; -*- MIDAS -*-

.symtab 3537.,7942.

.lstoff
ifndef $$pand,[
if1 [
define getpnd
  .tag retry
  printx /Is this to be a PANDA?  /
  .ttymac foo
    irpnc 0,1,1,bar,,foo
      ifse bar,Y,[$$pand==1]
      ifse bar,y,[$$pand==1]
      ifse bar,N,[$$pand==0]
      ifse bar,n,[$$pand==0]
    termin
  termin
  ifndef $$pand,[printx /
Answer Yes or No.
/
 .go retry]

ifn $$pand,[ .ofnm1==sixbit /PANDA/ ? .ofnm2==sixbit /BIN/]
ife $$pand,[ .ofnm1==sixbit /PWORD/ ? .ofnm2==sixbit /BIN/]

termin

getpnd

expunge getpnd
];end IF1
];end IFNDEF $$PAND,

ifndef $$DBUG,$$DBUG==0		   ;debuggin?  Don't hack real thing!

ife $$PAND,title PWORD -- Passwords for ITS
ifn $$PAND,title PANDA -- Password Manipulations

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;
;;;  Conventions to be rigidly adhered to!!!!!!!!
;;;  Under penalty of bugs and hassles!!!
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  1)  Do not use ERROR lightly.  It is for true internal errors, and
;;;      will write crash files!
;;;  2)  Put all conventions to be rigidly adhered to here!
;;;  3)  Document all that you do!
;;;  4)  Do more than that, TELL me all that you do.  I.e. :BUG PWORD
;;;  7)  I'd prefer to make whatever changes myself, on grounds that I know
;;;      more of what is involved.  At least, make an attempt to ask me first!
;;;  8)  Make no patches to the binary without also modifying the source and
;;;      doing :BUG PWORD .... 
;;;  9)  All typeout of strings is done by the TYPE macro.  The first argument
;;;      is the channel on which it should be output.  Use DSPC if ^P codes are
;;;      to be included, otherwise TYOC should be used, if output is to the
;;;	 TTY.  
;;; 10)  ECHOCH is for echoing the character contained in CH .... $ECHO is for
;;;	 "echoing" arbitrary characters, it takes a character
;;;	 as an argument.  $ECHO ["A] will "echo" an "A".  It echos tab, LF
;;;	 and backspace as uparrow-frobby, and on sail-able TTY's it uses ^KA
;;;	 type stuff.
;;; 12)  Any code which deigns to type out on it's own (as opposed to the
;;;	 TYPE etc. macros, which do this on their own) should refrain from
;;;	 doing so if TTYFLG is non-zero.  This indicates an output reset
;;;	 is in progress, and all output should be flushed until something
;;;	 of the nature of a prompt occurs, which should zero TTYFLG and then
;;;	 type out.
;;; 13)  Do not use DSKLOS for OPEN's that can fail letigimately.
;;;	 It generates crash files.  Use FILOSS <filename block>
;;; 14)	 All interrupt routines *MUST* save UUO and UUOH if they use any
;;;	 user UUO's.  The same is true of any UUO's that call UUO's
;;;	 recursively.  Also, UUOAC.  They should use the UUOPSH or UUOPOP
;;;	 macros.
;;; 15)	 Any UUO's that may use AC's in effective address calculations
;;;	 move tt,(sp) ? move t,-1(sp) to recover their original contents
;;;	 the AC field may be saved in UUOAC
;;; 16)	 17 (SP) cannot be used as the data address of a UUO.  (obviously)
;;; 17)	 UUO's clobber no AC's
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


SUBTTL	Basic Definitions

x=:0				   ;super temporary
a=:1
b=:2
c=:3
d=:4
e=:5

t=:7				   ;temporary arithmetic register
tt=:10				   ;temporary arithmetic register, T+1
ch=:11				   ;Character being manipulated.
count=:12			   ;count into string being manipulated
bp=:13				   ;byte pointer into string being read
ct=:14				   ;count of characters read in this part
				   ;of the reader.  If it goes negative,
				   ;the reader will fail-return
				   ;when this happens, the caller should
				   ;consider itself to have gotten a rubout,
				   ;rubbing out it's terminating character.
sp=:17

lodc==1				   ;channel to load DDT from
dspc==2				   ;TTY out channel, display mode
tyic==3				   ;TTY input channel, 12-bit input
tyoc==4				   ;TTY out channel, non-display
lsrc==5				   ;channel for LSRTNS
pwdc==6				   ;channel for maping in pword database
dski==7				   ;channel for disk input
hstc==10			   ;channel for NETWRK to use for HOSTS3 table
dsko==14			   ;channel to do mail output on
logc==15			   ;channel for log file output
tlnc==16			   ;USR device channel for STY owner
usrc==17			   ;USR device channel


c.op==42			   ;opcode for .OPER's
;;; random data area lengths

pdllen==100.			   ;large pdl
msgbfl==1400*5			   ;>2 * # of chars on VT52 screen! (79. x 24.)
cargmx==3			   ;maximum control arguments.
cargct==10			   ;must be greater than the most # of
				   ;control arguments known to any command

buflen==100			   ;buffer for reading from disk
luckln==100			   ;# of spaces to reserve for friendly sites
loseln==20			   ;# of spaces to reserve for unfriendly sites

.purpg==13			   ;first pure page

cnt==%CLBTW,,0			   ;control
cnti==%CLBIT,,0			   ;control immediate
argi==%CLIMM,,0			   ;immediate argument
val==%CLOUT,,0			   ;value return
errret==%CLERR,,0		   ;error return

DEFINE SYSCAL A,B,C=<calerr>
	.CALL [SETZ ? SIXBIT/A/ ? B ? setz+errret+c] TERMIN

define .pure
ifn .pure.,.err Two .PURE's without a corresponding .UPURE
.pure.==-1
..unpr==.
loc ..pure
termin

define .upure
ife .pure.,.err Two .UPURE's without a correspponding .PURE
.pure.==0
..pure==.
loc ..unpr
termin


..unpr==100
..pure==2000*.purpg
.pure.==0			   ; initially allocating impure

;; Macro to check for overlap of pure and impure
define .perch
define .pch. xx,yy,zz
printc \
Impure storage from 0 to yy
Pure storage from xx to zz
\
termin
.pch. \.purpg*2000,\..unpr,\..pure
ifl .purpg*2000-..unpr,.err UNPURE overlaps with PURE
termin

define norm7 c			   ;normallize a 7-bit byte pointer
       skipge c
         sub c,[430000,,1]
termin

define decbp c			   ;decrement byte pointer
	add c,[70000,,]		   ;back up the byte pointer
	skipge c		   ;did we cross a word boundary?
	  sub c,[430000,,1]	   ;then fix it
termin

define decbp6 c			   ;decrement byte pointer
	add c,[60000,,]		   ;back up the byte pointer
	skipge c		   ;did we cross a word boundary?
	  sub c,[440000,,1]	   ;then fix it
termin

;;; This macro takes two arguments, the first is a starting location in
;;; memory, and the second is a # of characters after that.
;;; It returns the BP that you'd get after that # of IDPB's into that buffer
define bpend buf,ln
<<000700+<<<<5-<ln-<ln/5>*5>>*7>+1>_14>>,,<buf+<ln/5>>> termin

define upper chr		   ;uppercase a character
	cail chr,141		   ;lower "a"
	  caile chr,172		   ;lower "z"
	    caia		   ;if got here, it's not lower a-z, skip
	    subi chr,40		   ;convert case
termin

define type chan=tyoc,&STRING
	output chan,[asciz string]
termin

define ask &string
	askusr [asciz string]
termin

;; WRITE clobbers X, writes string to bp
define write bp,&string
	move x,[440700,,[asciz string]]
	copy x,bp
termin

define tyobpi bp,ch
	movei x,ch
	idpb x,bp
termin

define	do stuff,else,\label
define ddoo exit
	jrst [stuff
jrst label]
!else!

label::
termin

ddoo <jrst label>

termin

pjrst==jrst			   ;for pushj sp, ? popj sp, sequences.
call=pushj sp,
ret=popj sp,

;;; macros to evaluate system symbols and locations

define seval a,b		;get value of symbol B in A
	move a,[squoze 0,/b/]
	.eval a,
	  loss
termin

define eval a,b
	seval a,b
	hrl a,a			;move to left
	hrri a,a		;destination is a
	.getloc a,		;get it into a
termin				;done!

define save objs
       irp x,,[objs]
       push sp,x
       termin
termin

define restore objs
       irp x,,[objs]
       pop sp,x
       termin

termin

%TCCOM==400000			   ;Comm mode bit in %TCCOM

;;; definitions of data-structures in command table.

; CO <=> Command Option
%CO==:1,,525252			   ;bit mask for %CO bit-typeout
%COJCL==:400000			   ;says command accepts JCL
%COTOP==:200000			   ;Says is a topic, not a command
%COOPT==:100000			   ;says that the %COARG argument is optional
%COARG==:040000			   ;says that the first word of JCL is 6bit
%COCRG==:020000			   ;says that this command expects control
				   ;arguments 
%CONLS==:010000			   ;says don't list this among the commands.
				   ;useful for establishing aliases among
				   ;commands.
%COFIL==:004000			   ;Says this command may use ^X or ^Y
%COSND==:002000			   ;Says this command needs :SEND type rubout
				   ;hackery, including updating SNAPTR

;Command table entry format
CM$NAM==:0			   ;	SIXBIT /NAME/
CM$RTN==:1			   ;	Routine to run
CM$FLG==:2
CM$OPT==:3			   ;	AOBJN ptr to OPTIONS
CM$HLP==:4			   ;	Helper
CM$SDC==:5			   ;	AOBJN ptr to short documentation
CM$LDC==:6			   ;	AOBJN ptr to long doc
CM$LEN==:7

cmdcnt==0

define COMMAND name,aname,routin,flags,options,helper,&short,long
cmdcnt==cmdcnt+1
ifb aname,    Z$!NAME:
ifnb aname,   Z$!ANAME:
	SIXBIT /name/
ifnb routin,   routin
.else	       0
ifnb flags,    flags
.else	       0
	optexp [options]
	       0
	<.length short>,,[asciz short]
	<.length long>,,[asciz long]
termin


;; hack an expression of OPTIONS
define OPTEXP options,\.bar
  -.bar,,[
	.foo==0
	.bar==0
        irpw x,y,[options]
         optex1 .bar,\<1_.foo>,x,[y]
	 .foo==.foo+1
	termin
	]
termin

define optex1 .bar,val,symbol,strings
; The following IRPS is to strip trailing blanks off the symbol  (termin)
IRPS x,,[symbol]
x==:val
termin 
 irp x,,[strings]
	  <.length /x/>,,[ascii /x/]
	  val
	  <.length /-x/>,,[ascii /-x/]
	  val
	  .bar==.bar+2
 termin 
termin 

;;; Macro to print error message and write crash file.

define error &mesage
	errdmp [asciz mesage]
termin

;;; in SIOTO, the AC is assummed to contain the count initially.  It is
;;; clobbered.  The channel defaults to TYOC

define sioto ac,[bp],chan=tyoc
	movem ac,siotct		   ;save the SIOT count
	move ac,bp
	syscal siot,[argi chan ? ac ? siotct]
	  loss
termin


define $echo .ch.

	push sp,ch
	move ch,[.ch.]
	echoch
	pop sp,ch
termin


;;;; ***** MEMORY MAP *****
;;;;
;;;; Data is assigned to one of two areas according to whether it follows
;;;; one of two macros, .PURE and .UPURE
;;;; Things following .UPURE are allocated in the unpure core, at the lowest
;;;; extreme of the job.  Things following .PURE are allocated in the pages
;;;; following the impure.  See the macro definitions for more details
;;;;
;;;; 0-13 impure data space
;;;; Pure code space
;;;; LSRTNS space
;;;; HOSTS3 table
;;;; password database (54-200)
;;;;
;;;; 360-363 badpag -- pages loaded into by DBGHAK.  When anylyzing crash files
;;;;		       these pages are also mapped into the impure data area
;;;;		       (0-3)
;;;; 364-370 goodpg -- This is where DBGHAK saves it's own good pages when it
;;;;		       has BADPAG mapped into the impure data area
;;;; 375 dpdlpg -- debuging pdl allocated by DBGHAK
;;;; 376 tmpag1 -- temporary page # 1, must be contiguous with tmpag2
;;;; 377 tmpag2 -- temporary page # 2, must be contiguous with tmpag1

lsrpag==32			   ;first page for LSRTNS to hack
lsrpgc==16.			   ;# pages for LSR1

hstpag==lsrpag+lsrpgc		   ;first page for NETWRK to hack
hstpgc==80.			   ;# pages for HOSTS3

pwpage==hstpag+hstpgc		   ;page where we map the password file

badpag==360
badloc==2000*badpag

goodpg==364
good=goodpg*2000

dpdlpg==375			   ;page to use as debugging PDL
dpdl=2000*dpdlpg		   ;location of debugging pdl

tmpag1==376
tmpag2==377


SUBTTL	UUO Routines etc.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                         ;;;
;;;                          UUO routines etc.				    ;;;
;;;									    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
									       
loc 35				   ;in case get's switched in middle of an $X
.break 16,500000
.break 16,70000

loc 40 
uuo:	0			   ;location for UUO's
	JSR UUOH		   ;go handle UUO's
loc 60
suuo:	0
	jsr suuoh		   ;go handle system-returned UUO's
	-intlng,,tsint		   ;abjon ptr to interrupt table
loclst:	0			   ;nothing on locked switch list yet
	-6,,critic		   ;Critical Routine table


loc 100
uuoh:	0			   ;foo!  Where did this come from?
	jrst uuodsp		   ;go dispatch on the UUO

uuoac:	0			   ;saved AC of UUO
uuoarg:	0			   ;saved arg of UUO
suuoh:	0
	jrst errfoo
.pure

errfoo:	movem tt,ac.tt		   ;save an AC to hack with
	ldb tt,[opcode suuo]	   ;check it for legitness
	caie tt,<.ldb opcode,errdmp>  ;is it real?
	  jrst [movei tt,[440700,,[asciz /Bad SUUO/]]
	        movem tt,errmsg
		movem x,ac.x
		jrst errput]
	ldb tt,[accum suuo]
	movei tt,@erruuo (tt)	   ;get address of handler
	exch tt,uuoac		   ;recover the orriginal AC
	jrst @uuoac		   ;    yes, hack the error

;;; this is the magical dispatch for the ERRDMP uuo
;;; it is indexed by AC field of the ERRDMP uuo

;;; ERRDMP <0 to 4>,[ASCIZ /STRING/]
;;; if 0, ordinary error
;;; if 1, it's a LOSS, I.e. random error
;;; if 2, it's an OPEN that failed that
;;;	  shouldn't have, and should dump
;;; if 3, it's an I/O operation that should
;;;	  print the error and filename, the
;;;	  effective address of this should be
;;;	  a file block instead.
;;; if 4, AC's have already been saved, don't
;;;	  clobber.


erruuo:	errmng			   ;basic ERROR uuo
	loserr
	dskerr			   ;disk error
	opfail			   ;OPEN failure?
	errmn1			   ;AC's already saved ERROR?
	repeat <20-<.-erruuo>>,baduer

baduer:	movem x,ac.x
	move tt,ac.tt
	movei x,[asciz /ERRDMP with bad AC field!/]
	movem x,errmsg
	jrst errput

errdmp=50000,,0			   ;UUO that goes through system, don't clobber
				   ;.JPC !!
loss=errdmp 1,
dsklos=errdmp 2,
filoss=errdmp 3,


;;; macros to save and restore locations needed for UUO handler
;;; (for interrupts)
define uuopsh
       save [UUO,UUOH,UUOAC]
termin

define uuopop
       restore [uuoac,uuoh,uuo]
termin

uuodsp:	save [T,TT]		   ;save a few AC's to work with
	ldb t,[opcode uuo]	   ;get the opcode
	ldb tt,[accum uuo]	   ;and the accumulator
	caige t,uuomax		   ;legal?
	  jrst @optab(t)	   ;  yes, hack it
uuoerr:	error /Internal Error:  Unknown UUO/
 

uxuuor:	restore [uuoh]		   ;restore our return address!
xuuort:	restore [x]		   ;restore our borrowed AC
uuoret:	restor [tt,t]		   ;restore the stolen AC's
	jrst @uuoh		   ;return

define uuodef name,loc
       loc
name=<.-optab-1>_33
termin

optab:	uuoerr			   ;no 0's allowed!
	uuodef output,strt	   ;OUTPUT <CHANNEL>,[ASCIZ /STRING/]
	uuodef outstr,istrt	   ;OUTSTR <CHANNEL>,[<bp [<string>]]
	uuodef 6type,type6	   ;6type chan,loc
	uuodef 8type,type8	   ;8type chan,loc
	uuodef htype,typeh	   ;htype chan,loc
	uuodef 10type,type10	   ;10type chan,loc
	uuodef aiot,aciot	   ;AIOT ac,loc (ac contains channel)
ifn $$PAND,uuodef tyo,utyo	   ;TYO chan,loc
ife $$PAND,tyo==.iot
	uuodef idpb6,uidpb6	   ;IDPB6 ac,[bp for output] (AC contains 6bit)
	uuodef idpb8,uidpb8	   ;IDPB8 ac,[bp for output] (AC has octal)
	uuodef idpb10,udpb10	   ;IDPB10 ac,[bp for output] (AC has decimal)
	uuodef typout,outtyp	   ;TYPOUT chan,[spec] (see spec format below)
	uuodef .mail,mailit	   ;.MAIL [mail-spec]
	uuodef copy,scopy	   ;COPY ac,[bp] (ac contains from bp)
	uuodef askusr,usrask	   ;ASKUSR [ASCIZ /STRING/]
				   ;documentation for command
uuomax==.-optab

; DSKLOS is for dsk output opens that fail and shouldn't


;;; TYPOUT expects the EA to contain a frob as follows:

; 1) Byte pointers
; 2) 0, in which case it returns without doing anything
; 3) one of the following opcodes.  These are indirected with, so indirection
;    or indexing may be used.

typcod:
tp$ind==730000,,0		   ;points to a footyp word to be interpreted
	error /TP$IND not handled/
tp$dec=740000,,0		   ;output word as decimal
	10type @uuoarg
tp$htp=750000,,0		   ;output word as half-words
	htype @uuoarg
tp$oct=760000,,0		   ;output the word as octal
	8type @uuoarg
tp$6bt=770000,,0		   ;6bit word to be output as 6bit
	6type @uuoarg

outtyp:	movem tt,uuoac		   ;remember the channel we hack
	move tt,(sp)		   ;in case the argument lives in an AC
	move t,-1(sp)		   ;gotta get the original vals for AC's
typot0:	skipn t,@uuo		   ;get the argument
	  jrst uuoret		   ;  null argument, just return
	call typdsp		   ;dispatch on the type
	jrst uuoret		   ;return

typdsp:	hlrz tt,t		   ;get the argument type
	andi tt,777740		   ;clear out any indirection, etc.

	cain t,0		   ;is the whole thing 0?
	  ret			   ;  yes, don't do anything at all.
	cain tt,0		   ;is it 0?
	  error /Null type code in TYPOUT/
	cain tt,(tp$ind)	   ;is it indirect?
	  jrst [movem t,uuo	   ;  substitute it for the UUO
	        move t,-2(sp)	   ;  recover old AC values for indirection
		move tt,-1(sp)
	        skipn t,@uuo	   ;  perform the indirection
	          ret		   ;    nothing there, don't do a thing
	        jrst typdsp]	   ;  and re-do argument checking
	caile tt,770000		   ;is it too large
	  jrst typabj		   ;  it's an AOBJN ptr
	caige tt,450000		   ;or too small?
	  jrst typbp		   ;  it's a byte pointer
	caige tt,720000		   ;is it out of our range?
	  error /Bad argument to TYPOUT/
	movem t,uuoarg		   ;remember the arg, to indirect through
	ldb tt,[360300,,t]	   ;get the type-code of the arg
	subi tt,3		   ;three unused ones
	move tt,typcod(tt)	   ;get the UUO to do that operation
	move t,uuoac		   ;recover our AC
	dpb t,[accum tt]	   ;and insert it into our consed up instr
	movem tt,uuo		   ;store in convenient slot
	move tt,-1(sp)		   ;recover the original contents of the AC's
	move t,-2(sp)		   ;except for the stack, of course
	push sp,uuoh		   ;remember where we're from
	xct uuo			   ;perform the new UUO
	pop sp,uuoh
	ret

;;; handle the AOBJN ptr case
.upure
ABJSAV:	0			   ;storage for our AOBJN ptr
.pure

typabj:	push sp,abjsav		   ;we may be recursive
	push sp,uuoac
typlop:	movem t,abjsav		   ;remember our AOBJN ptr
	hrrzm t,uuoarg		   ;cons up address of arg
	move t,(sp)		   ;recover UUOAC
	movem t,uuoac
	move t,-2(sp)		   ;recover AC values
	move tt,-3(sp)
	move t,@uuoarg		   ;get the actual argument
	call typdsp		   ;  dispatch on the type of argument
	move t,abjsav		   ;recall our AOBJN ptr
	aobjn t,typlop		   ;if there are more args, get the next
	pop sp,uuoac
	pop sp,abjsav		   ;back to the way the world was
	ret

;;; Cons up and execute a OUTSTR to type out from our Byte Pointer!
typbp:	move tt,[outstr t]	   ;basic instruction
	movem tt,uuo		   ;convenient place to put it!
	move tt,uuoac		   ;get the AC field
	dpb tt,[accum uuo]	   ;and add it into the instruction
	push sp,uuoh		   ;remember where we're from!
	xct uuo			   ;Do it!
	pop sp,uuoh		   ;restore OUR return!
	ret			   ;all done, return!

;;; STRT expects the UUO to have had the string at it's E.A, and it to start
;;; on a word boundary.
;;; ISTRT expects it to have had the byte pointer as it's E.A. and not start on
;;; a word boundary

.upure
mdlflg:	0			   ;non-zero if we're to type MUDDLE strings
.pure

istrt:	movem tt,uuoac		   ;remember the channel we hack
	move tt,(sp)		   ;in case the B.P. lives in an AC
	move t,-1(sp)
	move t,@uuo		   ;get the B.P.
istrt0:	move tt,uuoac		   ;recover the channel we hack
	jrst strt1		   ;and hack the rest of it.

strt:	hrlzi t,440700
	hrr t,uuo		   ;cons up a byte pointer to the string

strt1:	save [count,t]
	setz count,		   ;prepare to count characters
	
strt3:	ildb ch,t		   ;grab the char
	cain ch,^L		   ;is it ^L?
	  jrst strt4		   ;  ^L ends a file too, for us
	caie ch,^C		   ;is it a ^C?
	  cain ch,0		   ;  is it null?
	    jrst strt4		   ;    one or the other, exit loop
	skipn mdlflg		   ;are we hacking MUDDLE strings?
	  jrst strt39
	caie ch,""		   ;is it a " ?
	  cain ch,"\		   ;  or a \ ?
	    jrst strt40		   ;    take funny exit

strt39:	aoja count,strt3	   ;nope, keep on trucking

strt40:	seto ch,		   ;note that this is a funny case!

strt4:	syscal rfname,[tt ? val t] ;get the device this is to.
	  error /OUTPUT called on closed channel/
	camn t,[sixbit /TTY/]	   ;Is this TTY output?
	  jrst typer		   ;  yes, type it instead
	pop sp,t		   ;recover the byte pointer
	syscal siot,[tt ? t ? count]  ;type it
	  loss
	  
typecs:	restore [count]
	skipl ch		   ;was this a funny case?
	  jrst uuoret		   ;  no, just return
	ildb ch,t		   ;yes, get the funny character
	push sp,uuoh		   ;remember our return address!
	aiot tt,ch		   ;send it out quoted
	pop sp,uuoh		   ;restore our return address!
	jrst strt1		   ;and continue typing from there!

typer:	pop sp,t		   ;recover the byte pointer
	save [siotct]		   ;save it in case we're at interrupt level
	movem count,siotct	   ;put it in SIOTCT so ^S can clear
	syscal siot,[tt ? t ? siotct]
	  .lose 1400		   ;  We must be losing to badly!
	restore [siotct]
	jrst typecs		   ;return or loop as needed


type6:	movem tt,uuoac		   ;remember the channel to hack
	restore [tt,t]		   ;in case the word is in an AC
	save [t,tt,x]

	move tt,@uuo		   ;byte pointer to our arg on our stack
	move x,uuoac
	push sp,uuoh		   ;remember where we came from, we want to
				   ;go back!

type60:	setz t,			   ;clelar out cruft in T for new char
	lshc t,6		   ;get the first character
	skipn t			   ;is there something there?
	  aiot x,[^Q]		   ;  no, quote the space
	addi t,40		   ;convert to ascii
	aiot x,t		   ;type char in CH to channel in X
	jumpn tt,type60		   ;if there's more to type, type it
	jrst uxuuor		   ;and return


uidpb6:	movem tt,uuoac		   ;remember our ac
	restore [tt,t]		   ;in case the word is in an AC

	save [x,t,tt]		   ;Save the AC's we need..note not in usual
				   ;order
	push sp,@uuoac		   ;AC contains the data.  Put it on the stack
	move x,@uuo		   ;;get the byte pointer
	pop sp,tt		   ;get the 6bit in our AC

idpb60:	setz t,			   ;no garbage to throw us off.
	lshc t,6		   ;pick off a character
	skipn t			   ;iff it's a blank
	  do [movei t,^Q	   ;  grab a ^&Q
	      idpb t,x		   ;  and stuff it down the Byte Pointer
	      setz t,]		   ;  and restore the state of the world
	addi t,40		   ;convert to ascii
	idpb t,x		   ;deposit it
	jumpn tt,idpb60		   ;if there's any more to output, hack it
wbackx:	restore [tt,t]		   ;recover the temporary AC's
	exch x,(sp)		   ;recover original contents of X
	pop sp,@uuo		   ;and write back our Byte Pointer to wherever
	jrst @uuoh		   ;and return

type10:	movem tt,uuoac		   ;remember our AC
	restore [tt,t]		   ;restore AC's in case data in AC's
	save [t,tt,x]		   ;borrow another AC
	move t,@uuo		   ;get our data
	move x,uuoac		   ;get the channel to type to
	save [uuoh]		   ;save our return address
	call decpnt		   ;do the printing
	jrst uxuuor		   ;and return to caller

decpnt:	idivi t,10.		   ;figure first digit
	push sp,tt		   ;push remainder
	skipe t			   ;done?
	  call decpnt		   ;  no compute next one

decpn1:	pop sp,t		   ;yes, take out in opposite order
	addi t,60		   ;make ascii
	aiot x,t		   ;type char in T to channel in X
	ret			   ;and return for the next one.

udpb10:	movem tt,uuoac		   ;remember our AC
	restore [tt,t]		   ;restore AC's in case data in AC's
	save [x,t,tt]		   ;borrow another AC
	push sp,@uuo		   ; Get our byte pointer
	move t,@uuoac		   ;get our data
	pop sp,x		   ; Get our byte pointer into X
	call decdpb		   ;do the writing
	jrst wbackx		   ; write back X and exit

decdpb:	idivi t,10.		   ;figure first digit
	push sp,tt		   ;push remainder
	skipe t			   ;done?
	  call decdpb		   ;  no compute next one

decdp1:	pop sp,t		   ;yes, take out in opposite order
	addi t,60		   ;make ascii
	idpb t,x		   ; write character in T to BP in X
	ret			   ;and return for the next one.

type8:	movem tt,uuoac		   ;remember what AC field we had
	restore [tt,t]		   ;restore val of AC's, in case data resides
	save [t,tt,x,uuoh]	   ;therein.  Borrow X, and save return addr.
	move t,@uuo		   ;get our argument
	move x,uuoac		   ;get channel to hack
	call octpnt		   ;do the typing
	jrst uxuuor		   ;and return to caller

octpnt:	setz tt,
	lshc t,-3		   ;shift instead of IDIVI, don't forget
	lsh tt,-41		   ;negative! 
	push sp,tt		   ;push remainder
	skipe t			   ;done?
	  call octpnt		   ;no compute next one

octpn1:	pop sp,tt		   ;yes, take out in opposite order
	addi tt,60		   ;make ascii
	aiot x,tt
	ret			   ;and return for the next one.

;;; like OCTPRT except deposits down byte pointer in E.A. and gets data in AC

uidpb8:	movem tt,uuoac		   ;remember what AC has the data
	restore [tt,t]		   ;restore val of AC's, in case data resides
	save [x,t,tt]		   ;therein.  Also, borrow X.  Note unusual
				   ;order for things going to WBACKX
	push sp,@uuo		   ;get our argument Byte pointer
	move t,@uuoac		   ;Get contents of AC
	pop sp,x		   ;Byte Pointer to X
	call octdpb		   ;do the typing
	jrst wbackx

octdpb:	setz tt,
	lshc t,-3		   ;shift instead of IDIVI, don't forget
	lsh tt,-41		   ;negative! 
	push sp,tt		   ;push remainder
	skipe t			   ;done?
	  call octdpb		   ;no compute next one

	pop sp,tt		   ;yes, take out in opposite order
	addi tt,60		   ;make ascii
	idpb tt,x		   ;output down the Byte pointer 
	ret			   ;and return for the next one.

typeh:	movem tt,uuoac		   ; Remember the AC
	restore [tt,t]		   ;restore the vals of AC's in case the data
	save [tt,t,x,uuoh]	   ;resides therein.  Borrow X, save return
	push sp,@uuo		   ;recover the data without clobbering AC's
	hlrz t,(sp)		   ;get left half
	move x,uuoac		   ;remember the channel
	call octpnt		   ;print it
	aiot x,[",]		   ;,,
	aiot x,[",]
	hrrz t,(sp)		   ;get the right half
	call octpnt		   ;print it
	pop sp,x
	jrst uxuuor		   ;return

;;; one instruction SYSCAL IOT that checks for TTYFLG if TTY channel

aciot:	movem tt,uuoac		   ;remember the AC with the info
	move tt,(sp)		   ;recover original data of AC's
	move t,-1(sp)

	push sp,@uuo		   ;fetch the value, but don't clobber AC's
	move tt,@uuoac		   ;<AC> has channel, not is channel
	pop sp,t		   ;and recover the value

	cain tt,tyoc		   ;is it neither TTY channel?
	  caie tt,dspc
	    jrst aiot66		   ;    no, don't check for TTY turned off

	skipe ttyflg		   ;has the TTY ben turned off?
	  jrst uuoret		   ;  yep, just return
aiot66:	call mmquot		   ;maybe muddle quote the character!
	syscal iot,[tt ? t]	   ;actually do it
	  loss
	jrst uuoret		   ;and return from the UUO

;;; Maybe Muddle Quote !
mmquot:	skipn mdlflg		   ;hacking muddle strings?
	  ret
	caie t,"\		   ;is it a special char?
	  cain t,""
	    caia		   ;    yep, gotta hack specially
	      ret		   ;	  nope, just output it
	syscal iot,[tt ? ["\]]	   ;quote the frob first!
	  loss
	ret

utyo:	movem tt,uuoac		   ;remember the channel
	move tt,(sp)		   ;recover original data of AC's
	move t,-1(sp)
	move t,@uuo		   ;get the data
	move tt,uuoac		   ;and the channel
	cain tt,tyoc		   ;is it neither TTY channel?
	  caie tt,dspc
	    jrst utyo66		   ;    no, don't check for TTY turned off

	skipe ttyflg		   ;has the TTY ben turned off?
	  jrst uuoret		   ;  yep, just return

utyo66:	call mmquot		   ;maybe muddle quote the character!
	syscal iot,[tt ? t]	   ;actually do it
	  loss
	skipn logflg		   ;are we logging?
	  jrst uuoret		   ;  no, return from the UUO
	caie tt,tyoc		   ;is it either TTY channel?
	  cain tt,dspc
	    caia		   ;    yes, don't stop now!
	      jrst uuoret	   ;	  no, don't log it!
	syscal iot,[argi logc ? x]  ;yes, log it
	  loss
	jrst uuoret		   ;return


scopy:	movem tt,uuoac		   ;remember which AC has our FROM pointer
	move tt,(sp)		   ;recover original data of AC's
	move t,-1(sp)
	move tt,@uuoac		   ;get from pointer
	move t,@uuo		   ;get TO pointer
	save [ch]		   ;get a temporary AC to hack with!
scopy0:	ildb ch,tt		   ;get a character
	caie ch,^C		   ;is it a ^C
	  cain ch,0		   ;  or a ^@?
	    jrst scopy9		   ;    yes, end of loop
	idpb ch,t		   ;deposit, and
	jrst scopy0		   ;do it again

scopy9:	push sp,t		   ; Without advancing the BP
	setz ch,		   ; follow the string with a ^@
	idpb ch,t		   ; where it will be clobbered if further
	pop sp,t		   ; copying is done
	restore [ch]		   ; restore borrowed AC
bpback:	exch tt,(sp)		   ; get back the original contents of the ACs
	exch t,-1(sp)		   ; while saving the modified Byte pointer's
	pop sp,@uuoac		   ; write back the modifed Byte Pointer's
	pop sp,@uuo		   ; from whence they came
	jrst @uuoh		   ; and return.

;;; ASKUSR [ASCIZ /STRING/] types string and reads a char, echoing Yes or No.
;;; it skips if the answer is Yes.

usrask:	save [ch,dsprmp,uuo,uuoh]
	move t,[output dspc,]	   ;cons up a display UUO
	hrri t,@uuo		   ;with the right effective address
	movem t,dsprmp
usras1:	output dspc,@uuo
	type tyoc,/  (Y or N)  /
	tyi
	  jrst usrext		   ;  We'll take that as NO
	  jrst usras1		   ;  Help out
	  jrst usrext		   ;  ditto
	cain ch,40		   ; Pretend that a space is a Yes also.
	 movei ch,"Y
	caie ch,"y		   ;is it yes?
	  cain ch,"Y
	    jrst [type tyoc,/Yes.  /  ;    successful
		  restore [uuoh]   ;	recover our return address
		  aos uuoh	   ;	skip
		  jrst usrex1]	   ;	and return
usrext:	type dspc,/No.  /
	restore [uuoh]
usrex1:	restore [uuo,dsprmp,ch]
	jrst uuoret		   ;fail return

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                         ;;;
;;; Password routines.							    ;;;
;;;									    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

%COHLP==1			   ;says command is not to be documented

byebye:				   ;this is the location to use instead of
				   ;.logout, to avoid people logging out and   
				   ;linking
phaser==.suset [.spirqc,,[%piltp]]  ;sneaky way to get here
clock:
klock::	syscal finish,[argi tyoc]	   ;finish up our output
	  jfcl
IFN 1,[	skipn debug
	  .logout 1,
	.break 16,100000
	.logout 1,
]; END IFN 1,

IFN 0,[	.suset [.rsuppro,,tt]
	cail tt,0		   ;Are we running as an inferior?
          .logout 1,		   ;  Go away, but don't gun TELSER
	syscal rfname,[argi tlnc   ;is there a job open on this channel?
	       val t		   ;  device
	       val x		   ;  UNAME
	       val tt]		   ;  JNAME
	  loss			   ;  eh?
	cain t,0		   ;is the Device 0?
	  .logout 1,		   ;  yes, there is no job there
	tlz x,777700		   ;clear out the TTY # part of nnTLNT
	came x,[sixbit /  TLNT/]   ;is it really a telser?
	  .logout 1,		   ;  nope
	came tt,[sixbit /TELSER/]  ;including JNAME?
	  .logout 1,		   ;  nope
	.uset tlnc,[.ruind,,t]	   ;get his index
	.gun t,			   ;make it go away
]; END IFN 0,

telbye:	.logout 1,		   ;Bye-bye!
	.logout 1,

jtingl:	type tyoc,/The TINGLE command does not yet exist
/
	ret

init:	syscal corblk,[cnti %cbndw ;need to write to initialize
		argi 0
		argi %jself
		argi pwpage	   ;just the first page
		argi pwdc	   ;from the file
		argi 0]
	  loss

	syscal RQDATE,[val x ? val t]
	  loss
	jumpl t,[type dspc,/AThe system doesn't know the time yet, please
wait.
/
		 movei t,300.	   ;system doesn't know time,
		 .sleep t,	   ;sleep 10. sec and hope it
		 jrst init]	   ;finds out the time.
init0:	move tt,t
	exch t,pwinit		   ;claim privilege of init'ing.
init1:	camn t,pwinit		   ;should we init?
	  jrst initw		   ;  no, someone else is, wait for him
	setom pwlock		   ;unlock the lock
	move x,pwcnt		   ;check the count, must be even
	trz x,3			   ;flush any odd words
	movem x,pwcnt		   ;and save it back again

init2:	movem tt,pwdone		   ;mark init complete.
	jrst initd		   ;We're all done.

initw:	camn tt,pwdone		   ;wait till someone else's init is finished.
	  jrst initd		   ;  yes, they finished already.
	type dspc,/APassword database being initialized by another program.
Please wait.
/
	movei t,30.
	.sleep a,		   ;also consider that the job doing the
	move t,tt		   ;init'ing may have aborted.
	jrst init0		   ;so go back to try it again just in case.

initd:	syscal corblk,[cnti %cbndr ;back to read-only
		argi 0
		argi %jself
		argi pwpage]
	  loss
	syscal pgwrit,[argi pwpage]  ; Make sure the disk copy is up to date
	  loss			   ; too
	syscal dskupd,[argi pwdc]  ;update creation date, etc.
	  loss			   ;  Why would this fail?
	ret

constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;                      Lock manipulation routines.
;;;;
;;;;  LOCK is the multi-purpose entry, which takes the address of the lock in D
;;;;  PLOCK is the entry for locking the password database.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

plock:	.suset [.sdf1,,[-1]]	   ;prepare to lock the database
	.suset [.sdf2,,[-1]]	   ;defer interrupts
	call pwdopn		   ;access the database again
	movei d,pwlock		   ;lock the database
lock:	syscal corblk,[cnti %cbndw ;make it writeable again
		argi 0
		argi %jself	   ;get into self
		argi pwpage	   ;at our password file location
		argi pwdc	   ;the 0th page of the pword file
		argi 0]
	  loss
	.suset [.ruind,,tt]	   ;get our user-index to identify ourself
	skipl (d)		   ;wait for switch to be free.
	 .hang
	aose (d)		   ;try to lock it.
	 jrst lock		   ;(somone else grabbed it between
				   ;our .hang and our aose)
lock1:	movem tt,pwlkid		   ;identify ourself as the culprit
	move tt,loclst		   ;put the switch on the
	hrli tt,(setom)		   ;locked switch list
	movem tt,1(d)		   ;link it in
	movem d,loclst		   ;and install it in the chain

lock2:	.suset [.runame,,t]	   ;record who we are
	movem t,pwuhak		   ;for debugging and delousing
	.suset [.rjname,,t]	   ;ditto for JNAME
	movem t,pwjhak
	aos pwaccc		   ;count accesses, for STAT command
	move t,pwrbfp
	aobjp t,.+1
	aobjp t,[movsi t,-pwrbfl ? jrst .+1]
	movem t,pwrbfp
	move x,pwuhak
	movem x,pwrbuf(t)
	move x,pxunam
	movem x,pwrbuf+1(t)

	ret			   ;it's locked, continue

;; This routine will set up the switch as a switch block, and make
;; loclst point to it. The contents of the switch block will be:
;;
;;	0		;This word is the switch itself!
;;	SETOM <previous contents of loclst>
;;			;The SETOM is the unlock instruction.
;;			;The RH has nothing to do with the SETOM;
;;			;it points to the next block of the list.
;;
;; Note that the HRLI instruction is superfluous, because 0 in the
;; left half of the second word of the block is the same as (SETOM).
;;
;; The three instructions starting at LOCK1 are critical because
;; the switch has been locked but is not on the locked switch list.
;; Therefore, an entry in the critical routine table of the form
;;
;;	LOCK1,,LOCK2
;;	SETOM @t
;;
;; is needed, in case the job is killed while executing there.


;;;;   2. UNLOCKING AN AOSE-STYLE SWITCH.

;; The correct way to unlock a switch follows:
;; (assuming that A points to the switch block and that
;; the switch block is the first item on the locked switch list).

;; This has gross bug of removing anything on the list from top to the
;; switch being removed.  Thus, before using any more locks, I should fix
;; it.  but it came from .INFO.;ITS LOCKS, so foo!

unlock:	save [tt]
	hrrz tt,1(d)		   ;remove the switch from the
	movem tt,loclst		   ;locked switch list.
unloc1:	setom (d)		   ;then unlock the switch.
unloc2:	syscal corblk,[cnti %cbndr ;make read only
	       argi 0
	       argi %jself
	       argi pwpage]
	  loss
	syscal pgwrit,[argi pwpage]  ; Update the lock page on disk
	  loss
	restore [tt]
	ret

pulock:	save [d]
	movei d,pwlock		   ;unlock the database
	call unlock
	syscal pgwrit,[argi pwpage]  ; Make sure the disk copy is up to date
	  loss
	.suset [.sdf1,,[0]]
	.suset [.sdf2,,[0]]	   ;undefer interruputs
	syscal dskupd,[argi pwdc]  ;update creation date, etc.
	  loss		   ;  Why would this fail?
	.close pwdc,
	restore [d]
	ret

;; The instruction at UNLOC1 is critical because the switch is
;; locked but not on the locked switch list. Therefore, an entry
;; is needed in the critical routine table as follows:

;;	UNLOC1,,UNLOC2
;;	SETOM @t


;;;; This is the critical routine table

critic:	init1,,init2		   ;from init1 to init2 the database has been
	movem tt,pwinit		   ;marked as being inited.  If killed undo it

	unloc1,,unloc2		   ;Here the lock has been removed from chain
	setom @tt		   ;but is still locked.
	lock1,,lock2		   ;Here, the switch is locked, but we are
	setom @tt		   ;still in the process of putting it on the
				   ;chain

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;  Password encryption and lookup/insert routines.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; This encrypts the contents of PWBUF into the format it is in the file
;;; The result is returned in T and in PDPASS

pwdmak:	save [a,b,c,d]
	call ustrip		   ;get the UNAME in TT, stripped of digits
	skipn tt		   ;is there something there?
	  error /Null UNAME!/
	movem tt,pxunam		   ;remember who we're hacking
	move x,pwbuf		   ;grab the pword into one word
	xor x,pwbuf+1		   ;xor'd into the other
	rot x,31		   ;rotate it oddly
	add x,TT		   ;mix the UNAME in with the mess
	addi x,736251		   ;garble it some more
	setz a,			   ;clear what we'll accumulate
	setz b,
	move c,pwbuf		   ;gobble them down
	move d,pwbuf+1
	movei e,110		   ;Stir well
pwdma0:	trnn x,1		   ;odd?
	  jrst [rot x,-1	   ;  not odd enough, make it odder
	        rotc a,1	   ;  gyrate wildly
		sojg e,pwdma0	   ;  rock and roll
		  move t,a	   ;  T is answer
		movem t,pdpass
		jrst pwdma9 ]
	add a,c
	add b,d
	rotc a,1		   ;mixed up?
	rot x,-1		   ;you ain't seen nothing yet
	sojge e,pwdma0		   ;brain salad surgery
	  move t,a		   ;T is the answer
	  add t,b		   ;  But the T shuts down by 1:00 am
	movem t,pdpass
pwdma9:	restore [d,c,b,a]
	ret			   ;that's the whole password

;;; PWDUMK encodes the UNAME in it's trivial reversable fashion
;;; returns result in TT, and PDUNAM
;;; PWDUMS is the same, bug first strips off any final digit.

pwdums:	call ustrip		   ;strip the UNAME
	caia			   ;got it already, don't gobble again
pwdumk: move tt,uname		   ;gobble down the UNAME 
	rot tt,13		   ;mix it up a bit too
	add tt,[742532,,732643]	   ;Will oddities never cease?
	ret			   ;return for refund


ustrip:	save [T,A]		   ;a couple of AC's to play with
	move t,uname		   ;gobble UNAME
	movei a,5		   ;don't strip single character frobs!
	setz tt,
ustrp0:	lshc t,-6		   ;check final position
	caie tt,		   ;Got the last character?
	  jrst [lsh tt,-36	   ;  right-align it
	        cail tt,'0	   ;  is it a digit?
		  caile tt,'9
		    caia	   ;	  nope
		      jrst [move tt,t  ;   get it in TT, where we expect it
			    movei t,6
			    sub t,a
			    imuli t,6  ;   yep, calculate how many real bits
			    lsh tt,(t)  ;    re-align left, without digit
			    restore [A,T]
			    ret]   ;  and take the express bus, we're set
		move tt,uname	   ;  not ending in digit, return whole UNAME
		restore [A,T]
		ret]		   ;  It doesn't end in a digit, so OK.
	sojge a,ustrp0		   ;  do it again!
	move tt,uname		   ;  not ending in digit, return this tiny
				   ;UNAME
	restore [A,T]
	ret

;;; PWDCNS conses up an entry in PDATA buffer.  It takes a UNAME
;;; un UNAME, a password in PWBUF, and initializes the flags according
;;; to the machine's defaults.
;;; PWDCID sets the creator and creation-date fields.

pwdcid:	save [x,tt]
	jrst pwdcd0

pwdcns:	save [x,tt]
	call pwdums		   ;cons UNAME
	call pwdmak		   ;cons password
	setzm pdmore		   ;extra word initially 0
	hrlzi x,%pfnew		   ;get the default flags
	movem pdflag		   ;and make them ours
	setzm pdinfo
	setom pddate
pwdcd0:	call crtidx		   ; Get our creator index into TT
	dpb tt,[pi$crt pdinfo]	   ; put that into the entry
	syscal RQDATE,[val x]
	  loss
	hllm x,pddate		   ; Put today's date in creator date
	restore [tt,x]
	ret

;;; PWDINI expects a UNAME in UNAME, and a password in PWBUF, and either
;;; returns the entry for that UNAME in PDATA or a new entry in PDATA if there
;;; was no entry for that UNAME

PWDINI:	call pwdlok		   ;find it
	  pjrst pwdcns		   ;  not there, cons it up
	pjrst pwdget		   ;It's there, get it


;;; this opens the password file
;;; It must be done before any attempt can be made to make it writable

pwdopn:	syscal open,[cnti .uii	   ;for input
	       argi pwdc	   ;open on the p-word channel
	       pw.dev
	       pw.fn1
	       pw.fn2
	       pw.snm]
	  ERROR /Can't access password file!/
	syscal sdmpbt,[argi pwdc ? argi 0]  ;clear dump bit, so always back up
	  loss
	ret

;;; this maps in the password file for reading
.upure
pwmapd:	0			   ; -1 if file mapped
.pure

pwdmap:	skipe pwmapd		   ; Have we already mapped it?
	  ret			   ;   Yes, don't bother repeating
	call pwdopn		   ;open the file
	syscal fillen,[argi pwdc ? val t]  ;get how long the bastard is
	  ERROR /Can't get length of password file!/
	save [t,tt]
	addi t,1777		   ;convert words to pages
	idivi t,2000
	movn tt,t		   ;and convert to AOBJN ptr to file
	hrlz tt,tt		   ;, length in left half
	movei t,pwpage		   ;and do same for the core side of things
	hll t,tt		   ;from there to here
	syscal corblk,[cnti %cbndr ;get read access.
	       argi 0
	       argi %jself
	       t
	       argi pwdc
	       tt]
	  ERROR /Can't map password file!/

	call init		   ;make sure it's up to date.
	.close pwdc,		   ;close it up, we don't need it any more!
	setom pwmapd		   ; Note we've mapped it
	restore [tt,t]
	ret

;;; PWDLOK looks up a UNAME in the database, returns the pointer to
;;; the entry in A
;;; PWDLK0 is an alternate entry for pre-computed UNAMEs
;;; PWDLKX is alternate entry for not striping the UNAME.  for PWDEL.

pwdlkx:	call pwdumk		   ;don't strip uname
	jrst pwdlk5

pwdlk0: move tt,pdunam		   ;get the pre-computed UNAME garbled in TT
	caia			   ;don't get it again.

pwdlok:	call pwdums		   ;get the UNAME garbled in TT
pwdlk5:	setz a,			   ;count the entries
pwdlk1:	camn tt,pwname(a)	   ;is this our UNAME?
	  jrst popj1		   ;  just find it, don't move it
	addi a,pwleng		   ;move to next entry
	camle a,pwcnt		   ;have we reached the end?
	  jrst [movem tt,pdunam	   ;  failure return, remember who we wanted
	        ret]		   ;  failed
	jrst pwdlk1		   ;not at end, keep looking


;;; PWDGET takes a pointer to the entry in A, and moves it to the buffer
;;; it first does an error check.
pwdget:	movem a,pdloc		   ; Remember where we got it from
	trne a,3		   ;Is this a multiple of 4?
	  ERROR /Bad database pointer in PWDGET/
	hrlzi x,pwname(a)	   ;set up to BLT
	hrri x,pdata		   ;the info on this person to our buffer
	blt x,pdata+pwleng-1	   ;to the Bahamas
	move x,pwname(a)	   ;get the name...
pwdunm:	sub x,[742532,,732643]	   ;Will oddities never cease?
	rot x,-13
	movem x,uname		   ;save it for later
	ret

;;; This routine computes our creator index, adding us to the table of
;;; administrators if needed

crtidx:	save [x,t,a,b]
	movei a,pwadmn		   ; table of people who have modified entries
	call pwsget		   ; Get the table of entries
	hlre b,runame		   ; Check out this for unloggedinness
	aoje b,[ move x,[sixbit /___NNN/]
		 jrst crtida ]
	move x,runame
crtida:	move b,t		   ; Remember this AOBJN ptr
	setz tt,		   ; Entry #
crtid0:	camn x,(t)		   ; Is this us?
	  jrst crtid1		   ;   Yes
	aos tt			   ; count the entries
	aobjn t,crtid0		   ; Next entry
	movem x,tmpbuf(tt)	   ; Make this the next entry
	sub b,[1,,0]		   ; grow the AOBJN ptr
	movei a,pwadmn
	call pwsput		   ; put the table back into the database
crtid1:	restore [b,a,t,x]
	aos tt			   ; 0 means unknown
	ret

;;; This routine installs a password into the database.
;;; It takes it's data in the PDATA buffer.
;;; The protocol is to ALWAYS look up the entry AFTER
;;; locking the database.

pwdput:	save [x,t,tt,a,b]
IFN $$PAND,[
	syscal RQDATE,[val t]
	  loss
	hllm t,pdmod		   ; Remember the modification date
	call crtidx		   ; Get the creator index in TT

pwdpt1:	dpb tt,[pi$mod pdinfo]	   ; Store who modified this entry

] ; END of IFN $$PAND,

	call plock		   ;Open and lock the password database
	call pwdlk0		   ;does the entry exist?
	  do [	move a,pwcnt	   ;  so grab the count
		movei a,pwleng(a)] ;  and move to the next case
  
	movei t,(a)		   ;Get pointer where we expect it
	tlze t,pwleng-1		   ;it must not be odd
	  jrst [ movem t,pwcnt	   ;  so straighten it out
		 call pulock	   ;  close up the database
		 error /Odd length password file./]

	idivi t,2000		   ;T now has page # wrt pwdata
	movei t,pdpage(t)	   ;Get page # in the file
	hrlzi x,pdata		   ;construct a BLT word for the password data
	hrri x,pwname(a)	   ;to where we want to put it.
	syscal corblk,[cnti %cbndw ;gotta write it.
	       argi 0
	       argi %jself
	       argi pwpage(t)
	       argi pwdc
	       argi (t)]
	  jrst [call pulock
		error /Can't write password file./]

	blt x,pwdata+pwleng-1(a)

	syscal corblk,[cnti %cbndr ;make read-only again
	       argi 0
	       argi %jself
	       argi pwpage(t)]
	  loss			   ;eh?  We're all fucked up!
	syscal pgwrit,[argi pwpage(t)]	; Update the disk copy
	  loss
	camle a,pwcnt		   ;have we added anything?
	  movem a,pwcnt		   ;  yes, be sure to save that
	call pulock		   ; Unlock the database
	restore [b,a,tt,t,x]
	ret

;;; PWSGET -- get a string from the database string area.
;;; address of string pointer is taken in A, length is returned in A.
;;; T gets an AOBJN ptr to the data.
;;; Data is copied into TMPBUF.

PWSGET:	save [d,x,tt]
	call plock		   ; lock the database
	move a,(a)		   ; Get the string pointer
	hrli x,pwstr(a)		   ; Get address of string
	hrri x,tmpbuf		   ; where to put it
	hlre a,a		   ; -<length>
	movns a			   ; <length>
	setzm tmpbuf		   ; Always have a 0 there in case null string
	jumpe a,pwsgt0		   ; if nothing to move, don't try
	blt x,tmpbuf-1(a)	   ; Move the data into TMPBUF
pwsgt0:	movn t,a		   ; create an AOBJN ptr to data for T
	hrl t,t
	hrri t,tmpbuf
	call pulock		   ; Unlock the database
	restore [tt,x,d]
	ret

;;; PWSPUT writes data into the database string area.
;;; IN A is the address of the database entry to store ptr into.
;;; IN B is AOBJN to data to be installed

; String Space.  This is divided into thre consing areas, NEW, OLD, and NEXT
; When NEW is filled, all pointers into OLD are copied into NEXT space, which
; then becomes the NEW space.  The old NEW space, not suprisingly, becomes the
; OLD space.  This is done to avoid half-moved strings, to guarantee consistancy
; at all times.  Strings are pointed to by AOBJN ptrs, relative to PWSTR.  The
; AOBJN ptrs are examined and updated only with the database locked, and are
; updated only after any necessary copying is done.  Each consing area is 2 pgs
; long.

PWSPUT:	save [d,x,t,tt]
	push sp,a
	call plock		   ; Database MUST BE LOCKED
	skipe pwsgcp		   ; Is there a GC in progess?
	  call pwsgc		   ;   Yes, GC first!
	setz a,			   ; No full GC done yet
pwspt0:	hlre t,b		   ; get -<size>
	jumpge t,pwspte		   ; empty, just zero it
	hlre x,pwsptr		   ; Get -<room>
	sub x,t			   ; get -<room left>
	jumpg x,[ caile a,1	   ;   GC failed?
		    jrst pwsgcf	   ;     Complain about it
		  call pwsgc	   ;   full, gotta GC first
		  aos a		   ;   say we've already GC'd
		  jrst pwspt0]
	hrrz tt,pwsptr		   ; get pwstr offset of free area
	movei d,(tt)		   ; copy for our consed ptr
	sub tt,t		   ; get new pwstr offset of remaining free
	hrl tt,x		   ; get new free AOBJN ptr
	movem tt,pwsptr		   ; update it in single instruction
	hrli d,(t)		   ; get AOBJN ptr to newly consed string
	movei x,pwstr(d)	   ; prepare to put the data there
	hrl x,b			   ; from our given string
	move tt,d		   ; Copy our AOBJN ptr to store when done
	sub d,t			   ; get idx of word after our string
	save [t,tt]
	hrrz t,x		   ; first page to be hacked
	lsh t,-12		   ; page # within job
	subi t,pwpage		   ; page # within file
	movei tt,pwstr-1(d)	   ; addr within job of last word
	lsh tt,-12		   ; page # within job of last word
	subi tt,pwpage		   ; page # of last word
	syscal corblk,[ argi %cbndr\%cbndw
			argi %jself
			argi pwpage(t)  ; page # within job
			argi pwdc
			argi (t)]
	  loss
	camn t,tt		   ; are they on the same page?
	  jrst pwspt2
	syscal corblk,[	argi %cbndr\%cbndw
			argi %jself
			argi pwpage(tt)  ; page # within job
			argi pwdc
			argi (tt)]  ; page # within file
	  loss
pwspt2:	blt x,pwstr-1(d)	   ; Move it!
	syscal pgwrit,[ argi pwpage(t) ]  ; Write the page
	  loss
	camn t,tt		   ; Are they on the same page?
	  jrst pwspt3		   ;   yes
	syscal pgwrit,[ argi pwpage(tt) ]  ; no, hack the second one too
	  loss
pwspt3:	restore [tt,t]
	pop sp,a
	movem tt,(a)		   ; Store our now-valid pointer
pwspt4:	call pulock		   ; unlock the database
	restore [tt,t,x,d]
	ret

pwspte:	pop sp,a
	setzm (a)		   ; No more string
	jrst pwspt4

;; now we gotta GC
pwsgc:	save [x,t,tt,a,b,c,d,e]
	hrrz d,pwsptr		   ; Let's see which space is NEW
	caige d,pistr0+pstrln	   ; Is NEW space = 0?
	  jrst [ movei d,pistr0   ; NEW space = 0
		 movei a,pistr1	   ; NEXT space = 1
		 movei b,pistr2	   ; and OLD space = 2
		 jrst pwsgca]
	caige d,pistr1+pstrln	   ; Is NEW space = 1
	  jrst [ movei d,pistr1   ; NEW space = 1
		 movei a,pistr2	   ; NEXT space = 2
		 movei b,pistr0	   ; and OLD space = 0
		 jrst pwsgca]
	caige d,pistr2+pstrln
	  jrst [ movei d,pistr2   ; NEW space = 2
		 movei a,pistr0	   ; NEXT space = 0
		 movei b,pistr1	   ; and OLD space = 1
		 jrst pwsgca]
	error /Illegal String space pointer in PWSGC/
	
;; state now is that OLD is in B, NEW in D, and NEXT in A
pwsgca:	hrli a,-pstrln		   ; make an AOBJN ptr to NEXT space
	skipn c,pwsgcp		   ; If GC not in progress
	  movem a,pwsgcp	   ;   remember our GC pointer
	skipe c			   ; If GC *WAS in progress
	  move a,c		   ;   use the old GC pointer
	movei t,(a)		   ; Compute page # of NEXT space in string
	idivi t,2000		   ; space   
	syscal CORBLK,[ argi %cbndr\%cbndw  ; Need read and write
			argi %jself
			argi pwpage+pwstpg(t)  ; NEXT space page 0
			argi pwdc
			argi pwstpg(t)]
	  loss
	syscal CORBLK,[ argi %cbndr\%cbndw
			argi %jself
			argi pwpage+pwstpg+1(t)  ; NEXT space page 1
			argi pwdc
			argi pwstpg+1(t)]
	  loss

	move t,[-pwstln,,pwstbg]   ; AOBJN ptr to strings to be GC'ed

pwsgc0:	skipl c,(t)		   ; Is there a string here?
	  jrst pwsgc1		   ;   no, ignore it
	movei x,(c)		   ; Get the index portion
	trz x,pstrln-1		   ; Flush where in space it is
	caie x,(a)		   ; Is it already in NEXT space?  Aborted GC
	  cain x,(d)		   ; Is it in NEW space?
	    jrst pwsgc1		   ;   yes, ignore it
	caie x,(b)		   ; Is it in OLD space?
	  error /Gubbish database-string pointer./
	move e,a		   ; Remember un-updated pointer
	hlre x,a		   ; Get -<room>
	hlre tt,c		   ; Get -<length>
	movns tt		   ; <length>
	add x,tt		   ; Get -<remaining room>
	jumpge x,pwsgcf		   ; If no room, go complain
	hrl a,x			   ; Update the amount of room
	addi a,(tt)		   ; Update the pointer
	movem a,pwsgcp		   ; Update it in memory
	movei x,pwstr(e)	   ; Get address to move to
	hrli x,pwstr(c)		   ; Address to move from
	blt x,pwstr-1(a)	   ; Move it!
	hll e,c			   ; Put length into AOBJN ptr
	movem e,(t)		   ; store the updated pointer
pwsgc1:	aobjn t,pwsgc0		   ; Next!
	movem a,pwsptr		   ; Be sure pointer is updated in memory
	setzm pwsgcp		   ; Saw we've finished our GC
	restore [e,d,c,b,a,tt,t,x]
	ret

; GC failure
pwsgcf:	type dspc,/AString space in the database is full.  You'll have
to make room first.
/
	call pulock
	jrst quit


ifn $$PAND,[

;;; PWSTXT reads text from the terminal and stores it into string space
;;; A contains address of AOBJN ptr to hack
;;; Skip-returns if successful

pwstxt:	save [b]
	save [a]
	type dspc,/Enter text, end with ^C
/
	call readtx		   ; Read in the text
	  jrst pwstxx
pwstx0:	restore [a]		   ; where to put it
	movn t,argcnt
	subi t,4
	idivi t,5		   ; get -<# of words required>
	camn tt,[-4]		   ;   Was it a multiple of 5 characters?
	  jumpn t,[ movns t	   ;   <# of words required>
		    setzm msgbuf(t)  ;   make into an ASCIZ string
		    aos t	   ;   including room for it
		    movns t
		    jrst pwstx1]
pwstx1:	hrl b,t			   ; build an AOBJN ptr
	hrri b,msgbuf
	call pwsput		   ; put it into the database
	restore [b]
	jrst popj1

pwstxx:	restore [a]
	restore [b]
	ret

pwslin:	save [b]
	save [a]
	type dspc,/AEnter 1 line of text:  /
	move bp,[440700,,msgbuf]
	call readln
	  jrst pwstxx
	jrst pwstx0


] ; END -- IFN $$PAND,

pwgtxt:	save [a,b]
	call pwsget
ifn $$PAND,[
	type dspc,/A  [/
	10type tyoc,a
	type tyoc,/ words long]
/
] ; END of IFN $$PAND,

	output tyoc,tmpbuf
	restore [b,a]
	ret


ife $$PAND,[
;;; This routine expects that PWDGET has been called

syschk:	move x,pdflag		   ;fetch the flag word
	tlne x,%pfbad		   ;is logging in from loser sites ok?
	  call sitchk		   ;  no, check it out!

	ldb x,[pi$sta pdinfo]	   ; Get the account state
	cain x,ps%new		   ; State=new?
	  error /State = PS%NEW, account should never be in this state/
	cain x,ps%apl		   ;has he applied for an account?
	  jrst [setzm ttyflg	   ;  be sure he sees this
	        type dspc,/AYour application has not yet been processed.
Please try later.
/
		jrst sysrfs]
	cain x,ps%sys		   ;is it a system name?
	  jrst [type dspc,/AThat is a reserved name, please choose another.
/
		jrst sysrfs]

	caie x,ps%rfs
	  cain x,ps%hld
	    jrst prob
	cain x,ps%off
	  jrst prob
	jrst popj1		   ;  nope, no problem
	cain x,ps%off		   ; Is it turned off?
	  jrst popj1		   ;   nope, no problem
prob:	type dspc,/AThat account has been /
	move t,uname		   ; UNAME will be used as the FN2
	cain x,ps%rfs		   ;refused?
	  jrst [ type tyoc,/denied.
/
		 movei b,rfsnam
		 call prtrsn
		 jrst rfsnot]	   ; Note that the refuse has been seen
	cain x,ps%off
	  jrst [ type tyoc,/temporarily turned off.
/
		 movei b,offnam
		 call prtrsn
		 jrst rfsnot]	   ; Note that the refuse has been seen

	cain x,ps%hld
	  jrst [ type tyoc,/placed on hold.
/
		movei b,hldnam
		call prtrsn
		jrst rfsnot]

	error /Unknown account state/

prtrsn:	call fn2opn
	  jrst sysrfs
	type tyoc,/Reason:
/
	call printf

sysrfs:	type dspc,/AAny questions may be directed to USER-ACCOUNTS
/
	ret


;; Note in flag word that he's seen this message

rfsnot:	movsi x,%pfmsg
	iorm x,pdflag
	jrst pwdput

;;; SITCHK checks if a login is from a bad site and if it is, it flushes the
;;; imposter.

sitchk:	movei a,losers		   ; AOBJN ptr for the table of losers
	call pwsget		   ; get the data from the database
	jumpe a,cpopj		   ; Check for empty BAD sites list.
	move tt,fhost		   ;where are we from?
sitch1:	camn tt,(t)		   ;is it a loser?
	  jrst [.suset [.smsk2,,[0]]  ;no interrupts!
	        .reset dspc,	   ;reset output
	        .reset tyic,	   ;reset input
		terpri
		6type tyoc,uname
		type tyoc,/ is restricted to the local area.
/
		move x,uname	   ;pretend the xuname is the uname
		movem x,pxuname
		call pwdwrn	   ;note this failure
		phaser]
	aobjn t,sitch1
	ret			   ;ok!

;;; DILTIM fails if a user is not authorized for this system load or this
;;; line.  It expects PWDGET to have been called

diltim:	ldb x,[pi$sta pdinfo]	   ; Get the account state
	cain x,ps%apl		   ;has he just applied?
	  jrst popj1		   ;  don't hack him
	move x,pdflag
	tlne x,%pfdil		   ;is he authorized for dialup?
	  pjrst timchk		   ;  yes, just check on the time
	ldb a,[pi$grp pdinfo]	   ; Get our group
	movei tt,1		   ; start with one bit
	lsh tt,(a)		   ; get the bit to check
	tdnn tt,pwgdil		   ; Is this group priveleged?
	  pjrst timchk		   ;   yes, let him on

	movei tt,1		   ;start with one bit

	move a,consol		   ;get consol # for bit shift
	lshc t,(a)		   ;shift it to it's position
	tdnn tt,dltty0		   ;is it a dialup?
	  tdne t,dltty1
	    jrst [ ldb a,[pi$grp pdinfo]  ; Get our group
		   movei a,dilmsg(a)  ; Get address of message AOBJN ptr
		   call pwgtxt	   ; Print the message
		   jrst sysrfs]

timchk:	skipn pwholp		   ;If this is a holiday
	 tlne x,%pfday		   ; Or if he authorized for daytime
	  jrst popj1		   ;   Let him go
	.ryear t,		   ;Check out the date
	ldb x,[320300,,t]	   ;Get the day of the week
	syscal rqdate,[val b]	   ; Disk date
	  seto b,
	camn b,[-1]		   ;Does the system know the time?
	  jrst [type dspc,/AThe system does not yet know the time, you cannot yet log in.
Please wait.  Someone is still in the process of bringing up the system,
and will soon fix the them, when you can log in.
/
	        jrst sysrfs]
	ldb a,[pi$grp pdinfo]	   ; Get the group index for this user
	movei t,(b)		   ; Get the time of day
	movss b			   ; Get the date in RH
	idivi t,2*60.*30.	   ; get # of 1/2 hours after midnight
	movei ct,6		   ; let's look at the six exception dates
	move d,[442200,,pwordt]	   ; Byte Pointer to exception dates
exday0:	ldb tt,d		   ; Get an exception date
	cain tt,(b)		   ; Is this the exception date?
	  jrst exday		   ;   yes, handle as exception
	sojg ct,exday0

	setz d,			   ; assume weekday
	cain x,0		   ; is it Sunday?
	  movei d,1
	cain x,6		   ; or Saturday?
	  movei d,2
	ldb c,[ dm$wds pwgrdm(a)   ; Get start time
		dm$sns pwgrdm(a)
		dm$sts pwgrdm(a)](d)

	ldb d,[ dm$wde pwgrdm(a)   ; Get end time
		dm$sne pwgrdm(a)
		dm$ste pwgrdm(a)](d)
	cain c,77		   ; no restriction on time-of-day?
	  jrst popj1		   ;   Yes, let him on!
	caml t,c		   ; Is it earlier than the restricted period?
	  caml t,d		   ;   or later than it?
	    jrst popj1		   ;     yes, let him on.
	terpri
	movei a,timmsg(a)
	call pwgtxt		   ; type it
	jrst sysrfs

exday:	movei tt,6		   ; # of override dates
	sub tt,ct		   ; get override date #
	imuli tt,-6		   ; # of bits 
	move c,pwgors(a)	   ; Get the override start times for our grp
	lsh c,(tt)		   ; Position this date's at bottom
	move d,pwgore(a)	   ; Get the override end times
	lsh d,(tt)		   ; Position this date's at bottom
	andi c,77		   ; Flush all others
	andi d,77
	cain c,77		   ; no restriction on time-of-day?
	  jrst popj1		   ;   Yes, let him on!
	caml t,c		   ; Is it earlier than the restricted period?
	  camle t,d		   ;   or later than it?
	    jrst popj1		   ;     yes, let him on.
	terpri
	
	imuli tt,20		   ; get idx for table of grp*date messages
	addi tt,a		   ; get index of our message
	movei a,timmsg(a)	   ; If no special message, print the usual...
	skipe ovrmsg(tt)	   ; Get the message for this group today
	  movei a,ovrmsg(tt)
	call pwgtxt
	jrst sysrfs

] ; END IFE $$PAND

ifn $$pand,[
spew:	call pwread
	 .logout 1,
	move x,[sixbit /FOO/]
	movem x,uname
	call pwdmak
	ret
]; end ifn $$pand


;;; Routine to read a password.

pwprmp:	type dspc,/APassword:  /
ife $$PAND,[
	move x,crgbts		   ;gotta get it again, TYPE flushes X
	trne x,cf$lms		   ;is he paranoid?
	  type dspc,/##%##&##$##=H*%**&**$**=*H%@#&@#$@#=@#H/
]
	ret

pwread:	setzm ttyflg		   ;turn on typeout so this is sure to be seen!
	move x,[call pwprmp]	   ;on re-display, re-prompt
	movem x,dsprmp
	call pwprmp
	setz count,		   ;count them
	move t,[440600,,pwbuf]	   ;point into our buffer
	setzm pwbuf		   ;clear out our buffer
	setzm pwbuf+1		   ;so that anything at the end is blank

pwrlop:	tyi			   ;get a character
	  ret			   ;  quiting, return
	  jrst [type dspc,/A(Enter your password, end with a carriage return)/
	        jrst pwread]	   ;tell him what's what and ask again

	  jrst [sosge count	   ;  keep track of count
	          jrst [movei d,11.  ;  over-rubout
		        call wipe  ;    so wipe it out
			setzm dsprmp  ;	and no more funny prompt
			terpri	   ;    don't wait to go to next line
			ret]	   ;	return to caller as failure
		setz ch,	   ;	clear out that char from our buffer
		dpb ch,t	   ;	so that it doesn't lose if end
		decbp6 t	   ;	and back up.
		jrst pwrlop]	   ;	still in the running, gobble another

	caie ch,^M		   ;is it a CR
	  cain ch,^C		   ;  or a ^C
	    jrst [setzm dsprmp	   ;    yes, no more funny prompt
		  jrst popj1]	   ;    then we've won!

	caige ch,140		   ;Convert to 6bit:  if it's small
	  subi ch,40		   ;convert it so numbers work out right

	aos count
	caig count,14		   ;if we've not had our fill
	  idpb ch,t		   ;  deposit this in our account
	jrst pwrlop		   ;and gobble down more.

;;; PWASK asks for a password, and skips if correct, and tries again if not

pwask:	call pwdak1
	  jrst [type dspc,/AIncorrect.
/
		call pwdwrn
		call pwdak1
		  pjrst pwdwrn	   ;    warn account of lossage!
		jrst popj1]
	jrst popj1

pwdak1:	call pwread		   ;read the password
	  jrst pwdak1		   ;  just return if he quits or rubs out
	push sp,pdpass		   ;save the real password
	call pwdmak		   ;create the password he just gave
	came t,(sp)		   ;is it the same as the saved one?
	  jrst [pop sp,pdpass	   ;  restore real password
		.reset tyic,	   ;  flush typeahead, like multi-CR lossage
	        ret]		   ;  and fail-return
	pop sp,pdpass		   ;restore real password
	jrst popj1		   ;and success return

pwdwrn:	skipn t,pxunam		   ;do we have a bug?
	  error /PWDWRN detected null PXUNAM/

logit:	movei b,lognam
	syscal open,[cnti .uao\100000  ;write over mode
	       argi dsko
	       (b)
	       1(b)
	       2(b)
	       3(b)]
	  ret			   ;  if failed, don't bother.
	syscal fillen,[argi dsko ? val x]  ;get end position
	  ret
	syscal access,[argi dsko ? x]  ;and go there
	  ret
	6type dsko,uname
	.iot dsko,[^I]
	output dsko,hstnam	   ; Output the foreign host name
	skipe tipnum
	  jrst [ tyo dsko,["#]
		 8type dsko,tipnum
		 jrst .+1]
	.iot dsko,[40]
	8type dsko,consol
	.iot dsko,[40]
	call datime"timget	   ;get the time
	push sp,a		   ;save the time word for later
	call datime"timdow	   ;convert to day of week
	
	output dsko,@datime"dowlng(b)  ;print it into the file
	type dsko,/, /

	move d,[440700,,msgbuf]	   ;put the date down msgbuf
	pop sp,a		   ;get thhe time word
	call datime"timexp
	output dsko,msgbuf	   ;output the stuff in the input buffer
	skipl linkno		   ; is this under link?
	  call lnklog
	type dsko,/
/
	.close dsko,
	ret

lnklog:	type dsko,/	Link from TTY #/
	8type dsko,linkno
	type dsko,/, UNAME = /
	6type dsko,linker
	ret

ifn $$pand,[

pwdel:	call plock		   ;lock the password database
	call pwdlkx		   ;find the beggar
	  pjrst pulock		   ;  trivial case, not there
	movei t,(a)		   ;Get pointer where we expect it
	tlne t,3		   ;it must not be odd
	  jrst [call pulock	   ;  unlock the password database
		error /Odd length password file./]
	idivi t,2000		   ; T <= page # in data area
	movei t,pdpage(t)	   ; Get page # in file
	movei b,(t)		   ;save it for when we re-purify
	syscal corblk,[cnti %cbndw ;gotta write it.
	       argi 0
	       argi %jself
	       argi pwpage(t)
	       argi pwdc
	       argi (t)]
	  jrst [call pulock	   ;unlock the password database
		error /Can't write password file./]
	move t,pwcnt
	hrlzi tt,pwdata(t)	   ;LH(TT) <- pointer to last password
	hrri tt,pwdata(a)	   ;RH(TT) <- new home for last password
	blt tt,pwdata+pwleng-1(a)  ;move one entry
	move x,pwcnt
	subi x,pwleng		   ;subtract off one entry from total
	movem x,pwcnt
	syscal corblk,[cnti %cbndr ;make read-only again
	       argi 0
	       argi %jself
	       argi pwpage(b)]
	  loss			   ;eh?  We're all fucked up!
	call pulock		   ;all done, unlock the database
	jrst popj1		   ;successful return

pwprul:	call stinit
         jfcl
	call maplsr
	setz d,			   ; start counting
pwpru0:	movei a,lsrc
	move x,pwname(d)	   ; Get the UNAME
	call pwdunm		   ; un-decode it
	move b,uname		   ; store it
	call lsrtns"lsrunm	   ; Is he in INQUIR?
	  caia
	    jrst pwpru9		   ;   Yes, don't print it
	call usrprt		   ; print the info on this user
	  ret			   ;   typeing flushed
pwpru9:	addi d,pwleng		   ; Next user
	camg d,pwcnt		   ; are we at the end yet?
	  jrst pwpru0		   ;   Nope, keep on trukin'
	pjrst pstats		   ;   Yep, all done, so let's print some stats


;;; Routine to print out null-passwords users.

pwprnl:	save [a,b]
	call maplsr		   ; Ensure INQUIR mapped
	setz d,			   ; D points to account entry
pwprn1:	move a,d
	call pwdget		   ; Fetch password and UNAME
	move b,pdpass
	setzm pwbuf		   ; Null password
	setzm pwbuf+1
	call pwdmak		   ; Get the encrypted form into T
	camn t,b		   ; Same?
	 jrst [	call usrprt	   ;   Yes - print info for this luser
		 jrst pwprn9	   ;    (typing flushed)
		jrst .+1 ]
	addi d,pwleng		   ; Pointer to next luser
	camg d,pwcnt		   ; Are we at the end yet?
	 jrst pwprn1		   ;   Nope, keep on trukin'
pwprn9:	restore [b,a]
	ret


;;; Routine to print out never-logged-in users.

pwprnw:	call stinit
         jfcl
	call maplsr
	setz d,			   ; start counting
pwprw0:	move x,pwflag		   ; Check the flags
	tlnn x,%pfnew		   ; Has he ever logged in?
	  jrst pwprw9		   ;   Yes, don't print him
	call usrprt		   ; print the info on this user
	  ret			   ;   typeing flushed
pwprw9:	addi d,pwleng		   ; Next user
	camg d,pwcnt		   ; are we at the end yet?
	  jrst pwprw0		   ;   Nope, keep on trukin'
	pjrst pstats		   ;   Yep, all done, so let's print some stats


pwdprt:	call stinit		   ;initialize statistics and print leading
				   ;info 
	  jfcl			   ;  We've gotta grovel over them anyway...
	type tyoc,/
Data follows:
/
	setz d,			   ;start counting, bud.
	move c,crgbts		   ;check out whether we are brief mode
	trnn c,CF$PBF		   ;are we?
	  call maplsr

prtlop:	skipe allflg		   ;are we printin extra info?
	  type dspc,/A_________________________

/
	call usrprt		   ;print out the entry
	  ret			   ;  typeing flushed
	addi d,pwleng		   ;next entry
	camg d,pwcnt		   ;are we at the end yet?
	  jrst prtlop		   ;keep on trukin'
	pjrst pstats		   ;  yep, all done, so let's print some stats


pwdsts:	call stinit		   ;initialize status counts and print leading
	  pjrst pstats		   ;info 
	setz d,			   ;start counting, bud.
	call maplsr

psdst1:	move a,d		   ;PWDGET expects pointer in A
	call pwdget		   ;get the entry to have stats counted
	call gstats		   ;get the flag stats
	movei a,lsrc		   ;tell LSRTNS what channel it can hack
	move b,uname		   ;ask about this UNAME
	call lsrtns"lsrunm	   ;is it there?
	  jrst [aos pnonam	   ;  count how many of these there are
		jrst psdst3]		   ;  Don't hack INQUIR any more!
	movem b,lsrptr		   ;save pointer to this entry
	movei a,lsrtns"i$grp	   ;find his group
	call lsrtns"lsritm
	  jrst [aos ptype	   ;  count it
	        jrst psdst3]		   ;  nothing to do

	move t,a		   ;copy it
	ildb ch,t		   ;check it out
	cain ch,0		   ;is it null?
	  jrst [aos ptype	   ;  count it
	        jrst psdst3]		   ;  and don't bother otherwise

	cail ch,140		   ;upper-casify
	  subi ch,100
	subi ch,40		   ;make it into 6bit
	skipge ch		   ;make ssure it's in range
	  setz ch,
	aos ptype(ch)		   ;count the beggar
psdst3:	addi d,pwleng		   ;net one!
	camg d,pwcnt		   ;are we at the end yet?
	  jrst psdst1		   ;keep on trukin'
	pjrst pstats		   ;  yep, all done, so let's print some stats

	
stinit:	tyo dspc,[^P]		   ;clear the screen
	tyo dspc,["C]
	move x,pwcnt		   ;check the count
	trne x,3		   ;is it off?
	  do [type tyoc,/
The count is out of phase!
Count = /
	  8type tyoc,pwcnt
]
	type tyoc,/
Last modified by:  /
	6type tyoc,pwuhak
	tyo tyoc,[40]
	6type tyoc,pwjhak
	type tyoc,/
Access count:  /
	10type tyoc,pwaccc
	terpri
	move x,pwaccc		   ;get this access count
	camn x,opwacc		   ;is it still the same?
	  ret			   ;  yes, don't bother
	movem x,xpwacc		   ;remember...
	setzm ptype		   ;clear ptype
	move x,[ptype,,ptype+1]
	blt x,cntend		   ;all of them!

	jrst popj1


pstats:	move x,xpwacc		   ;remember when we started
	movem x,opwacc
	type tyoc,/
*** Statistics ***

Total users:  /
	move x,pwcnt		   ;calculate # of entries
	idivi x,pwleng
	movem pwbuf		   ;temporary spot
	10type tyoc,pwbuf	   ;# of users in decimal!
	type tyoc,/
*'s:  /
	10type tyoc,pnull
	type tyoc,/  +'s:/
	10type tyoc,pzunam
	type tyoc,/
Flag counts:
SYSTEM	APPLIED	NEW	REFUSED	NODAY	NODIAL
/
irp flg,,[sys,apl,new,rfs,day,dil]
	10type tyoc,pz%!flg
	tyo tyoc,[^I]
termin

	type tyoc,/
1
Breakdown by INQUIR group:
Group	Count
-----	-----
/
	move t,[-100,,0]	   ;index into PTYPE table

pstat1:	skipe ttyflg		   ;if TTY is off
	  ret			   ;  don't bother any more
	skipn ptype(t)		   ;if it's zero
	  jrst [aobjn t,pstat1	   ;  loop
	        terpri		   ;    until the end
		ret]
	hrrz ch,t		   ;get the character
	addi ch,40		   ;convert to ascii again
	tyo tyoc,ch		   ;type it out
	tyo tyoc,[^I]		   ;tab over for count

	push sp,t		   ;save T, we need it!
	10type tyoc,ptype(t)	   ;type it out
	pop sp,t		   ;restore T

	terpri			   ;new line
	aobjn t,pstat1		   ;loop until the end
	  ret			   ;  that's it.

;;; print out the database data for a user.  USRWHO is for pre-calculated UNAME
;;; and USRPRT is for having a pointer to entry in D.

usrprt:	skipe ttyflg		   ;was the TTY turned off?
	  ret			   ;  yes, stop printing
	push sp,a		   ;takes pointer in A
	move a,d
	call pwdget		   ;get the entire entry
	pop sp,a
	call usrwho		   ;print out the stuff!
	  aos pnonam		   ;  count how many of these there are
pwprt8:	call fstats		   ;get the stats for the flags
	jrst popj1		   ;skip return

;;; USRPRI skips if there is an INQUIR entry, and prints the name, etc.
;;; takes uname in UNAME
;;; clobbers PWBUF

usrpri:	move bp,[440700,,msgbuf]
	aos (sp)		   ; Skip unless USRPR2 doesn't
	call usrpr2		   ; compute up the text
	  sos (sp)		   ;   (no INQUIR entry)
	setz ch,		   ; be sure to end with NUL
	idpb ch,bp
	output tyoc,msgbuf	   ; output it to the TTY
	ret


;;; USRDAT skips if there is an INQUIR entry,
;;; takes UNAME in UNAME
;;; clobbers PWBUF
;;; assumes password info already in PDBUF
usrdat:	move x,uname
	idpb6 x,bp		   ; write the uname
	tyobpi bp,^I
	setom nodate		   ; suppress creator/modifier date info
	jrst usrdt0

;;; USRPR1 skips if there is an INQUIR entry.
;;; takes uname in UNAME
;;; clobbers PWBUF

usrpr1:	move tt,uname		   ;get it
	movem tt,pwbuf		   ;as password as well
	setzm pwbuf+1		   ; (second word 0)
	move x,uname		   ; Get the uname
	idpb6 x,bp		   ;type it out
	tyobpi bp,^I		   ;space over to column for that
	call pwdlok		   ;find this user
	  pjrst [write bp,/	[NEW]	/
		 call pwdcns	   ;  cons up an entry
		 jrst usrpr2]	   ;  go handle the INQUIR end of it
	call pwdget		   ;and get his data
usrdt0:	call uflgp0		   ;print his flags
usrpr2:	skipe brfflg		   ;are we supposed to be brief?
	  ret			   ;  yes, just return
	tyobpi bp,^I		   ;Tab over to NAME column!
	call grplsr		   ;get the group for this loser
	  jrst [write bp,/  (No INQUIR entry)/
		jrst usrdpr]	   ;  and just print his name
	idpb ch,bp
	movem ch,lstgrp		   ;remember it for SCAN
	subi ch,40		   ;make it into 6bit
	skipge ch		   ;make ssure it's in range
	  setz ch,
	aos ptype(ch)		   ;count the beggar

pwprt3:	movei a,lsrtns"i$rel	   ;find his relationship
	call lsrget
	  movei ch,40		   ;  substitute a space
	upper ch
	idpb ch,bp
	tyobpi bp,40
	move b,lsrptr
	movei a,lsrtns"i$name	   ;find his name
	call lsrtns"lsritm
	  jrst [write bp,/-=> [His INQUIR entry is missing his NAME!!]/
		jrst usrdpr]	   ;  unsuccessful
	move b,bp		   ;where to get his name
	call lsrtns"lsrnam	   ;get his name in human-readable form
	  jfcl			   ;  eh?
	move bp,b		   ; Recover the byte pointer
	decbp bp		   ; back over the null
usrdpr:	hrlz a,pddate		   ; Get last login date
	tyobpi bp,^I
	call datwrt
	skipe nodate		   ; If we don't want the date,
	  ret			   ;   don't print the rest of this stuff
	movei a,pwadmn
	call pwsget		   ; Get the table of creators
	write bp,/
  Creator:  /
	ldb tt,[pi$crt pdinfo]	   ; Get the creator index
	jumpe tt,[ write bp,/Unknown  /
		   jrst usrpx0]
	move tt,tmpbuf-1(tt)	   ; Get the name
	idpb6 tt,bp		   ; Include it in our output
	write bp,/  /
usrpx0:	hllz a,pddate
	call datwrt
	write bp,/,  Last Mod:  /
	ldb tt,[pi$mod pdinfo]	   ; Get the last modification index
	jumpe tt,[ write bp,/Unknown  /
		   jrst usrpx1]
	move tt,tmpbuf-1(tt)
	idpb6 tt,bp
	write bp,/  /
usrpx1:	hllz a,pdmod
	call datwrt
	write bp,/
/
	jrst popj1


datwrt:	save [d]
	hlre d,a
	skipe d
	  aosn d
	    jrst [ write bp,/[Date Unknown]/
		   jrst datwrx]
	move d,bp
	call datime"datasc
	move bp,d
datwrx:	restore [d]
	ret

datprt:	save [d]
	hlre d,a		   ; If date part is -1
	skipe d
	  aosn d
	    jrst [ type tyoc,/[Date Unknown]/
		   jrst datprx]
	move d,[440700,,msgbuf]
	call datime"datasc	   ; deposit date into MSGBUF
	output tyoc,msgbuf	   ; Type it
datprx:	restore [d]
	ret

;;; UFLGPR prints the user's flags
uflgpr:	move bp,[440700,,msgbuf]
	call uflgp0
	setz t,
	idpb t,bp
	output tyoc,msgbuf
	ret

uflgp0:	ldb t,[pi$grp pdinfo]	   ; Get his group
	move t,pwgnam(t)	   ; get the group's name
	idpb6 t,bp
	tyobpi bp,^I

	ldb tt,[pi$sta pdinfo]	   ; Get the state of this account
	cain tt,ps%del		   ; if this account is deleted
	  move tt,delsta	   ;   Get the state before deletion
	cain tt,ps%new		   ; Is this a new account?
	  jrst [ write bp,/[NEW] / ;   note the fact
		 jrst .+1]
	cain tt,ps%sys		   ;is this a system name?
	  jrst [ write bp,/[SYS] / ;  note the fact
		 jrst .+1]
	cain tt,ps%rfs		   ;is he refused?
	  jrst [ write bp,/[RFS] /
		 jrst .+1]
	cain tt,ps%off		   ; Temporary hold?
	  jrst [ write bp,/[OFF] /
		 jrst .+1]
	cain tt,ps%hld		   ;account on hold?
	  jrst [ write bp,/[HLD] /
		 jrst .+1]
	cain tt,ps%apl
	  jrst [ write bp,/[APL] /
		 jrst .+1]
	cain tt,ps%ok
	  jrst [ write bp,/[OK]  /
		 jrst .+1]
	push sp,pdpass		   ;save the users password
	call pwdmak		   ;cons up the password
	pop sp,pdpass		   ;restore the world
	camn t,pdpass		   ;is it the same Pword and UNAME?
	  jrst [ tyobpi bp,"+	   ;  yes, print + to note it
		 aos pzunam	   ;  and count it
		 jrst uflgp1]
	skipn pdpass		   ;is the password null?
	  jrst [ tyobpi bp,52	   ;  and mark this oddity
		 aos pnull	   ;  count the odities
		 jrst uflgp1]

	tyobpi bp,40

uflgp1:	tyobpi bp,40
	move tt,pdflag		   ;check the flags
	tlze tt,%pfnew		   ;is this new?
	  jrst [ tyobpi bp,"!
		 jrst .+1]
	tlze tt,%pfday		   ;daytime?
	  jrst [ tyobpi bp,"L	   ; (L for Load)
		 jrst .+1]
	tlze tt,%pfdil		   ;dialups?
	  jrst [ tyobpi bp,"T	   ; (T for Telephone)
		 jrst .+1]
	tlze tt,%pfbad		   ;forbid bad sites?
	  jrst [ tyobpi bp,"B	   ;  (B for Bad)
		 jrst .+1]
	tlze tt,%pfmsg		   ; Seen REFUSE/OFF message?
	  jrst [ tyobpi bp,"S	   ;  (S for Seen)
		 jrst .+1]
	skipe tt		   ;Other bits on?
	  call flgerr		   ;  Yes!  Warn of it!
	ret

;;; GSTATS takes stats on an entry in PDATA buffer
;;; FSTATS takes just the flag stats.

gstats:	move tt,pdunam		   ;get the name...
	sub tt,[742532,,732643]	   ;Will oddities never cease?
	rot tt,-13
	movem tt,uname		   ;save it for later
	movem tt,pwbuf		   ;as password as well
	setzm pwbuf+1		   ; (second word 0)
	skipn pdpass		   ;is the password null?
	  aos pnull		   ;  count the odities
	push sp,pdpass		   ;save the real password
	call pwdmak		   ;cons up the password
	pop sp,pdpass		   ;restore the original password
	camn t,pdpass		   ;is this the original password?
	  aos pzunam		   ;  count how many of these there are
fstats:	ldb x,[pi$sta pdinfo]	   ; Get the state
	cain x,ps%apl		   ; PS%APL?
	  aos pz%apl
	cain x,ps%rfs		   ; PS%RFS?
	  aos pz%rfs
	cain x,ps%off		   ; PS%OFF?
	  aos pz%off
	cain x,ps%hld		   ; PS%HLD?
	  aos pz%hld
	cain x,ps%sys		   ; PS%SYS?
	  aos pz%sys
	move x,pdflag		   ; check out the flag word
	tlze x,%pfnew		   ; %PFNEW?
	  aos pz%new
	tlze x,%pfday		   ; %PFDAY?
	  aos pz%day
	tlze x,%pfdil		   ; %PFDIL?
	  aos pz%dil
	tlze x,%pfbad		   ; %PFBAD?
	  aos pz%bad
	tlze x,%pfmsg		   ; %PSMSG?
	  aos pz%msg
	skipe x			   ;that should be all
	  call flgerr		   ;  It's not, warn of it
	ret



;;; routine to warn of a flag word having bits on that it's not supposed to
flgerr:	type dspc,/AFIE!!!  Bad flag word found.
Index = /
	8type tyoc,pdloc	   ; It may change, but...
	type dspc,/AUNAME = /
	6type tyoc,uname
	type dspc,/APDFLAG = /
	htype tyoc,pdflag	   ; type it out in half-words
	type dspc,/ACall CSTACY!!
/
	ret

.upure

ptype:	block 100		   ;count of each group

pnonam:	0			   ; count of no-names
pzunam:	0			   ; count of entries with UNAME=Password
pnull:	0			   ; count of null entries
pz%apl:	0			   ; count of PS%APL's seen
pz%sys:	0			   ; count of PS%SYS's seen
pz%new:	0			   ; count of %PFNEW's seen
pz%rfs: 0			   ; count of PS%RFS's seen
pz%off:	0			   ; count of PS%OFF's seen
pz%hld:	0			   ; count of PS%HLD's seen
pz%dil:	0			   ; count of %PFDIL's seen
pz%day:	0			   ; count of %PFDAY's seen
pz%bad:	0			   ; count of %PFBAD's seen
pz%msg:	0			   ; count of %PFMSG's seen

cntend:	0			   ;dummy, end of cleared entries

pwaddf:	0			   ;non-zero if we want to append rather than
				   ;replace

opwacc: 0			   ;stats uses this to notice changes
xpwacc:	0			   ;count when STATS was started

.pure

] ; END IFN $$PAND,

.upure
lsrptr:	0			   ;pointer into INQUIR database

pxunam:	0			   ;UNAME being hacked
pdloc:	0			   ; Where this entry was found

delsta:	0			   ; State of account before deletion
popass:	0			   ; Password before setting

pdata::				   ;block of data containing info for one user
pdunam:	0			   ;temporary for encoded uname word
pdpass:	0			   ;temporary for encoded password word
pdflag:	0			   ;temporary for database flag word
pdinfo:	0			   ; temporary for misc. info word
pddate:	0			   ; temporary for creation/login date word
pdmod:	0			   ; temporary for modification date word
	0			   ; empty
pdmore:	0			   ;temporary for database extra word

newflg:	0			   ;new flag for PWDCHG to use in place of old


.pure
p==sp				   ;synonym for LSRTNS and RFN


$$ulnp==0			   ;don't assemble in last-name prefix-matcher
$$ulnm==0			   ;Don't assemble in last-name finder
$$hsnm==1			   ; DO assemble in HSNAME hackery
.insrt syseng;lsrtns

;;; Basically wining file name reader goes here.

$$MNAME==0			   ;We want DSK: to print as DSK:
$$RFN==1			   ;we want to read them.
$$PFN==1			   ;we want to print them
$$SWITCH==0			   ;we don't allow switches
$$PFNBRF==0			   ;we don't use short forms.
$$RUC==0			   ;the default means of reading is adaquate.

.insrt syseng;rfn

;;; basically winning time printer goes here.
$$out==1			   ;we want the output routines.
$$outz==1			   ;fancy time zones, etc.
$$outt==1			   ;and the tables of days of the week

.insrt syseng;datime

.insrt sysen1;pwfile

$$HST3==1			   ; Use HOSTS3 database
$$ARPA==1			   ; Support ARPA hosts
$$CHAOS==1			   ; Support CHAOS hosts
$$HSTCMP==1			   ; Routine to compare host addresses
$$OWNHST==1			   ; Routine to get our host address
$$HSTMAP==1			   ; Host table routines
$$SYMGET==1			   ; Completing host-name reader
$$HOSTNM==1			   ; Host-name lookup

.insrt syseng;netwrk

popj1:	aos (sp)		   ;popskip
cpopj:	ret

;;; Input/Output Routines for NETWRK package.

netwrk"getchr:
	tyi
	  caia
	  movei ch,"?
	  jfcl
	movei t,(ch)
	jrst popj1

netwrk"putchr:
	tyo tyoc,t
	idpb t,bp		   ; Remember it for the mail
	ret

netwrk"spchan:
	caie ch,^G
	  cain ch,^D
	    ret
	jrst popj1





;;;; Command table definitions go here
cmdtab:

ife $$pand,[
command ACOUNT,,kacount,,,,/For information about getting an account, do
:ACOUNT
/,/Applications for accounts can sometimes be done online.
Do :ACOUNT to find out if online applications are being accepted.  
If they are, simply answer the questions which :ACOUNT asks you,
and a USER-ACCOUNTS person will process your application quickly.
If you are in a particular hurry, you may contact USER-ACCOUNTS
people by sending network mail to USER-ACCOUNTS.  
You should come back later and check if your account has been approved
by attempting to log in.
/

command LOGIN,,klogin,(%cocrg+%coarg),[
CF$LPW				   ;password,pw,change
CF$LNI				   ;noinit,brief,bf
CF$LMS				   ;mask

],/Identify yourself to the machine.
Type :LOGIN <name> <optional arguments>

(If you do not have a password, do :HELP ACOUNT
for information.)
/,/
The LOGIN command takes any of the following optional arguments:
-change or -ch		change your password after you log in
-password or -pw	change your password after you log in
-brief or -bf		don't run your init file
-noinit			same as -brief
-mask			print a mask over where the password will print
/
command TCTYP,,jtctyp,(%cojcl),,,/Set terminal type
/,/Runs the TCTYP program to set your terminal type. 
Do :TCTYP HELP
for more info.
/

command LUSER,,jluser,(%cojcl),,,/Ask people for help.
/,/Asks certain people (if they're logged in) for help.
/

command ITS,,,(%cotop),,,/Information about this system.
/,/You are connected to a PDP-10 computer running the ITS operating
system.  ITS stands for Incompatible Timesharing System, and was
written at the MIT Artificial Intelligence Laboratory.

To request assistance from any available user, you may do :LUSER.
/

command JCL,,,(%cotop),,,/JCL is additional information that you give a command.
(Note:  This is not like IBM Job Control Language!)
/,/It is typed on the same line following the command, and is usually
terminated with a carriage return.  The only common exception to
this is terminating the :SEND and :MAIL commands with ^C (control-C)
causes them to send immediately.
/

command PRINT,,kprint,(%cojcl\%cofil),,,/Print a file.
/,/:print <file>
prints a file.  Files are in the format <device>:<directory>;<name1> <name2>
where each field is six characters or less.

Device defaults to DSK:, <directory> defaults initially to a user's
directory, or USERS for people without directories, or .INFO. if you aren't
logged in yet.

You may use an [ALTMODE] (sometimes labelled ESC or ESCAPE) to print the
defaults.  [ALTMODE] prints as a dollar sign.

/

;;;  QUIT will tell him how to do what's he's looking for.
;;;  also in LOGOFF, BYE, etc. variations

command QUIT,,kquit,(%conls\%cohlp),,,//,//

command LOGOUT,,klogout,(%cocrg),[
CF$LBY				   ;bye
],/Terminate connection with this machine.
/,/The :LOGOUT command should always be given when you are done
using the system to clean up any jobs you may have and close your
connection.
The -bye option runs the BYE program before logging you out.
/

]; END IFE $$PAND

ifn $$PAND,[

command quit,,klogou,(%cocrg),,,/Quit out of the program
/,//

command DELETE,,kkill,(%coarg),,,/Delete a name from the database
/,/Takes the name as an argument.
/

command SET,,USRSET,(%COARG\%COCRG),[
CF$SSY				   ;system
CF$SPW				   ;password,pwd,p
CF$SDY				   ;day
CF$SND				   ;nday
CF$STL				   ;dial
CF$SNT				   ;ndial
CF$SRF				   ;rfs,refuse
CF$SHL				   ;hold,hld
CF$SBD				   ;bad
CF$SNB				   ;nbad
CF$SOF				   ;off
CF$SOK				   ;ok,on
CF$GRP				   ;group,grp,gr
],/Set a user's password and other attributes.
/,/If the user is not in the database, it defaults his password to his UNAME
Control arguments:

PASSWORD
  -pass, -pw, -pwd	Set his password
FLAGS
  -day			Override group restriction for daytime use
  -nday			Remove override of group restriction for daytime use
  -dial			Override group restriction for dialup use
  -ndial		Remove override of group restriction for dialup use
  -bad			don't allow to log in from bad sites
  -nbad			undo a -bad
GROUP
  -group, -grp		User Group
STATE
  -ok, -on		Turn an account on
  -off			Turn an account off
  -refuse, -rfs		Denies this user an account.
  -hold, -hld		hold this account for more info
  -system, -sys		This is a reserved system name.
/

command VAR,,kvar,%coarg,,,\Examine/Set a database variable.
\,\VAR <varname>
You will be asked if you wish to set it.  If so, you will be
prompted for additional information.

Do "VAR <cr>" to list variables which can be examined/modified.
\

command GROUP,,grpset,%coarg,,,\Examine/Modify group characteristics.
\,\Interactively examine and modify groups' restrictions.
\

command FIND,,kfind,(%cojcl\%coarg\%cocrg),[
CF$PBF				   ;bf,brf,brief
],\Find out which accounts someone has created.
\,\ FIND <creator> [-BRIEF]

All the accounts created by <creator> are listed in the output file
which you will be asked for. If you specify the -BRIEF option, only
the unames will be listed; otherwise you will also get their names and
status of the account.
\

command CHECK,,kcheck,,,,\Checks a list of users to see if they are accounts.
\,/CHECK reads a file of UNAMES (there should be one on each line) and
produces another file which tells you which UNAME's corrsponded to
valid accounts in the PWORD database.  You are prompted for both the
input and output file. You are also asked if the output file should
list people with accounts, or the unknown UNAMEs.
/

command PRINT,,kuprin,(%coarg\%cocrg),[
CF$PBF				   ;bf,brf,brief
CF$PAL				   ;all
CF$PND				   ;nodate

],\Print out the users in the database.
\,\Also gives various statistics as in the STATS command
PRINT <user> <cargs> <CR> prints info on a single user.
PRINT * <cargs> or :PRINT<CR> prints out data on all users.
PRINT *UNKNOWN prints information on users without INQUIR entries
PRINT *NEW prints information on people who have never logged in.
PRINT *NULL prints information on people with null passwords.

Optional control args:
-all		list all of the information from INQUIR on this person
		If the -ALL option is given, the HOLD or REFUSE or APPLY file
		for this user will be printed.
-brief		Don't even list his name!  Much faster if you are listing all
		users with :PRINT ALL or :PRINT<CR>
-nodate		Don't list the creator and modifier (and dates)

What is printed for a user without the -ALL option is as follows
<UNAME> <group> <state> <pw> <FLAGS>	TU <human-style-name>	 <login date>
  Creator:  <uname> <date;  Last modification:  <uname> <date>

The T column is his INQUIR group, the U column is his INQUIR affiliation.
<group> is one of the 16 different user groups listed by the GROUP command.
<state> is one of the following: [NEW] [APL] [OK] [RFS] [HLD] [OFF] [SYS]
<pw> is *, +, or blank, for a password of null, UNAME, or other

Flags are as follows:
!	Never logged in.
L	Allowed daytime use, overriding his GROUP. [-NDAY]
T	Allowed dialup (Telephone) use, overriding his group [-NDIAL]
B	Don't allow this person on from bad sites.
S	Has seen his REFUSE/OFF/HOLD file.
\


command SCAN,,KSCAN,(%COARG),,,/Map over the database, asking what to do with each
user matching a given condition.
/,/
Conditions currently include ALL, NEW, APPLY (APL), SYSTEM (SYS),
REFUSE (RFS), and HOLD (HLD), unknown users (UNK), and INQUIR
(INQ) which reads a line of INQUIR groups to scan for.
Options for actions are:

N -- Not.  Do the opposite of next given option.  Reads another char.
A -- Authorize
B -- Bad ... disallow logins for this name from bad sites
D -- Delete
R -- Refuse account
H -- Put on hold
O -- Temporarily turn account OFF
T -- Authorize for Telephone
L -- Authorize for Loaded Hours
I -- Ignore this entry (Go on to next)
X -- Perform the operations.
^D and [RUBOUT] reset the entry
[RETURN] simply allows the entry
[SPACE]  goes onto next entry

USAGE:  ":SCAN APPLY"
It will then print out info on each user who has applied but not been
processed, then prompt for one of the above characters.
/

command STATS,,pwdsts,,,,/Print out statistics on the password database.
/,/Includes such things as # of people in each INQUIR group.
/

]  ; END IFN $$PAND

command SEND,,KSEND,(%COSND),,,/SEND a message to a user.
/,/:SEND <user> <message>^C sends <message> to <user> immediately
if he is logged in.  If he is not logged in or is not receiving
messages,  it will be mailed.  The <message> may be more than
one line long. The form "User@Host" does not work for SEND.
type ":SEND ?" for more help.
/

command NAME,,J.NAME,(%COJCL),,,/See what users are running what jobs. (FINGER)
/,/If given no JCL (do :HELP JCL), it prints TTY #'s, user-names (UNAME's),
full names, the job they are currently running, and where they are from.
If given JCL, that should be in the form
NAME <name>@<site>,<name>@<site>,....
<name> is the user you want to find out about, or everyone at that site
if you omit it.  "@<site>" if omitted defaults to the site you are on.
/

command host,,J.HST,(%COJCL),,,/Look up information about a network host.
/,/Given a host name or host address, tells you all the names and addresses
of the host and what protocols it supports.
/

command sstatu,,ksstat,,,,\Print out info on system/version etc.
\,/This is like the :VERSIO and :SSTATU commands combined.
Fair share is a measure of system load, if it is less than
about 40% you might wish to try when it is less crowded.
/

command loadp,,jloadp,,,,/See how loaded the system is.
/,/This prints out various pieces of information about how
many system resources are in use.
/

command whoj,,jwho,(%COJCL),,,/See what users are running what jobs.
/,/This is like WHO except that it prints out what job 
a person is currently in.
/

command bug,,jmail,(%cojcl),,,/Mail a bug report to a program's maintainers.
/,/Runs the mail program, but it takes the name of a program instead of a
person.  It will send mail to the people who maintain a given program.
You should try to give any information that would help reproduce the problem.
Usage is:
:BUG MACSYMA
The MACSYMA program has gross bugs.
^C
/

command who,,jwho,(%COJCL),,,/See who is logged in at a site.
/,/Differs from :WHOJ and :FINGER in that it only prints TTY# and user-name,
The format of the JCL (See :HELP JCL) is:
:WHO AI
to find out who is on AI.
/

command date,,jdate,(%cojcl),,,/Types time and date.
/,//

command time,,jtime,(%cojcl),,,/Types the time of day.
/,//

command times,stime,jtimes,(%cojcl),,,/Types times from several different machines.
/,//

command timoon,,jtimoo,(%cojcl),,,/Types time of day, and the phase of the moon.
/,//

command octpus,,joctps,(%cojcl),,,/A program to read and echo characters.
/,/For testing terminals and finding out what your terminal sends.
/

command WHOIS,,j.name,(%cojcl),,,/Print out info on who a person is.
/,/If given no JCL (Do :HELP JCL), it does it for everyone who is logged in.
If given JCL, it should be the login name of a person, or his last name.
It will print out relevant info on that person.  (A more extreme :NAME)
/

command help,,khelp,(%coarg\%cocrg\%coopt),[
CF$HAL				   ;all
CF$HBF				   ;bf,brief

],/Print help on commands and concepts.
Takes a single argument of the command to print help on.
/,/
This command only exists before you log in.

:HELP optionally takes the following after it's argument:

-bf	Brief.  This just prints the first line of the documentation.
	:HELP ALL -bf just prints the names of the commands.

Also, there is often help available by typeing H or ?, until you log in.
/

command mail,,jmail,(%cojcl),,,/Send mail to a user or users.
/,/This runs the mail program.  It takes a login-name as JCL
(See :HELP JCL) and sends mail to that user.  Terminate the message
with a Control-C.  More documentation on the :MAIL program may be
obtained by doing:
:MAIL <user>
<altmode>H?
/

command prmail,,kprmai,(%coarg),,,/Read a user's mail.
/,/:PRMAIL <user>
prints a users mail file.
/

command prsend,,kprsen,(%coarg),,,/Print a user's SENDS file.
/,/:PRSEND <user>
prints a users SEND's, that is the messages that he has been sent while he
has been logged in.
/

command listf,,klistf,(%cojcl),,,/List a directory.
/,/:listf <directory name>
prints a file.  <directory name> must me six characters or less.
/

command users,,jusers,(%cojcl),,,/List the users on the system.  Nice for printing terminals.
/,//

define equiv a,b
sixbit /a/
sixbit /b/
termin

eqvtab:	equiv M,MAIL
	equiv W,WHO
	equiv F,NAME
	equiv FINGER,NAME
	equiv WHEN,NAME
	equiv FING,NAME
	equiv ACCOUN,ACOUNT
	equiv S,SEND
	equiv VERSIO,SSTATU
	equiv U,USERS

ife $$PAND,[
	equiv TCTYPE,TCTYP
	equiv BYE,QUIT
	equiv LOGOFF,QUIT
	equiv KJOB,QUIT
]; END IFE $$PAND,

ifn $$PAND,[
	equiv ADD,SET
	equiv DEL,DELETE
	equiv SCN,SCAN
	equiv PR,PRINT
	equiv STAT,STATS
	equiv LOGOUT,QUIT
	equiv BYE,QUIT
	equiv KILL,QUIT
	equiv DONE,QUIT
	equiv Q,QUIT
	equiv EXIT,QUIT
]; END IFN $$PAND,

eqvlen==.-eqvtab
	.upure

;;;; data areas

msgbuf:	block <msgbfl+4>/5	   ;input buffer. 

tmpbuf:	block 4000		   ; Temporary buffer

jclbuf:	block 100		   ;JCL buffer, input and output.

outbuf:	block 200		   ; buffer for generating output

dsprmp:	0			   ;if non-zero, XCT it instead of usual
				   ;prompting

morflg:	0			   ;-1 if at a --MORE--.  TYI will take
				   ;non-skip on ^L.

jclct:	0			   ;# of chars in JCL

pwbuf:	block 2			   ;two words for a password in clear
hispas:	block 2			   ;similarly.  Set by PWDCHG, used by KACOUN

uname:	0			   ;UNAME he wants to log in as
linker:	0			   ; Who did the linking
linkno:	-1			   ; TTY no of who did the linking
cretor:	0			   ; Creator uname to FIND.
checkp:	0			   ; -1 if CHECK looks for non-accounts.

;;; reader switches go here

logflg:	0			   ;-1 if keeping log file
hfdupf:	0			   ;half duplex switch
sailp:	0			   ; -1 if TTY understands sail chars
bsflag:	0			   ;non-zero if terminal can backspace

helper:	call bhelp		   ;the routine to call to respond to a HELP
				   ;typed.
vpos:	0			   ;current vertical position
hpos:	0			   ;current horizontal position

lfflag:	0			   ;set non-zero if we have just rubbed out
				   ;means to LF when get a real char.

jlflag:	0			   ;set non-zero if last char rubbed out was a
				   ;LF.  For avoiding double-lf's


cliarg::
nuprt:	0			   ;UNAME read in from CLA device
njprt:	0			   ;JNAME read in from CLA device
savewd:	0			   ;saved word, read in from CLI for to check
				   ;first char for being a rubout
chsave:	0			   ;saved first char, in case it wasn't a
				   ;rubout 


crgbts:	0			   ;These bits correspond to which
				   ;control-arguments were found by RCARG

cargbf:	block cargct		   ;buffer for control-arguments
acrgbf:	block 30		   ;ascii chars read by RCARG

cladir:	sixbit /.TEMP./		   ;directory that SENDS files are found on.


;;; call block to open a .UAI file on DSKI
.pure
uaiopn:	setz ? sixbit /OPEN/ ? cnti .uai ? argi dski
	(b)
	1(b)
	2(b)
	3(b)
	<setz>+<errret>+calerr


;;; filename block for application message in lieu of application proceedure

mlname:	sixbit /DSK/
	sixbit / APPLY/
	sixbit / MSG/
	sixbit /ACOUNT/

.upure

;;; filename block for application file
aplnam:
fa.dev: sixbit /DSK/
fa.fn1:	sixbit /APPLY/
fa.fn2:	0
fa.snm:	sixbit /ACOUNT/


;;; filename block for :PRINT defaults
filnam:				   ;block of 4 words:
ife $$PAND,[
fi.dev:	sixbit /DSK/		   ;DEVICE
fi.fn1:	sixbit /ITS/		   ;FN1
fi.fn2:	sixbit /NEW/		   ;FN2
fi.snm:	sixbit /.INFO./		   ;SNAME
]
ifn $$PAND,[
fi.dev:	sixbit /DSK/
fi.fn1:	sixbit /USER/
fi.fn2:	sixbit /ACOUNT/
fi.snm:	sixbit /ACOUNT/

;;; Filename blocks for FIND and CHECK commands.
outfil:
ot.dev:	sixbit /DSK/
ot.fn1:	sixbit /ACCTS/
ot.fn2:	sixbit />/
ot.snm:	sixbit /ACOUNT/		   ; Gets changed to our hsname.
infil:
in.dev:	sixbit /DSK/
in.fn1:	sixbit /.FOO./
in.fn2:	sixbit /.BAR./
in.snm:	sixbit /ACOUNT/
]
;;; filename block used for :LISTF
dirnam:				   ;block of 4 words:
fd.dev:	0			   ;DEVICE read by a :LISTF FOO:
fd.fn1:	0			   ;:LISTF FOO or FOO^F
fd.fn2:	0			   ;ignored
fd.snm:	0			   ;:LISTF FOO;

;;; filename block for the log file
.pure
lognam:
fl.dev:	sixbit /DSK/
fl.fn1:	sixbit /FAILED/
fl.fn2:	sixbit /LOGINS/
fl.snm:	sixbit /ACOUNT/
.upure

;;; filname block for file names in error
errnam:				   ;block of 4 words:
fe.dev:	0
fe.fn1:	0
fe.fn2:	0
fe.snm:	0

;;; filename block for refusal reason file
rfsnam:
fr.dev:	sixbit /DSK/
fr.fn1:	sixbit /REFUSE/
fr.fn2:	0
fr.snm: sixbit /ACOUNT/

;;; filename block for OFF reason file
offnam:
ft.dev:	sixbit /DSK/
ft.fn1:	sixbit /OFF/
ft.fn2:	0
ft.snm: sixbit /ACOUNT/

;;; filename block for a HOLD file
hldnam:
fh.dev:	sixbit /DSK/
fh.fn1:	sixbit /HOLD/
fh.fn2: 0
fh.snm:	sixbit /ACOUNT/

;;; filename block for output files
outnam:
fo.dev:	sixbit /DSK/
fo.fn1:
ifn $$PAND,sixbit /_PANDA/
ife $$PAND,sixbit /_PWORD/
fo.fn2:	sixbit /OUTPUT/
fo.snm:	0


;;; filename block for :PRINT-style opens (CALL PRTOPN)
fdxnam:
fx.dev:	0
fx.fn1:	sixbit /.FILE./
fx.fn2:	sixbit /(DIR)/
fx.snm:	0

;;; the info to be passed to DDT goes here.
altusw:	0			   ;if -1, we logged in with $U
lbrief:	0			   ;if -1, we used $0U or -BF in login.

;;;  Stuff for the inferior handlers goes here.

infp:	0			   ;-1 if we are in an inferior
j.file:
infdev:	sixbit /DSK/
inffn1::sixbit /TS/		   ;FN1 of the file to load inferior
				   ;from
inffn2:	0			   ;FN2
infsnm:	sixbit /SYS/		   ;sname

j.upc:	0			   ;location of interrupt
jinstr:	0			   ;instruction causing interrupt
jaddr:  0			   ;address field of instruction
jindex:	0			   ;index field of instruction
jindrp:	0			   ;non-zero if indirect
jopcod:	0			   ;operation code of inferior
jaccum:	0			   ;accumulator field of operation in inferior

jclpag:	0			   ;the page # that JCL is to be moved to
jclloc:	0			   ;the offset from the begging of that page

;;; random parameters go here
cmhcnt:	6			   ;initially 6 commands per line.
hcnt:	0			   ;# of commands still room for on line
failct:	2			   ;the number of failures allowed before
				   ;logging the loser out
failun:	0			   ;# of times loser has tried unkown account
	
;;; Data collected by the error handler goes here.
dbgdir:
ifn $$DBUG,sixbit /CSTACY/
ife $$DBUG,sixbit /CRASH/		   ;where to write crash files
dbgfn1:
ifn $$PAND,sixbit /PANDA/
.else      sixbit /PWORD/
dbgfn2: sixbit />/

iocchn:	0			   ;channel that had an IOC error
iocsts:	0			   ;STATUS of channel that had IOC error

erracs:: block 20		   ;saved AC's in event of error
	irp ZZ,,[x,a,b,c,d,e,t,tt,ch,count,bp,ct,sp]
ac.!zz=erracs+zz
	termin

erradr:	0			   ;address of the error
ebsts:	0			   ;status word of bad channel
ebchn:	0			   ;collect the bad channel
empva:	0			   ;when we get around to catching MPV's
euind:	0			   ;get user index, for identification if we
				   ;get it before it is killed!
euname:	0			   ;get worthless data, usually
ejname:	0
etty:	0
epirqc:	0			   ;interrupts?
eifpir:	0			   ;inferiority complex?
ecnsl:	0			   ;what TTY ....
esv40:	0

baderr:	0			   ;a saved error from the system
deathp:	
ifn $$pand,-1
.else 0

pat::
patch: block 100		   ;a large patch area

calerr:	0			   ;.CALL errors
debug:	0			   ;set -1 if debuging.
noddt:	0			   ;set -1 if noone is to get DDT (debugging)
startd:	0			   ;set -1 if initialization has been done
vrsadr:	.fnam1			   ;same as DDT's in purpose, so DBGHAK can
	.fnam2			   ;know if it won or not

goodf:0				   ;-1 if this is our good working set, and we
				   ;have a crash file loaded
puname:	0			   ;UNAME of person who purified us last
;;; various ITS data goes here.
consol:	0			   ;our console #
ttycom:	0			   ;the TTYCOM variable
vsize:	0
hsize:	0
ttyopt:	0
ttytyp:	0			   ;TTYTYP variable, for testing various things
	

tsrtab:	0			   ; Magic identifier (should be 'TERMID)
termid:	block 8			   ; If non-zero, an ASCIZ terminal name
hstnam:	ascii /LOCAL/		   ; If non-zero, the name of the host in ASCIZ
	block 7
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

tsrloc==:100			   ; Where data lives in TELSER
tsrcnt==:funame-tsrtab+1	   ; # of words of data in TELSER

ife $$PAND,lclsit:	0	   ;site this host is

machin:	0			   ;sixbit machine name
dm.flg:	0			   ;-1 if this is DM
itsver:	0			   ;sixbit ITS version
susrs:	0			   ;count of users on system
sysdbg:	0			   ;SYSDBG in system
parnxm:	0			   ;sum of parity errors and NXM's
time:	0			   ;time system has been up
shutdn:	0			   ;time till system goes down.
xuname:	0			   ;the initial uname login is attempted as
runame:	0			   ;UNAME of this job

;;; This location is only written, never read
nul:	0

;;; PDL
pdl:	block pdllen
	block 30		   ;lots of room for PDL over flow handling.
qitpdl:	block 30		   ;PDL for things to XCT on unwinding of the
				   ;pdl.

vpatch:	block 10		   ;an extra patch areea
.pure

ifn $$pand,[

usrwho:	move bp,[440700,,msgbuf]
	push sp,[-1]
	call usrpr1		   ;print out the info on this user
	  setz (sp)		   ;   Say we didn't see any INQUIR info
	setz ch,
	idpb ch,bp		   ; end text with a nul
	terpri
	output tyoc,msgbuf
	pop sp,t
	skipn allflg		   ; Is that all?
	  jrst [ jumpe t,cpopj	   ;   Yes, just fail-return, no INQUIR entry
		 jrst popj1]	   ;   INQUIR entry, success return
	jumpe t,usrnm7		   ; No INQUIR entry, just type other info

usrnm2:	movei a,lsrtns"i$nick	   ;get his nickname
	move b,lsrptr
	call lsrget
	  jrst inqr04		   ;  yes, don't bother
	type tyoc,/ (/
	outstr tyoc,a
	tyo tyoc,[")]
inqr04:	movei a,lsrtns"I$neta	   ;find his net address
	move b,lsrptr
	call lsrget
	  jrst inqr06		   ;  not there
	type tyoc,/ [/
	outstr tyoc,a
	type tyoc,/]/
inqr06:	movei a,lsrtns"i$mitt	   ;find his MIT Tel.
	move b,lsrptr
	call lsrget
	  jrst inqr12
	type tyoc,/(MIT:  /
	outstr tyoc,a
	type tyoc,/) /
inqr12:	movei a,lsrtns"i$homt	   ;find his home tel.
	move b,lsrptr
	call lsrget
	  jrst inqr14
	type tyoc,/(Home:  /
	outstr tyoc,a
	tyo tyoc,[")]
inqr14:	terpri
	movei a,lsrtns"i$proj	   ;find his project
	move b,lsrptr
	call lsrget
	  jrst inqr08		   ;  not there
	type tyoc,/Hacking /
	outstr tyoc,a
	tyo tyoc,[40]
inqr08:	movei a,lsrtns"i$supr	   ;find his supervisor
	move b,lsrptr
	call lsrget
	  jrst inqr10
	type tyoc,/for /
	outstr tyoc,a
inqr10:	terpri
	movei a,lsrtns"i$mita	   ;get his MIT address
	move b,lsrptr
	call lsrget
	  jrst inqr16
	outstr tyoc,a
	terpri
inqr16: movei a,lsrtns"i$homa	   ;get his home address
	move b,lsrptr
	call lsrget
	  jrst inqr18
	outstr tyoc,a
	terpri
inqr18:	movei a,lsrtns"i$rem	   ;get remarks
	move b,lsrptr
	call lsrget
	  jrst inqr20
	outstr tyoc,a
	terpri
inqr20: movei a,lsrtns"i$altr	   ;get alterer
	move b,lsrptr
	call lsrget
	  jrst usrnm7
	outstr tyoc,a
	call usrnm7		   ;USRNM7  prints APPLY file, and no more
	jrst popj1		   ;success return

;; USRNM7 is internal for USRWHO, prints APPLY files, or REFUSE files
usrnm7:	type dspc,/A======================================
/
	call pwdlok		   ;check for already there
	  jrst [type dspc,/A[Not in database]
/
		ret]		   ;  it isn't there, but no problem

	type dspc,/A[In database]
/
	call pwdget		   ;get this entry
	move t,uname
	ldb x,[pi$sta pdinfo]	   ;and gobble the account state
	cain x,ps%apl		   ;applied?
	  pjrst [type dspc,/AThis person has applied./
		 movei b,aplnam	   ;fileblock for applications
		 jrst usrnmx]
	cain x,ps%rfs		   ;has he been put on hold or refused?
	  pjrst [type dspc,/AThis person has been refused
/
		 movei b,rfsnam	 ;we want the REFUSE file
		 jrst usrnmx]
	cain x,ps%off		   ; temporarily held
	  jrst [type tyoc,/temporarily held.
/
		movei b,offnam
		jrst usrnmx]
	cain x,ps%hld
	  jrst [type tyoc,/held for more info.
/
		movei b,hldnam	 ;we want the HOLD file
		jrst usrnmx]

	caie x,ps%sys
	  cain x,ps%ok
	    ret

	error /Illegal account state found./

usrnmx:	move t,uname
	call fn2opn
	  pjrst [type dspc,/ANo info on file.
/
		 ret]
	terpri
	pjrst printf

usrnam:	setom allflg		   ;note we want it all
	setzm brfflg		   ;not brief
	call usrwho
	  jfcl			   ;  ignore non-presense in INQUIR
usrnm8:	ask /AIs this OK?/
	  jrst [type dspc,/   Left alone./
	        ret]		   ;  fail return
	call pwdmap		   ;so map it in and skip
	jrst popj1

;;; get lsr item, skiping if present
lsrget:	call lsrtns"lsritm
	  ret
	move t,a
	ildb ch,t
	cain ch,0
	  ret
	jrst popj1


usrset:	call r6arg		   ; Parse the command
	call rcarg
	  ret

	skipn t,arg6		   ;get the argument
	  jrst [type dspc,/AType "SET <uname> [<options>]"
/
		ret]
	movem t,uname		   ;UNAME to hack
	movem t,pwbuf		   ;and it serves as a default password
	setzm t,pwbuf+1
	type dspc,/CSETTING:  /
	tyo tyoc,[133]		   ;open-square-bracket

	move x,crgbts
	trze x,CF$SOK		   ;Turning this account on?
	  do [type tyoc,/-on/	   ;  more to come, space between!/
	      tyo tyoc,[40]]
	trze x,CF$SBD
	  do [type tyoc,/-bad/
	      tyo tyoc,[40]]
	trze x,CF$SNB		   ; OK from bad site?
	  do [type tyoc,/-nbad/
	      tyo tyoc,[40]]
	trze x,CF$SRF
	  do [type tyoc,/-refuse/
	      tyo tyoc,[40]]
	trze x,CF$SHL
	  do [type tyoc,/-hold/
	      tyo tyoc,[40]]
	trze x,CF$SOF
	  do [type tyoc,/-off/
	      tyo tyoc,[40]]
	trze x,CF$SDY
	  do [type tyoc,/-day/
	      tyo tyoc,[40]]
	trze x,CF$SPW
	  do [type tyoc,/-pw/
	      tyo tyoc,[40]]
	trze x,CF$SND
	  do [type tyoc,/-nday/
	      tyo tyoc,[40]]
	trze x,CF$STL
	  do [type tyoc,/-dial/
	      tyo tyoc,[40]]
	trze x,CF$SNT
	  do [type tyoc,/-ndial/
	      tyo tyoc,[40]]
	trze x,CF$SSY
	  do [type tyoc,/-system/
	      tyo tyoc,[40]]
	trze x,CF$GRP
	  do [type tyoc,/-group/
	      tyo tyoc,[40]]
	trze x,CF$SHL
	  type tyoc,/-hold/
argdef:	skipn crgbts
	  type tyoc,/DEFAULT/
	tyo tyoc,[135]		   ;close-square-bracket
	terpri
	call maplsr		   ;map in the INQUIR database
	call usrnam		   ;check his name, etc
	  ret			   ;  not right
	setzm usrrsn		   ; so that .MAIL NOTMAL will win
	move bp,[440700,,usrbfr]   ; Remember how it was for the notification
	call usrdat
	  jfcl
	setzm msgbuf		   ; make sure empty at start
	move x,pdpass		   ; remember the old password
	movem x,popass
	move x,crgbts		   ;check the control arguments
	trne x,CF$SPW		   ;set password?
	  do [type tyoc,/
Enter new password.
/
	  call pwadd5		   ;do the work of asking
	    ret			   ;  lost
][	call pwdini]		   ;cons/get the entry
	move a,crgbts		   ;check the control arguments
	trne a,CF$SOK		   ; Turning on this user?
	  jrst [ movei x,ps%ok
		 ldb t,[pi$sta pdinfo]
		 dpb x,[pi$sta pdinfo]
		 movsi x,%pfmsg	   ; Say we've not seen any refuse message
		 andcam x,pdflag   ; since the flag isn't aplicable
		 cain t,ps%apl	   ; If this was an application
		   call pwdcid	   ;   Set the creator field
		 jrst daydel]
	trne a,CF$SOF		   ; Temporarily hold this user?
	  jrst [ call offwrt	   ;   write the message
		 movsi x,%pfmsg	   ;   Say he's not seen the message
		 andcam x,pdflag   ;   since it was just written
		 jrst dayp]	   ;   and don't delete anything
	trne a,CF$SRF		   ;refuse this user?
	  jrst [ call rfswrt	   ;  yes, write the refusal
		 movsi x,%pfmsg	   ;  Say he's not seen the message
		 andcam x,pdflag
		 jrst dayp]	   ;  and don't delete anything
	trne a,CF$SHL		   ;put this user on hold?
	  jrst [ call hldwrt	   ;  yes, write the HOLD file
		 movsi x,%pfmsg	   ;  Say he's not seen the message
		 andcam x,pdflag
		 jrst dayp]	   ;  and don't delete anything
daydel:	call acdel		   ;delete any left over APLY or REFUSE files
dayp:	move x,pdflag		   ; Check the flag bits
	trne a,CF$SBD		   ;Prohibit bad sites?
	  tlo x,%pfbad
	trne a,CF$SNB		   ; bad site OK?
	  tlz x,%pfbad
	trne a,CF$SDY		   ;daytime OK?
	  tlo x,%pfday
	trne a,CF$SND		   ;daytime not ok?
	  tlz x,%pfday
	trne a,CF$STL		   ;Dialups?
	  tlo x,%pfdil
	trne a,CF$SNTL		   ;Dialups NOT ok?
	  tlz x,%pfdil
	movem x,pdflag		   ;in the flag word
	trne a,CF$SSY		   ;Is it supposed to be system reserved name?
	  do [movei x,ps%sys	   ;  note this fact
	      dpb x,[pi$sta pdinfo]
	      movsi x,%pfmsg	   ; Flush inapplicable flag
	      andcam x,pdflag
	      setom pdpass]	   ;  no password in particular
	ldb x,[pi$sta pdinfo]	   ; Check the state for being PS%NEW
	cain x,ps%new		   ; which isn't legal.  This can happen
	  jrst [ movei x,ps%ok	   ;   when creating an account
		 dpb x,[pi$sta pdinfo]	; via SET FOO<cr>.
		 jrst .+1]
	trne a,CF$GRP
	  do [ call rdgrp	   ; Read in the group
	         ret
	       dpb a,[pi$grp pdinfo]]
	move bp,[440700,,usraft]
	call usrdat		   ; Get the new state of the user
	  jfcl
	move x,popass
	came x,pdpass		   ; Has the password been changed?
	  jrst [ write bp,/
     [new password]
/
		jrst .+1]
	call malset		   ;send off a note
	pjrst pwdput		   ;put this entry in the database

rdgrp:	call grpprt		   ; Print the group names
	type dspc,/AGroup:  /
	save [bp]
	move bp,[440700,,msgbuf]
	call read6		   ; Read in the 6bit name of the group
	  jrst [ restore [bp]
		 ret]
	restore [bp]
rdgrp6:	save [x]
	movsi a,-20		   ; AOBJN ptr to group names
	move x,arg6
rdgrp0:	camn x,pwgnam(a)	   ; Is this our group?
	  jrst rdgrp1		   ;   Yep
	aobjn a,rdgrp0		   ;   Nope

	type dspc,/AThat group is not known.
/

	restore [x]
	ret

rdgrp1:	movei a,(a)		   ; Eliminate the count
	restore [x]
	jrst popj1


;;; local function for SET and SCAN.  X contains future flag word (PWFLAG)
;;; writes ACOUNT;REFUSE <UNAME> file

rfswrt:	push sp,x		   ;save X
	movei x,ps%rfs		   ; Set the state to REFUSE
	dpb x,[pi$sta pdinfo]
	call acdel
	push sp,[440700,,[asciz /
Has been denied /]]
	call aplcop		   ;copy over the apply file with
	pop sp,nul
	move t,uname		   ;rename with FN2 of UNAME
	movei b,rfsnam
	pop sp,x
	call rnmfn2		   ;rename the file
	pjrst apldel		   ;and flush the old cruft

;;; local function for SET and SCAN.  X contains future flag word (PWFLAG)
;;; writes ACOUNT;REFUSE <UNAME> file

offwrt:	push sp,x		   ;save X
	movei x,ps%off		   ; Put into OFF state
	dpb x,[pi$sta pdinfo]
	call acdel
	push sp,[440700,,[asciz /
Has been denied /]]
	call aplcop		   ;copy over the apply file with
	pop sp,nul
	move t,uname		   ;rename with FN2 of UNAME
	movei b,offnam
	pop sp,x
	call rnmfn2		   ;rename the file
	pjrst apldel		   ;and flush the old cruft

;;; HLDWRT is like RFSWRT except for HOLD files

hldwrt:	push sp,x		   ;save x
	movei x,ps%hld
	dpb x,[pi$sta pdinfo]
	call acdel
	push sp,[440700,,[asciz /
Has been held /]]
	call aplcop		   ;copy the apply file to a new file
	pop sp,nul
	move t,uname		   ;rename with FN2 of UNAME
	movei b,hldnam
	pop sp,x
	call rnmfn2		   ;rename the file
	pjrst apldel		   ;and flush the old

aplcop:	move b,[sixbit /ACOUNT/]   ;output directory is ACOUNT
	call opnout		   ;output a file to it
	movei b,aplnam		   ;file with the applicatiton
	move t,uname
	call fn2opn		   ;open application file
	  jrst filwrt		   ;  Not there
	type dsko,/The following application:
/
	call copyf
aplwrt:	outstr dsko,(sp)
filwrt:	move t,[type dspc,/CThe user will se this when he tries to log in.
End with a ^C.
Because:  /]
	movem t,helper		   ;set up some help for the user
	call becaus		   ; get the reason from the user
	output dsko,usrrsn	   ;output our reason
	ret

becaus:	setzm usrrsn
	move t,[usrrsn,,usrrsn+1]
	blt t,usrrsn+400-1	   ;clear out the previous contents
	move t,[440700,,[asciz /Because:  /]]
	move bp,[440700,,usrrsn]   ;place to put the input!
	copy t,bp
	type dspc,/ABecause:  /
	save [a,x]
	call readsn		   ;read the message
	  jrst [restore [x,a]
	        syscal delewo,[argi dsko]  ;don't leave garbage around
		  ret
		ret]
	restore [x,a]
	ret

kkill:	call r6arg
	skipn t,arg6		   ;ARG6 is the one to delete
	  jrst [type dspc,/AType ":DELETE <uname>"
/
		ret]		   ;  explain it to him!
	movem t,uname
	type dspc,/CDELETING:  /
	call maplsr
	call usrnam
	  ret
	ldb x,[pi$sta pdinfo]
	movem x,delsta
	movei x,ps%del
	dpb x,[pi$sta pdinfo]
	call acdel
	move bp,[440700,,usrbfr]
	setzm usraft
	call usrdat
	call pwdel		   ;delete it
	  jrst [type dspc,/ANot found.
/
		ret]
	call becaus		   ; get the reason
	call maldel		   ;set a note
	type dspc,/ADone./
	ret

acdel:	syscal delete,[[sixbit /DSK/]
	       [sixbit /REFUSE/]
	       uname
	       [sixbit /ACOUNT/]]
	  jfcl
	syscal delete,[[sixbit /DSK/]
	       [sixbit /HOLD/]
	       uname
	       [sixbit /ACOUNT/]]
	  jfcl

	syscal delete,[[sixbit /DSK/]
	       [sixbit /OFF/]
	       uname
	       [sixbit /ACOUNT/]]
	  jfcl
apldel:	syscal delete,[[sixbit /DSK/]
	       [sixbit /APPLY/]
	       uname
	       [sixbit /ACOUNT/]]
	  jfcl
	ret

;;; SCAN command

define scanop [names],init,pred
irp name,,names
irps x,,[name]
	sixbit /x/
termin
ifnb init,init,,pred
.else	  popj1,,pred

termin
termin

SCNOPS:	

irp x,,[[NEW,,scnnew],[ALL,,popj1],[[APPLY,APL,APPLY],,scnapl],[UNK,sinunk,scnunk],
        [[SYS,SYSTEM],,scnsys],[[REFUSE,RFS],,scnrfs],[[HOLD,HLD],,scnhld],
	[[OFF,TOFF],,scnoff],[[INQUIR,INQ],sininq,scninq],[BAD,,scnbad]]
  scanop x
termin

scnlng==.-scnops
.upure
notsw:	0			   ; Initially NOT NOT

;; the next 3 should be together in the same order.  They are sometimes used
;; together as a single buffer, i.e. for the  GROUP command

usrbfr:	block 40		   ; Buffer for user status BEFORE we modify
usraft:	block 40		   ; Buffer for user status AFTER we modify
usrrsn:	block 400		   ; text of reason for refusal

.pure
kscan:	setzm notsw		   ;NOT NOT
	call r6arg		   ; Hack the JCL
	skipn t,arg6		   ;get the argument
	  move t,[sixbit /APPLY/]  ;default to searching applications
	movsi b,-scnlng
kscan1:	camn t,scnops(b)	   ;is this the command?
	  jrst kscan2		   ;  yes, let's to hack!
	add b,[1,,1]		   ;skip the address
	aobjn b,kscan1		   ;and hack the next command name
	type dspc,/Foo!  I don't know that sub-command!/
	ret

kscan2:	hlrz t,scnops+1(b)	   ;get the initialization routine
	call (t)		   ;initialize it
	  ret			   ;  he flushed it
	setz a,			   ;start counting entries
krscan:	call pwdget		   ;get this entry
	move x,pdflag		   ;get the flags
	movem x,opdflg		   ;remember the way they were
	move x,pdinfo
	movem x,opdinf
	move x,pdunam		   ;convert his name to normal 6bit
	sub x,[742532,,732643]	   ;Will oddities never cease?
	rot x,-13
	movem x,uname		   ;save it for later
	save [b,a]		   ;save our AC's for later
	hrrz t,scnops+1(b)	   ;get the predicate
	call (t)		   ;and call it
	  jrst kscan9		   ;  nope, get next
	call maplsr		   ;map in the INQUIR database
kscask:	tyo dspc,[^P]		   ;clear the screen
	tyo dspc,["C]
	setom allflg		   ;make sure we get all the info!
	setzm nodate
	call usrwho		   ;print out loads of info
	  jfcl
	move bp,[440700,,usrbfr]   ; let's remember state before hackery
	call usrdat
	  jfcl
ksask1:	type dspc,/ALZUUUE/
	6type tyoc,uname
	tyo tyoc,[^I]
	call uflgpr		   ;print his flags
	call usrpri		   ;print his name etc.
	  jfcl
	setzm ttyflg		   ;turn on the TTY...
	type dspc,/ALWhat now boss? (A,N,I,D,T,L,B,H,O,R,S,X,?,<CR>,^D)  /
	setzm notsw		   ;not negative

ksask2:	move x,[call [movei ch,^D  ;pretend it's a ^D instead
		      movem ch,reread
		      ret]]
	movem x,dsprmp
	tyi
	  jrst [pop sp,a
	        call pwdget	   ;back to the way we were
		move x,pdflag	   ;get the flags
		movem x,opdflg	   ;remember the way we were
		move x,pdinfo
		movem x,opdinf
		push sp,a
		jrst kscask]
	  jrst [type dspc,/CA -- Authorize
A -- Accept application.
N -- Not (negate next character)
I -- Ignore, go to next entry
D -- Delete this entry
T -- Telephone usage
L -- Loaded usage (daytime)
B -- Disallow bad sites
H -- Put on hold
R -- Refuse this account
S -- SYSTEM name
O -- Temporarily Off
X -- Done, make changes permanent.
^D, [RUBOUT] -- reset
<CR> -- do the default
? -- This help.

---type space to redisplay---
/
	
		.iot tyic,ch
		jrst kscask]
	  jrst [pop sp,a
	        call pwdget
		push sp,a
		jrst kscask]
	setzm dsprmp		   ;no more funny stuff!
	upper ch		   ;uuppercasify
	cain ch,"A		   ; Approved?
	  jrst [ type tyoc,/Approved./
		 skipe notsw	   ; Not?
		   jrst kscask		   ;   Then don't do it!
		 call rdgrp	   ; Get the group
		   jrst kscask	   ;   Punt
		 dpb a,[pi$grp pdinfo]	; Store the group
		 movei x,ps%ok
		 ldb t,[pi$sta pdinfo]	; check out the old state
		 dpb x,[pi$sta pdinfo]	; Set the state to OK
		 cain t,ps%apl	   ; Was this new application?
		   call pwdcid	   ; Set the creator field.
		 jrst kscan8]	   ; Next

	cain ch,"I
	  jrst [type tyoc,/Ignored./
		skipe notsw	   ;not?
		  jrst kscask	   ;  don't ignore it!
		jrst kscan9]
	cain ch,"D
	  jrst [type tyoc,/Delete/
	        skipn notsw	   ;  positive?
		  jrst [tyo tyoc,[".]	;yes, period
		        move x,[sixbit /DELETE/]  ;pretend we are a DELETE
			movem x,comand
			ask /ADelete this user?/
			  jrst [type dspc,/ANot Deleted./
			        jrst ksask1]
			ldb x,[pi$sta pdinfo]
			movem x,delsta	; remember the old state for printing
			movei x,ps%del	; Set the state to something random
			dpb x,[pi$sta pdinfo]
		        call acdel ;flush files
		        call pwdel
			  type tyoc,/(Not found????)/
			jrst kscanx]
		type tyoc,/d./
		jrst ksask1]
	cain ch,"R
	  jrst [type tyoc,/Refuse/
	        skipe notsw	   ;  negative?
		  jrst kscnok
		movei x,ps%rfs	   ;   New state = REFUSE
		jrst kscan4]	   ;  and re-save in database
	cain ch,"O
	  jrst [type tyoc,/Temporary Hold (off)./
		skipe notsw	   ; negative?
		  jrst kscnok
		movei x,ps%off
		jrst kscan4]
	cain ch,"H		   ;hold?
	  jrst [type tyoc,/Hold./
		skipe notsw	   ;  negative?
		  jrst kscnok
		movei x,ps%hld	   ; Make state HOLD
		jrst kscan4]
	cain ch,"S		   ;system?
	  jrst [type tyoc,/SYSTEM./
		skipe notsw	   ;  negative?
		  jrst kscan5	   ;    turn off PS%SYS
		setzm pdflag	   ; No flags on, please
		setom pdpass	   ;no password in particular
		movei x,ps%sys	   ; Make the state SYSTEM
		jrst kscan4]
	cain ch,"T		   ;turn off telephone authorization
	  jrst [type tyoc,/Telephone./
	        move x,pdflag	   ;get the flags
		skipn notsw	   ;if positive
		  tlo x,%pfdil	   ;  allow telephone
		skipe notsw	   ;if negative
		  tlz x,%pfdil	   ;  don't allow telephone
		movem x,pdflag	   ;use new
		jrst kscan5]	   ;and re-save in database
	cain ch,"L
	  jrst [type tyoc,/Loaded use./
	        move x,pdflag	   ;;get the flags
		skipn notsw	   ;if positive
		  tlo x,%pfday	   ;  turn off daytime prohibition
		skipe notsw	   ;if negative
		  tlz x,%pfday	   ;  prohibit daytime use
		movem x,pdflag
		jrst kscan5]	   ;  and re-save in database

	cain ch,"B		   ;Badness?
	  jrst [type tyoc,/Bad site prohibit.  /
	        move x,pdflag	   ;  get the flags
		tlo x,%pfbad	   ;  turn on prohibition
		skipe notsw	   ;    unless negative
		  tlz x,%pfbad	   ;  turn it off
		movem x,pdflag
		jrst kscan5]	   ;  and re-save in database.

	cain ch,"N		   ;Not?
	  jrst [type tyoc,/Not /
	        move x,notsw
		xori x,-1
		movem x,notsw
		jrst ksask2]

	cain ch,"X		   ;X ?
	  jrst kscan8		   ;  deposit and go.

	skipe crgbts		   ;have we done anything?
	  jrst ksask1		   ;  yes, none of the rest should exit then.

	cain ch,^M		   ;CR?
	  jrst kscnok		   ;  just do the minimum

	cain ch,40		   ;space?
	  jrst kscan9		   ;  on to the next one!


	type tyoc,/Huh?/
	jrst kscask		   ;ask again

kscnok:	movei x,ps%ok
kscan4:	dpb x,[pi$sta pdinfo]
kscan5:	movsi x,%pfmsg		   ; We're setting the state, say we've not
	andcam x,pdflag		   ; seen this message yet
	jrst ksask1

kscan8:	setzm usrrsn		   ; no reason given yet
	ldb x,[pi$sta opdinf]	   ; compare with the old flags
	ldb t,[pi$sta pdinfo]	   ; with what we have now.
	camn x,t		   ; are they the same?
	  jrst kscn8a		   ;   yes, don't send any mail or anything
	cain t,ps%rfs		   ; Did we refuse him?
	  jrst [ call rfswrt	   ;   yes, write a refuse file
		 jrst kscn8a]
	cain t,ps%hld		   ; Did we put him on hold?
	  jrst [ call hldwrt	   ;   yes, write a hold file
		 jrst kscn8a]
	cain t,ps%off		   ; Did we turn him off?
	  jrst [ call offwrt	   ;   yes, write a off file
		 jrst kscn8a]
	call acdel		   ; Else clean up special files
	
kscn8a:	move bp,[440700,,usraft]   ; now get new state of account
	call usrdat
	  jfcl
	call malset		   ; Send out mail about it
	call pwdput		   ;put it back
kscan9:	restore [a,b]
	addi a,pwleng		   ;point to next entry
	camg a,pwcnt		   ;is this all?
	  jrst krscan		   ;  nope, loop
	ret			   ;yes, that's all folks!

;; for after deletion, re-tries same entry slot, since it has changed who
;; is in it!
kscanx:	call becaus		   ; find out why
	call maldel		   ; Send mail about it
	restore [a,b]		   ;restore the world
	camg a,pwcnt		   ;if we haven't flushed the last entry
	  jrst krscan		   ;  loop around hitting this one first
	ret			   ;else done.

;;;  SCNNEW skips if this is a new entry
scnnew:	move x,pdflag		   ;get the flag
	tlnn x,%pfnew		   ;is it new?
	  ret			   ;  nope, no skip
	jrst popj1		   ;yes, skip

scnapl:	ldb x,[pi$sta pdinfo]	   ;get the flag
	cain x,ps%apl		   ; Has he only applied?
	  jrst popj1		   ;   Yes, this is it
	ret			   ; nope, no patch

scnbad:	move x,pdflag		   ;get the flag
	tlnn x,%pfbad		   ;is he forbidden from bad sites?
	  ret			   ;  nope
	jrst popj1		   ;yep

scnrfs:	ldb x,[pi$sta pdinfo]
	cain x,ps%rfs		   ;has he been refused?
	  jrst popj1
	ret

scnoff:	ldb x,[pi$sta pdinfo]
	cain x,ps%off		   ; Is it off?
	  jrst popj1
	ret

scnhld:	ldb x,[pi$sta pdinfo]
	cain x,ps%hld		   ; Is he on hold?
	  jrst popj1
	ret

scnsys:	ldb x,[pi$sta pdinfo]
	cain x,ps%sys		   ;is it a system name?
	  jrst popj1
	ret

sininq:	setz count,
	move bp,[440700,,inqbuf]
sin0:	type dspc,/AEnter INQUIR groups to scan for:  /
sin3:	tyi
	  ret			   ;^D typed
	  jrst [type dspc,/AType as many groups as you wish, end with
a CR.  Null group is the same as [SPACE].
/
		jrst sin0]
	  jrst [sojl count,[ret]
	        decbp bp
		call 1wipe	   ;wipe it from the screen
		jrst sin3]

	cain ch,^M		   ;is it the end?
	  jrst sin9		   ;  yes, remember this
	upper ch		   ;uppercasify
	echoch
	idpb ch,bp
	aos count

	caige count,24		   ;are there too many of them?
	  jrst sin3		   ;  nope, ask for more
sin9:	terpri			   ;let him know he got it.
	movem count,inqcnt
	save [a,b]		   ;save important stuff
	call maplsr		   ;map in the INQUIR database
	restore [b,a]
	jrst popj1		   ;yes, don't take any more

scninq:	move count,inqcnt	   ;set up for count
	jumpe count,[ret]
	move bp,[440700,,inqbuf]
	call grplsr
	  movei ch,40		   ;pretend it's a space
scinq0:	ildb x,bp		   ;get a character
	camn ch,x		   ;is it one of them?
	  jrst popj1		   ;  yes.  Win win.
	sojg count,scinq0	   ;keep on trying
	ret			   ;not there.

.upure
inqbuf:	block 4			   ; 20. groups max
inqcnt:	0			   ; count of groups searched for
lstgrp:	0			   ; remembered group from USRPR1
opdflg:	0			   ; old PDFLAG word for this user
opdinf:	0			   ; old PDINFO word for this user
sukchk:	0			   ; -1 if should ignore special unknowns
.pure

;;;  SCNUNK skips iff luser has no INQUIR entry (SINUNK inits)

sinunk: setzm sukchk		   ;Normally process everyone.
	ask /AIgnore special users (reserved names, people on HOLD, etc.)? /
	 caia
	  setom sukchk		   ;Yes - ignore them.
	save [a,b] 
	call maplsr		   ;Map in the INQUIR database.
	restore [b,a]
	jrst popj1

scnunk:	skipn sukchk		   ;Ignoring special entries?
	 jrst scnun1		   ; No, go process everyone.
	move x,pdflag
;	tlne x,%pfnew		   ;New account?
;	 ret			   ; Yes, ignore it.
	ldb x,[pi$sta pdinfo] 
	caie x,ps%apl		   ;Applicant?
	 cain x,ps%rfs		   ; Or refusal?
	  ret			   ;  Yes, leave alone.
	caie x,ps%off		   ;Off?
	 cain x,ps%hld		   ; Or held?
	  ret			   ;  Yes, leave alone.
	cain x,ps%sys		   ;If this is a system name
	 ret			   ; ignore it.
scnun1:	movei a,lsrc		   ;Tell LSRTNS what channel it can hack.
	move b,uname		   ;Ask about this UNAME.
	call lsrtns"lsrunm	   ;Is it there?
	 jrst popj1		   ; No - hack this guy.
	ret			   ;Yes, leave alone.



SUBTTL	Parameters, Variables, Tables

.upure
varnam:	0			   ; Name of variable set
.pure

;;; Macro for defining parameters.

parcnt==0			   ;Number of PANDA parameters defined.

define param name,erout,srout,arg,mail,&doc
	sixbit /NAME/		   ;Name
	erout			   ;Examining routine
	srout			   ;Setting routine
	arg			   ;Argument (passed in A) for above
	mail			   ;Argument for .MAIL
	[asciz doc]		   ;Parameter documentation
parcnt==parcnt+1
termin
parlen==:6

partab:
parnam=:partab
parex=:partab+1
parset=:partab+2
pararg=:partab+3
parmal=:partab+4
pardoc=:partab+5

param GOOD,enet,snet,lucktb,varmml,/Hosts which get DDT instead of PWORD/
param BAD,enet,snet,losers,varmml,/Hosts to check the -BAD bit on/
param PEOPLE,e6tab,0,pwadmn,0,/People who have run PANDA/
param APPLY,flgprt,flgset,atoapl,varmml,/When true, allow applications/
param APLTXT,pwgtxt,pwstxt,naplmg,varmml,/Message to print in lieu of accepting applications/
param PHONE,pwgtxt,pwslin,phone,varmml,/Phone number for users to call for help/
param DDTTTY,ttylis,ttyset,ddtttb,varmml,/TTY lines to get DDT instead of PWORD/
param DILTTY,ttylis,ttyset,dilttb,varmml,/TTY lines to be considered reserved dialups/
param BADCMD,e6tab,s6tab,nocmnd,varmml,/PWORD commands to suppress/
param HOLDAY,flgprt,flgset,pwholp,varmml,/When true, PWORD ignores login time restrictions./


;;; .MAIL text to type variable name and ASCIZ text from MSGBUF.
varmml:	-4,,[ 440700,,[asciz /Variable:  /]
	      tp$6bt varnam
	      440700,,[asciz /
Value:  /]
	     440700,,msgbuf]

.upure
varmal:	440700,,[asciz /USER-ACCOUNTS/]
	tp$6bt runame
	0
	440700,,[asciz /New Variable setting in PWORD/]
varinf:	0
.pure

;;; Implement the VAR command for PANDA.


;;; Routine to handle VAR command in PANDA.

kvar:	call r6arg		   ; Parse the command
	skipn t,arg6		   ; Did we get an argument?
	  jrst kvarh		   ;   No - just list the variables.
	movem t,varnam		   ; Remember the name for the mail
	call kvar0		   ; Find the parameter
	  ret			   ;   No such var!
	move a,pararg(tt)	   ; argument to the routine
	save [tt]
	call @parex(tt)		   ; Do it
	  jfcl			   ;   Maybe it might skip-return
	restore [tt]
	skipn parset(tt)	   ; is there a routine to set it?
	  ret			   ;   no, that's it.
	ask /ADo you wish to set it?/
	  ret
	move a,pararg(tt)	   ; argument to the routine
	save [tt]
	move bp,[440700,,msgbuf]
	call @parset(tt)
	  jfcl
	restore [tt]
	setz ch,		   ; Ensure everything ends with a nul
	idpb ch,bp
	move t,parmal(tt)	   ; tell the .MAIL what to hack
	movem t,varinf
	movei t,(tp$ind)
	hrlm t,varinf
	.mail varmal		   ; Mail notification
	ret


kvar0:	movei t,parcnt
	setz tt,
	move x,arg6
kvar1:	camn x,partab(tt)	   ; Is this the parameter?
	  jrst popj1
	addi tt,parlen
	sojg t,kvar1
	type dspc,/AI never heard of that variable!
/
	ret


kvarh:	type dspc,/CThe VAR command will examine any of the following vars:

/
	movei t,parcnt
	setz tt,
kvarh0:	skipn parset(tt)	   ; * if setable
	  type tyoc,/  /
	skipe parset(tt)
	  type tyoc,/* /
	6type tyoc,parnam(tt)
	type tyoc,/ -- /
	output tyoc,@pardoc(tt)
	terpri
	addi tt,parlen
	sojg t,kvarh0
	type tyoc,/
* ==> Variable can be set.
/
	ret



;;; Flags are a simple kind variable.
;;; Here are the routines to Examine and Set a flag variable.

flgprt:	skipn (a)
	  jrst [ type dspc,/AValue = FALSE
/
		 ret]
	type dspc,/AValue = TRUE
/
	ret

;;; Set a flag-style variable.

flgset:	call plock		   ; Lock database for unpurity.
	aose (a)		   ; if -1, make it zero
	  setom (a)		   ;   Else -1
	move t,[440700,,[asciz /TRUE/]]
	skipn (a)
	  move t,[440700,,[asciz /FALSE/]]
	copy t,bp
	call pulock		   ; unlock it and repurify.
	ret



;;; HAKTAB is a utility for hacking tables.
;;; It can be called by parameter setting routines such as SNET.

;;; The argument table for HAKTAB describes useful combinations of
;;; object-reading, object-comparing, and table-printing routines.

hk%rd==:0			   ;Function to call to read object.
hk%dsp==:1			   ;Function to call to display table.
hk%cmp==:2			   ;Function to call to compare objects.
				   ; A and B and skip if they are equal.
define hakdef read,prt,cmp
	read
	prt
IFSE cmp,EQ,	[ came a,b ? jrst cpopj ? jrst popj1 ]
	.ELSE	cmp
termin

6tabtb: hakdef tread6,e6tab,EQ
snthtb:	hakdef rdhost,enet,netwrk"hstcmp

;;; Routines called from HAKTAB for various kinds of objects.
;;; Readers skip return with the frob in A, else non-skip.

;;; Read a sixbit frob.

tread6: type dspc,/AEntry:  /
	call read6		   ; Read it.
	 ret
	move a,arg6		   ; Get it to return.
IFN 0,[
	idpb6 a,bp		   ; Output it to mail
	move t,[440700,,[asciz /
/]]
	copy t,bp
] ;IFN 0
	jrst popj1		   ;Win.


;;; Routine to read a network host name.
;;; Returns a host number.

rdhost:	save [d]
	terpri
	call netwrk"hostnm	   ; Read in the host name.
	 jrst [ type dspc,/ANo such host.
/
		movei t,30.
		.sleep t,
		restore [d]
		ret ]
rdhos9:	restore [d]
	jrst popj1



;;; HAKTAB - Add or Delete an item from a table.
;;; The user types in an object, and it is added or delete to a table.
;;; Takes address in database of table (ie., LUCKTB) in A.
;;; Requires HAKDEF pointer in D.  
;;; (Note: BP should point to MSGBUF for logging.  KVAR does this.)

.upure
tabptr:	0			   ;Table pointer
tabadr:	0			   ;Table address.
.pure

haktab:	save [a,b,c,d,e]
	movem a,tabadr
	call pwsget		   ; Get the table from the database.
	movem t,tabptr
hakta1:	ask /ADo you wish to add an entry?/
	  caia			   ; Maybe he wants to delete.
	    jrst hakadd		   ;   He wants to add.
	skipe a			   ; If no entries, can't delete.
	  ask /ADo you wish to delete an entry?/
	    jrst [ type dspc,/AYou're confused!
/
		   jrst hakta9 ]   ;  Maybe he was just confused.
				   ; Fall through for deletion.

;;; Here to delete an entry.

hakdel: move tt,[440700,,[asciz /Deleting /]]
	copy tt,bp		   ; Log what we are doing.
	call @hk%rd(d)		   ; A gets user object.
	  jrst hakta9		   ;   Reading failed?
	move c,tabptr
hakde0:	move b,(c)		   ; B gets table object.
	call @hk%cmp(d)		   ; Compare them.
	 jrst [	aobjn c,hakde0	   ;   No match - try another.
		type dspc,/ANot found.
/
		movei a,30.
		.sleep a,	   ;   Pause a moment.
		jrst hakde9 ]	   ;   Give up if frob not in table.
hakde2: hlre a,c		   ; Now move stuff around.
	movns a			   ; Get the count remaining (positive).
	soje a,hakde3		   ; If last entry, just update pointer.
	hrli b,1(c)		   ; Where to get entries.
	hrri b,(c)		   ; Where to put them.
	addi a,-1(c)		   ; Where to end.
	blt b,(a)		   ; Move them.
hakde3:	move b,tabptr		   ; AOBJN ptr to data.
	add b,[1,,0]		   ; Shrink the table ptr by one.
	movem b,tabptr
	move a,tabadr		   ; Retrieve address of table.
	call pwsput		   ; Store the shrunken table

hakde9:	type dspc,/C/		   ; Display the table
	move a,tabadr		   ; Retrieve table address
	call @hk%dsp(d)
	ask /AWould you like to delete another entry?/
	  caia			   ;   No. Maybe add?
	   jrst hakdel		   ;     Go delete another.
	ask /AWould you like to add a entry?/
	  caia			   ;   No. all done.
	   jrst hakadd		   ;     Go to addition loop
	jrst hakta9		   ; All done.

;;; Here to add an entry.

hakadd:	move tt,[440700,,[asciz /Adding /]]
	copy tt,bp		   ; Log what we are doing.
	call @hk%rd(d)		   ; A gets user object.
	  jrst hakta9		   ;   Reading failed?
	move c,tabptr		   ; Check table for the object.
hakad0:	move b,(c)		   ; B gets table object.
	call @hk%cmp(d)		   ; Compare them.
	 jrst [	aobjn c,hakad0	   ;   No match - try another.
		jrst hakad1 ]	   ;  OK - it's not already there.
	type dspc,/AAlready in table.
/
	 movei a,30.
	 .sleep a,		   ; Pause a moment.
	jrst hakad9		   ; It's already there?

hakad1:	movem a,(c)		   ; Store the host in the table
	move b,tabptr		   ; AOBJN ptr to data.
	sub b,[1,,0]		   ; Grow the table ptr by one.
	movem b,tabptr
	move a,tabadr		   ; Retrieve table address
	call pwsput		   ; Store updated table
hakad9:	type dspc,/C/		   ; Display the table. 
	move a,tabadr		   ; Retrieve table address
	call @hk%dsp(d)
	ask /AWould you like to add another entry?/
	caia
	 jrst hakadd
	ask /AWould you like to delete a entry?/
	 jrst hakta9
	jrst hakdel
hakta9:	restore [e,d,c,b,a]	   ; Exit.
	ret




;;; These routines Examine and Set parameters.
;;; (Reference these in PARAM declarations.)
;;; All these routines expect a pointer to the table in A.

;;; Examine a table of 6bit items.

e6tab:	save [t,a]
	call pwsget		   ; Get the table
	movei t,tmpbuf		   ; ptr into TMPBUF of items
	call e6tab0		   ; Print them all
	restore [a,t]
	ret

e6tab0:	save [t,tt,a]
e6taba:	jumpe a,e6tab3		   ; if no items, just return
	movei tt,8		   ; 8 items accross
e6tab1:	6type tyoc,(t)		   ; type this item
	aos t
	sojg tt,e6tab2		   ; one item typed
	  terpri		   ;   End of line
	  sojg a,e6taba
	  jrst e6tab3
e6tab2:	tyo tyoc,[^I]		   ; tab to next position
	sojg a,e6tab1		   ; next item
e6tab3:	restore [a,tt,t]
	ret

;;; Set 6bit table.

s6tab:	save [d]
	movei d,6tabtb
	call haktab
	  caia
	    aos -1(p)
	restore [d]
	ret


;;; Examine Network Host Table.

enet:	save [a,b,d,bp]
	call pwsget		   ; Get table from database.
	jumpe a,enet5		   ;  If zero length, all done.
	move ct,(a)		   ;  Count in A, AOBJN in T.
	seto tt,
enet0:	move b,(t)		   ; Get host address.
	jumpe b,enet4
	save [t,tt]		   ; (Save temps from NETWRK.)
	move bp,[440700,,outbuf]   ; BP to typeout buffer.
	call netwrk"hstsrc	   ; Look up this host address
	 jrst [ idpb8 a,bp	   ;   No name - just print its number.
		tyobpi bp,0	   ;   Tie off the BP.
		jrst enet1 ]	   ; Found it!
	hrr x,a			   ; Get BP to host name.
	hrli x,440700
	copy x,bp		   ; Copy host name into output buffer.
enet1:	move bp,[440700,,outbuf]   ; Reset the byte pointer.
	restore [tt,t]		   ; (Get back temps.)
	jumpl tt,[ terpri	   ; First position
		   jrst enet3]
	JUMPE tt,[ type dspc,/H!/
		   jrst enet3]	   ; Second position

	type dspc,/H@/	   ; Last position
	seto tt,		   ; First position again
	caia
enet3:	  aos tt		   ; Next position
	outstr tyoc,bp		   ; Type out the host name.
enet4:	aobjn t,enet0		   ; Get another entry.
	terpri
enet5:	restore [bp,d,b,a]
	ret

;;; Set Network Host table.

snet:	save [d]
	movei d,snthtb
	call haktab
	  caia
	    aos -1(p)
	restore [d]
	ret




;;; Print the table of TTY lines

ttylis:	move tt,@ttyin0(a)
	move t,@ttyin1(a)
	setz x,			   ; TTY #
	setz a,			   ; # of tty's typed
ttyls0:	caile x,77		   ; Last TTY?
	  jrst ttyls3
	trnn tt,1		   ; Is this one in the table?
	  jrst ttyls2		   ;   Nope, don't print
	skipe a			   ; If not first, separate
	  type tyoc,/, /
	tyo tyoc,["T]		   ; TTY number,
	caige x,10
	  tyo tyoc,["0]		   ; complete with no leading zero suppression
	8type tyoc,x
	aos a			   ; count # printed on this line
	caige a,20		   ; Line full?
	  jrst ttyls2		   ;   line not full
	setz a,			   ; start
	terpri			   ; a new line
ttyls2:	lshc t,-1		   ; next TTY
	aoja x,ttyls0
ttyls3:	terpri
	ret

DDTTTB:
ttyms0==:0
	440700,,[asciz /ADo you wish to make some TTY's get DDT?/]
	440700,,[asciz /ADo you wish to make some TTY's get PWORD?/]
ttyms1==:2
	440700,,[asciz /The following TTY's now get DDT:
/]
	440700,,[asciz /The following TTY's now get PWORD:
/]
ttyin0==:4
	iorm tt,ddtty0
	andcam tt,ddtty0
ttyin1==:6
	iorm t,ddtty1
	andcam t,ddtty1


DILTTB:
	440700,,[asciz /ADo you wish to make some TTY's reserved?/]
	440700,,[asciz /ADo you wish to make some TTY's not reserved?/]

	440700,,[asciz /The following TTY's are now reserved:
/]
	440700,,[asciz /The following TTY's are no longer reserved:
/]

	iorm tt,dltty0
	andcam tt,dltty0

	iorm t,dltty1
	andcam t,dltty1

; END of DILTTB

ttyset:	move bp,[440700,,msgbuf]
	move b,a		   ; Remember the address of our info block
	askusr @ttyms0(b)
	  jrst ttyttp
	jrst ttyttx

ttyttp:	aos b			   ; Let's get the alternate version
	askusr @ttyms0(b)	   ; Ask about it
	  ret
ttyttx:	move t,ttyms1(b)	   ; Get the informative message
	copy t,bp		   ; and copy to mail output
	type dspc,/ATTY #'s (Tnn, Tnn):  /
	call readln		   ; Read in a line
	  ret
	move bp,argloc
ttyst0:	sosge argcnt		   ; Take one character
	  ret			   ;   Nothing left
	ildb ch,bp
	caie ch,40		   ; space
	  cain ch,",
	    jrst ttyst0		   ;   Ignore
	caie ch,"t
	  cain ch,"T
	    jrst ttyst1		   ;   Ignore, number follows
	cain ch,^I
	  jrst ttyst0		   ; Ignore
	jrst ttyst2

ttyst1:	sosge argcnt		   ; Take one character
	  jrst ttystx
	ildb ch,bp
ttyst2:	cail ch,"0		   ; Digit-p?
	  caile ch,"9
	    jrst ttystx		   ;   No, lose
	subi ch,"0
	movei a,(ch)
	sosge argcnt		   ; Take one character
	  jrst ttyst3		   ;   Nothing left
	ildb ch,bp		   ; Next character
	caie ch,",		   ; Terminator?
	  cain ch,40
	    jrst ttyst3
	cain ch,^I
	  jrst ttyst3
	cail ch,"0		   ; Digit-p?
	  caile ch,"9
	    jrst ttystx		   ;     No, lose
	subi ch,"0		   ; convert to number
	lsh a,3
	addi a,(ch)		   ; full 2-digit octal number
ttyst3:	movei tt,1		   ; get the bit
	setz t,
	lshc t,(a)		   ; refering to this TTY number
	save [t,tt]
	call plock		   ; Lock the database
	restore [tt,t]
	xct ttyin0(b)
	xct ttyin1(b)
	call pulock		   ; unlock the database
	jrst ttyst0

ttystx:	type dspc,/AInvalid TTY #
/
	ret


SUBTTL	Hacking Groups

grpprt:	save [t,a]
	terpri
	movei t,pwgnam		   ; Table of group names
	movei a,pwgrct		   ; Count of entries
	call e6tab0		   ; Print the table
	restore [a,t]
	ret

;; Print the status of a group, offering to set it

grpset:	save [x,ch,t,a,c]
	call r6arg		   ; Parse our argument
grpstr:	move bp,[440700,,usrbfr]
	skipe arg6
	  jrst [ call rdgrp6	   ; Look up the group
		   jrst grpst	   ;   Lost...
		 jrst grpst1]
grpst:	type dspc,/C/
	call rdgrp		   ; List all the groups
	  jrst grpstx
grpst1:	movei c,(a)		   ; Get group #
	save [bp]
	move bp,[440700,,msgbuf]
	call grpdsc		   ; Describe the group
	restore [bp]
	terpri
	output tyoc,msgbuf	   ; print the description on the screen
	ask /ADo you wish to modify anything?/
	  jrst grpst

	call grpdsc

grpst2:	type dspc,/C/
	movei a,(c)
	save [bp]
	move bp,[440700,,msgbuf]
	call grpdsc		   ; Describe the group in the mail
	restore [bp]
	output tyoc,msgbuf	   ; put description at top of screen
	type dspc,/A
1 -- Weekday time restriction
2 -- Saturday time restriction
3 -- Sunday time restriction
4 -- Name of group
5 -- Daytime use message
6 -- Dialup use message
7 -- Dialup permission
8 -- Choose another Group
9 -- Quit

Enter one:  /
	.iot tyic,ch
	cain ch,"1
	  jrst [ call gtimrd	   ; Read the date
		   jrst grpstf	   ;   Failed, retry
		 call plock	   ; Make the page writable
		 dpb a,[dm$wds pwgrdm(c)]  ; Set the start time
		 dpb b,[dm$wde pwgrdm(c)]  ; and the unstart time
		 call pulock	   ; Repurify the page
		 jrst grpst9]	   ; More!
	cain ch,"2		   ; saTurday time restriction
	  jrst [ call gtimrd	   ; Read the date
		   jrst grpstf	   ;   Failed, retry
		 call plock	   ; Make the page writable
		 dpb a,[dm$sts pwgrdm(c)]
		 dpb b,[dm$ste pwgrdm(c)]
		 call pulock
		 jrst grpst9]
	cain ch,"3
	  jrst [ call gtimrd
		   jrst grpstf
		 call plock
		 dpb a,[dm$sns pwgrdm(c)]
		 dpb b,[dm$sne pwgrdm(c)]
		 call pulock
		 jrst grpst9]
	cain ch,"4		   ; Change the name of the group?
	  jrst [ type dspc,/AEnter new name for this group:  /
		 save [bp]
		 call read6	   ; Read a 6bit name
		   jrst [ restore [bp]
			  jrst grpst2]
		 restore [bp]
		 skipn a,arg6	   ; The new name!
		   jrst grpst2	   ;   A Real Nothing
		 call plock	   ; Depurify it
		 movem a,pwgnam(c) ; update the name!
		 call pulock
		 jrst grpst9]
	cain ch,"5		   ; Daytime message?
	  movei a,timmsg(c)	   ; Address of where to put it
	cain ch,"6		   ; Dialup message?
	  movei a,dilmsg(c)	   ; Address of where to put it
	caie ch,"5
	  cain ch,"6
	    jrst [ type dspc,/AEnter new message:  /
		   save [bp]
		   call pwstxt	   ; Read in the message
		     jfcl
		   restore [bp]
		   jrst grpst9]	   ;   Abort, keep hacking
	cain ch,"7
	  jrst grpsdl
	cain ch,"8		   ; Choose another group?
	  jrst grpstn		   ;   yep!
	caie ch,"9
	  cain ch,"Q		   ; Quit?
	    jrst grpstx
	cain ch,"q
	  jrst grpstx
	type tyoc,/  Huh??  /
	jrst grpst2		   ; try again!

grpstn:	skipn rdxct		   ; Have we done anything yet?
	  jrst grpstr		   ;   nope, just keep trying
	call grpsml		   ; send the mail
	jrst grpstr		   ; reset!

grpsml:	write bp,/
---- becomes ----
/
	call grpdsc		   ; Describe the new state
	.mail grpmal		   ; Send the mail
	setzm rdxct
	ret


grpst9:	movem c,rdxarg		   ; Remember the group for sending mail
	movem bp,rdxbp
	move x,[call grpsml]
	movem x,rdxct		   ; make sure this gets sent when done
	jrst grpst2

grpstf:	type dspc,/AIllegal date format!/
	movei x,15.
	.sleep x,
	jrst grpst2		   ; loop

; hack dialup toggling
grpsdl:	call plock
	movei t,1		   ; Bit for group # to mask in dialup
	lsh t,(c)		   ; restriction test
	tdne t,pwgdil		   ; Check against database
	  jrst grpsdn
	iorm t,pwgdil
	call pulock
	jrst grpst9

grpsdn:	andcam t,pwgdil
	call pulock
	jrst grpst9

grpstb:	restore [bp]
grpstx:	restore [c,a,t,ch,x]
	ret

;; GRPDSC takes a group in A, and describes that group

grpdsc:	save [x,t,tt,a]
	move x,pwgnam(a)	   ; include the group name
	idpb6 x,bp
	write bp,/	Weekday:  /
	ldb t,[dm$wds pwgrdm(a)]   ; Get when it starts
	ldb tt,[dm$wde pwgrdm(a)]  ; Get when it ends
	call gprtim
	write bp,/;  Saturday:  /
	ldb t,[dm$sts pwgrdm(a)]
	ldb tt,[dm$ste pwgrdm(a)]
	call gprtim
	write bp,/; Sunday:  /
	ldb t,[dm$sns pwgrdm(a)]
	ldb tt,[dm$sne pwgrdm(a)]
	call gprtim
	push sp,a
	skipn timmsg(a)		   ; Does this group have a restriction
	  jrst grdsc2		   ; message?
	movei a,timmsg(a)
	write bp,/
This group's daytime restriction message is:
/
	call pwsget		   ; get the message
	move x,[440700,,tmpbuf]
	copy x,bp		   ; copy it into the text

grdsc2:	pop sp,a
	movei t,1		   ; Bit for group # to mask in dialup
	lsh t,(a)		   ; restriction test
	tdne t,pwgdil		   ; Check against database
	  jrst [ write bp,/
This group is NOT allowed to use the dialups.
Message:
/
		 movei a,dilmsg(a) ; Get the dialup message
		 call pwsget
		 move x,[440700,,tmpbuf]
		 copy x,bp
		 jrst grdsc3]
	write bp,/
This group IS allowed to use the dialups.
/
grdsc3:	setz x,			   ; Follow the output with a NUL to be IDPB'd
	move t,bp
	idpb x,t
	restore [a,tt,t,x]
	ret


;; Take start time in T and end time in TT (group restriction format, of
;; # of 1/2 hours past midnight; 77 ==> no restriction).  Write the time to BP

gprtim:	save [x,t]
	cain t,77		   ; No restriction?
	  jrst [ write bp,/NONE/
		 restore [t,x]
		 ret]
	lsh t,-1		   ; Get # of hours past midnite
	caige t,10.		   ; If < 10, type leading zero explicitly
	  jrst [ tyobpi bp,"0
		 jrst .+1]
	idpb10 t,bp		   ; Write the time to the BP
	restore [t]
	trne t,1		   ; 1/2 hour?
	  jrst [ write bp,/30-/
		 jrst .+1]
	trnn t,1		   ; On the hour?
	  jrst [ write bp,/00-/
		 jrst .+1]
	save [tt]
	lsh tt,-1		   ; Get # of hours past midnite
	caige tt,10.		   ; If < 10, type leading zero explicitly
	  jrst [ tyobpi ,"0
		 jrst .+1]
	idpb10 tt,bp
	restore [tt]
	trne tt,1		   ; 1/2 hour?
	  jrst [ write bp,/30/
		 jrst .+1]
	trnn tt,1		   ; On the hour?
	  jrst [ write bp,/00/
		 jrst .+1]
	restore [x]
	ret

;;; GTIMRD reads in a restriction-format time rage into A and B.
;;; Allowable formats are:  NONE; 6-12; 600-1230

gtimrd:	save [bp]
	type dspc,\AEnter time range accurate to 1/2 hour (i.e. 6-1430) or NONE
Time:  \
	move bp,[440700,,msgbuf]
	call readln		   ; Read in a line
	  jrst gtimrx
	move bp,argloc
	move ct,argcnt
	cain ct,4		   ; Is this 4 long?
	  jrst gtimra		   ;   Maybe it's NONE?
gtimr0:	setzb a,b
	call gtimrn		   ; Get the first #
	  jrst gtimrx
	ildb ch,bp		   ; Advance past the termination
	soje ct,cpopj
	exch a,b
	call gtimrn		   ; Get the second #
	  jrst gtimrx
	exch a,b
	caile a,48.		   ; Had better be less than or = midnight
	  jrst gtimrx
	caile b,48.
	  jrst gtimrx
	cain a,77		   ; If this is ALL, they can be the same
	  jrst gtimwn
	caml a,b		   ; Otherwise
	  jrst gtimrx		   ;   A had better be less than B
gtimwn:	skipn ct		   ; Is there still more stuff?
gtimx1:	  aos -1(sp)		   ;   No, fine, skip return
gtimrx:	restore [bp]
	ret

gtimra:	push sp,bp
	ildb ch,bp		   ; Check first char
	caie ch,"n
	  cain ch,"N
	    caia
	      jrst gtima0
	ildb ch,bp
	caie ch,"o
	  cain ch,"O
	    caia
	      jrst gtima0
	ildb ch,bp
	caie ch,"n
	  cain ch,"N
	    caia
	      jrst gtima0
	ildb ch,bp
	caie ch,"e
	  cain ch,"E
	    caia
	      jrst gtima0
	movei a,77		   ; Return ALL time
	movei b,77
	pop sp,bp
	jrst gtimx1

gtima0:	pop sp,bp
	jrst gtimr0

;; Gobble one number
gtimrn:	call gtimrp		   ; Count the digits
	  ret			   ;   Syntax error
	cain x,1		   ; 1 is simple
	  jrst gtimn1
	cain x,2		   ; 2 is also fairly simply
	  jrst gtimn2
	cain x,3		   ; 3 is of 100 or 130 variety
	  jrst gtimn3
	cain x,4		   ; 4 is full 24 hr time
	  jrst gtimn4
	ret			   ; Too many digits, syntax error

gtimn2:	ildb ch,bp		   ; Get 10's digit
	cail ch,"3		   ; Illegal digit?
	  ret
	subi ch,"0		   ; DIGIT-WEIGHT
	movei a,(ch)		   ; accumulate in A
	imuli a,10.		   ; 10's digit
gtimn1:	ildb ch,bp		   ; Next digit
	subi ch,"0
	addi a,(ch)		   ; That's the number!
	imuli a,2		   ; convert to # of half-hours
	jrst popj1

gtimn3:	call gtimn1		   ; Gobble down the hour's digit
	  ret
	caia
gtimn4:	  call gtimn2		   ;   Gobble down the hour's digits
	    jfcl
	ildb ch,bp		   ; Get the 10-minute digit
	cain ch,"3		   ; 1/2 hour?
	  aos a			   ;   Count it
	caie ch,"0		   ; Is it a legal time?
	  cain ch,"3
	    caia
	      ret		   ;       Nope!
	ildb ch,bp		   ; Is it a legal time?
	cain ch,"0		   ; Either 00 or 30
	  jrst popj1		   ;   yes
	ret			   ; no

;; Count off the digits of one number
gtimrp:	move t,bp		   ; Remember where our number begins
	setz x,			   ; # of characters in this number
gtimp0:	ildb ch,bp		   ; or maybe not
	cain ch,"-		   ; -?
	  jrst gtimp1
	caig ch,"9		   ; Digitp?
	  caige ch,"0
	    ret			   ;   Nope, syntax error
	aos x
	sojg ct,gtimp0

gtimp1:	move bp,t		   ; Back up our BP
	jrst popj1



SUBTTL	Assorted Commands

;;; Implement the FIND command in PANDA.

kfind:	call r6arg		   ; Parse out "creator" arg.
	call rcarg		   ; Parse out control args.
	  ret
	move x,crgbts		   ; Check out control options.
	setzm brfflg		   ; Assume we want verbosity.
	trne x,CF$PBF		   ; If we want it brief
	  setom brfflg		   ;  remember so.
	skipn t,arg6		   ;check for an argument.
	 jrst [ type dspc,/AHuh? I dont know who to look for.
/
		ret ]
	movem t,cretor		   ; Remember the target creator.
kfind1:	.suset [.rhsname,,ot.snm]  ; Change output sname to our own dir.
	movei x,[asciz /AWhere should I file the list?/]
	movem x,filprm		   ; Set up prompt.
	movei x,outfil		   ; Say this is the default.
	call flprmp		   ; Prompt for file name with default.
	call readfi		   ; Read the file name.
	 jfcl			   ;   Eh?
	move d,argptr		   ; Pointer to the file name string.
	movei b,outfil		   ; Where to put the file name.
	call rfn"rfn		   ; Parse file name.
	syscal open,[cnti .uao	   ; Open our output file.
		     argi dsko
		     ot.dev
		     ot.fn1
		     ot.fn2
		     ot.snm ]
	 jrst [	type dspc,/ACannot open output file.
/
		ret ]
	call maplsr		   ; Map in the INQUIR database.
	setz a,			   ; Begin counting entries.
kfind2:	call pwdget		   ; Get an entry.
	move x,pdunam		   ; Convert his name to normal 6bit.
	sub x,[742532,,732643]	   ; Will oddities never cease?
	rot x,-13		   ; (obviously not).
	movem x,uname		   ; Save it for later.
	save [b,a]		   ; Save our AC's for later.
	movei a,pwadmn		   ; Get the table of creators.
	call pwsget
	ldb tt,[pi$crt pdinfo]	   ; Get the creator index.
	jumpe tt,kfind9		   ; Cannot match  unknown creator.
	move tt,tmpbuf-1(tt)	   ; Get this entry's creator name.
	came tt,cretor		   ; If this is not the target creator
	 jrst kfind9		   ;  try another entry.
kfind3:	move bp,[440700,,msgbuf]   ; Bp to information we find.
	tyobpi bp,^M
	tyobpi bp,^J
	move x,uname
	idpb6 x,bp		   ; Write the uname.
	skipe brfflg		   ; If we are being brief
	 jrst kfind8		   ;  dont print anything else.
	tyobpi bp,^I
	ldb tt,[pi$sta pdinfo]	   ; Get the state of this account
	cain tt,ps%sys		   ; Is this a system name?
	  jrst [ write bp,/[sys]/
		 jrst .+1]
	cain tt,ps%rfs		   ; Is he refused?
	  jrst [ write bp,/[rfs]/
		 jrst .+1]
	cain tt,ps%off		   ; Turned off?
	  jrst [ write bp,/[off]/
		 jrst .+1]
	cain tt,ps%hld		   ; On hold?
	  jrst [ write bp,/[hld]/
		 jrst .+1]
	cain tt,ps%ok
	  jrst [ write bp,/[ok]/   ; Would you believe, normal?
		 jrst .+1]
	tyobpi bp,^I
kfind4:	movei a,lsrc		   ; Tell LSRTNS what channel it can hack.
	move b,uname		   ; Get Inquire entry address.
	call lsrtns"lsrunm	   ; Is it there?
	 jrst [ write bp,/ --> Not in Inquire database <--/
		jrst kfind8 ]
	movem b,lsrptr		   ; Save pointer to this Inquire entry.
	movei a,lsrtns"i$name	   ; Find his name.
	call lsrtns"lsritm
	  jrst [write bp,/  --> Name Missing in Inquire <--/
		jrst kfind8 ]	   ;  unsuccessful.
	move b,bp		   ; Where to get his name.
	call lsrtns"lsrnam	   ; Write his name nicely.
	  jfcl			   ;  eh?
	move bp,b		   ; Recover the byte pointer.
	decbp bp		   ; Back over the null.
kfind8:	setz ch,		   ; End text with a nul.
	idpb ch,bp
	output dsko,msgbuf	   ; Write text to file.
kfind9:	restore [a,b]		   ; Pick up count where we left off.
	addi a,pwleng		   ; Point to next entry.
	camg a,pwcnt		   ; Is this all?
	  jrst kfind2		   ;  Nope, loop for another one.
	.close dsko,		   ; All done. Close output file.
	ret


;;; Implement the CHECK command in PANDA.

kcheck:	save [a,b,c,d,e]
	movei x,[asciz /AInput file of alleged users?/]
	movem x,filprm		   ; Set up prompt.
	movei x,infil		   ; Say this is the default.
	call flprmp		   ; Prompt for file name with default.
	call readfi		   ; Read the file name.
	 jfcl			   ;   Eh?
	move d,argptr		   ; Pointer to the file name string.
	movei b,infil		   ; Where to put the file name.
	call rfn"rfn		   ; Parse file name.
	syscal open,[cnti .uai	   ; Open our input file.
		     argi dski
		     in.dev
		     in.fn1
		     in.fn2
		     in.snm ]
	 jrst [	type dspc,/AUnable to open the file!
/
		jrst kchec9 ]
	setzm checkp		   ; Assume we are looking for accounts.
	ask /ALooking for valid accounts?/
	 jrst [	setom checkp
		type dspc,/AOK, listing unknown UNAMEs./
		jrst .+1 ]
	movei x,[asciz /AFile to list invalid UNAMEs in:/]
	skipn checkp		   ; Alter prompt if looking for winners.
	 movei x,[asciz /AFile to list valid accounts in:/]
	movem x,filprm		   ; Set up prompt.
	movei x,outfil		   ; Say this is the default.
	call flprmp		   ; Prompt for file name with default.
	call readfi		   ; Read the file name.
	 jfcl			   ;   Eh?
	move d,argptr		   ; Pointer to the file name string.
	movei b,outfil		   ; Where to put the file name.
	call rfn"rfn		   ; Parse file name.
	syscal open,[cnti .uao	   ; Open our output file.
		     argi dsko
		     ot.dev
		     ot.fn1
		     ot.fn2
		     ot.snm ]
	 jrst [	type dspc,/ACannot open output file.
/
		jrst kchec9 ]
	setz e,			   ; Count UNAMEs read from file.
	setz d,			   ; Count UNAMEs which are really accounts.
kchec1:	setz a,			   ; Accumulate uname from DSKI.
	move b,[440600,,a]	   ; Sixbit BP to result.
kchec2:	.iot dski,ch
	cain ch,^M		   ; Check for CR
	 jrst [	.iot dski,ch	   ;   Gobble  LF.
		jrst kchec3 ]	   ;   End of UNAME.
	andi ch,-1
	cain ch,^C
	 jrst kchec7		   ; EOF - no more names.
	cail ch,140		   ; Hack case.
	 subi ch,40		   ;  To sixbit.
	tlnn b,770000		   ; Gobble only six characters.
	 jrst kchec3
	subi ch,40
	idpb ch,b		   ; Remember this char.
	jrst kchec2		   ; Go get another.
kchec3:	aos e			   ; Count each UNAME
	movem a,uname
kchec4:	call pwdlok		   ; Check for uname in A.
	 jrst [	skipn checkp	   ;   No account.
		 jrst kchec6	   ;    (We're looking for accounts.)
		jrst kchec5 ]	   ;   (We're looking for others.)
	skipe checkp		   ;  Has account.
	 jrst kchec6		   ;   (We're looking for others.)
kchec5:	aos d			   ; Write down this UNAME.
	6type dsko,uname	   ; Type uname in file.
	tyo dsko,[^M]
	tyo dsko,[^J]
kchec6:	jrst kchec1		   ; Get another.

kchec7:	type dspc,/AChecked /
	10type tyoc,e
	type dspc,/ UNAMEs; /
	10type tyoc,d
	skipn checkp
	 jrst [	type dspc,/ corresponded to real accounts./
		jrst kchec9 ]
	type dspc,/ did not correspond to accounts./
kchec9:	.close dski,		   ; All done.
	.close dsko,		   ; Close files.
	restore [e,d,c,b,a]
	ret


;;; Implement the PRINT command in PANDA

kuprin:	call r6arg		   ; Parse the command
	call rcarg
	  ret
	move x,crgbts		   ;check it out
	setzm allflg
	setzm brfflg
	setzm nodate
	trne x,CF$PAL		   ;do we want it all?
	  setom allflg		   ;  yes, note the fact
	trne x,CF$PND		   ; suppress dates
	  setom nodate		   ;   yes, note the fact

	trne x,CF$PAL		   ;if it's -ALL,
	  do [tyo dspc,[^P]
	      tyo dspc,["C]]	   ;   clear the screen
	trne x,CF$PBF		   ; do we want it brief?
	  setom brfflg
	skipn t,arg6		   ;check for an argument.
	  pjrst pwdprt		   ;  none, print them all
	came t,[sixbit /*/]
	  camn t,[sixbit /ALL/]	   ;  is it special case of "ALL" ?
	    pjrst pwdprt	   ;    yes, print all them wihtout INQUIR
	camn t,[sixbit /*UNKNOWN/]
	  jrst pwprul
	camn t,[sixbit /*NULL/]
	  jrst pwprnl
	camn t,[sixbit /*NEW/]
	  jrst pwprnw
	movem t,uname		   ;remember this person
	move d,a		   ;transfer pointer
	call maplsr
	pjrst usrwho		   ;who? are You?


]  ; End of IFN $$PAND


SUBTTL	Login

IFE $$PAND,[
ulogin:	setom altusw		   ;note that we did it this way
	terpri
	setzm lbrief
	skipe altifx		   ; If 0U or friends
	  setom lbrief		   ;   note we want no init file.
	jrst klog0

;;; We enter here from the :LOGIN form.
lbfbts=16			   ;bits saying brief login

klogin:	call r6arg		   ; Parse up the 6bit name
	skipn arg6		   ; Did he do :LOGIN<CR> ?
	  jrst [type dspc,/ADo :LOGIN <NAME>
/
		ret]
	call rcarg		   ; Decode the control arguments
	  ret
	move x,crgbts		   ;check the switches
	trne x,cf$lni		   ;did he ask for no init file? (-bf, -noinit)
	  setom lbrief		   ;  note that he wants brief login

klog0:	move x,arg6		   ;our argument is our XUNAME
	movem x,xuname		   ;  retry it here
	movem x,uname
	.suset [.ssname,,x]	   ;for the sake of PEEK
	call pwdmap		   ;map in the database
	call pwdlok		   ;does he have a password?
	  pjrst pwhelp		   ;  no, let's help him out.

	save [uname]
	call pwdget		   ;get his old entry
	restore [uname]
	call syschk		   ;check for system name
	  jrst [ldb x,[pi$sta pdinfo]  ;  check again, for HOLD
		caie x,ps%hld
		  ret
		pjrst ungot]	   ;Hackity hack, he's on hold, let him hack

	call diltim		   ;prohibited by dialup or daytime?
	  phaser		   ;  yes, flush him.
	move x,crgbts		   ;check to see if he wanted to change it
	trne x,cf$lpw		   ;did it?
	  do [setzm ttyflg	   ;  be sure he sees this
	      type dspc,/AEnter your old password now!
/]

	call pwask
	  jrst [type dspc,/AIncorrect.
/
		sosge failct	   ;  don't let him hack passwords forever
		  phaser
		  ret]
	setzm pwbuf
	setzm pwbuf+1
	move x,crgbts		   ;get our flags
	trne x,cf$lpw		   ;do we want to change it?
	  do [call pwdchg	   ; yes, change it!
	        ret]		   ;  he rubbed out!

;;; When we get here, we've either gotten the entry via PWDGET or
;;; a new one from PWDCHG via PWDCNS.
	
log.in:	move x,pdflag		   ;get the flags
	tlze x,%pfnew		   ;turn off the new user bit if any
	  movem x,pdflag	   ;  restore it
	syscal rqdate,[val t]	   ;get the current date
	  setom t		   ;  don't know!?
	hlrm t,pddate		   ;right half = login date
	call pwdput		   ;  replace it
	syscal login,[uname ? argi 0 ? xuname]
	  caia			   ;don't go to DDT if we didn't win!
	jrst goddt
	move x,calerr		   ;get the error returned
loglos:	caie x,%erojb		   ;is it "CAN'T MODIFY JOB" ?
	  cain x,%etop		   ;  or "NOT TOP LEVEL"?
	    jrst [type dspc,/AYou are hacking me.
/
		  jrst goddt]	   ;  load DDT anyway
	cain x,%ebdfn		   ;is it "ILLEGAL FILENAME" ?
	  error /Attempt to log in with illegal name./
	cain x,%ensmd		   ;is it "MODE NOT AVAILABLE" ?
	  error /Attempt to log with intact inferiors./
	caie x,%eexfl		   ;is it "FILE ALREADY EXISTS" ?
	  error /Unknown error from LOGIN call./

	move t,[000600,,UNAME]	   ;yes, let's hack the uname
klogn0:	ldb ch,t		   ;gobble a char
	cain ch,0		   ;is it a space?
	  jrst [decbp6 t	   ;  back up the byte ptr
	        jrst klogn0]	   ;  and try another
	came t,[000600,,UNAME]	   ;is it 6 chars wide?
	  ibp t			   ;  no, space over the last char
	movei ch,'0		   ;add a zero in at the end
	dpb ch,t		   ;deposit it

klogn1:	syscal login,[UNAME ? argi 0 ? xuname]	;try again with name0
	  jrst [move x,calerr	   ; lost, find out why.
	        caie x,%eexfl	   ;   was it because duplication?
		  jrst loglos	   ;     no, go barf and return to caller
		addi ch,1	   ;yes, advance the digit at end of name
		dpb ch,t	
		caig ch,'@	   ;don't advance into the letters
		 jrst klogn1
		type dspc,/AToo many users all logged in with the same name.
/
		ret  ]

	type dspc,/AAlready logged in, so logged you in as /
	6type tyoc,UNAME	   ;tell him who he is
	terpri
	jrst goddt

] ; end of IFE $$PAND
 
pwdchg:	type dspc,/AI will now ask you for a password.
Give anything you like, up to 12 characters.
Case does not matter.
End it with a carriage return.
/
pwadd5:	call pwread
	  ret			   ;rubbed out or something
	move x,pwbuf		   ;get the response
	movem x,hispas		   ;and save it in HISPAS
	move x,pwbuf+1		   ;so we can compare with his next response
	movem x,hispas+1	   ;to avoid typo's and lossage
	type dspc,/AI will now ask you to type the password in again,
to avoid the possibility of errors.
/
	call pwread		   ;get it again
	  ret			   ;  rubbed out?
	
	move t,pwbuf		   ;get his second response
	move tt,pwbuf+1
	camn t,hispas		   ;is it right
	  came tt,hispas+1	   ;  the same as before?
	    jrst [type dspc,/AThey weren't the same.  We will try it again.
/
		  jrst pwadd5]	   ;    give him another chance
	call pwdini		   ;Initialize the entry.
	call pwdmak		   ;and add in the password
ife $$pand,[
	type dspc,/AOK, be sure to remember it!
If you have any difficulties, send mail to USER-ACCOUNTS
or call /
	movei a,phone
	call pwgtxt		   ; Print the phone #
]
.else [	type dspc,/ADone.
/]
	jrst popj1		   ;skip-return to denote success

constants


;;; Unknown user routines.
;;; TELAPL sees how many losing unames have been tried.
;;; TELAP1 types verbose "no auto-applications" message.

telapl:	move a,failun		   ; See how many times loser has lost.
	caige a,2		   ; If only first time, just mention it.
	 jrst [	type dspc,/AThat name is not known.
/
		ret ]		   ; (Save long messages for two-time losers.)
telap1:	movei a,naplmg		   ; Message about why no applications.
	terpri
	call pwgtxt		   ; Type it out.
	terpri
	ret

;;; help routine for unknown names.

ife $$pand,[
pwhelp:	aos failun		   ; Count the number of unkown unames tried.
	skipn atoapl		   ; Are we automatically running applications?
	  jrst telapl		   ;   No, so make sure he gives a good name.
pwhel0:	call maplsr
	movei a,lsrc
	move b,uname
	call lsrtns"lsrunm
	  jrst [type dspc,/AThat name is not known.
/
		sosge failct
		  phaser
		jrst pwhel1]	   ;help him out
	type dspc,/AThere is no password associated with that name.
/
	sosge failct		   ;don't let him hack us forever
	  phaser		   ;  a loser, hack him back

pwhel1:	ask /Do you wish to apply for an account?/
	  ret
	pjrst acoun1		   ;give him help!

constants

;;; Ask for various info useful to USER-ACCOUNTS

kacoun:	setzm uname		   ;no UNAME is known!
	skipn atoapl		   ; If we are not doing auto-applications
	  jrst telap1		   ;   verbosely explain the situation.
acoun1:	tyo dspc,[^P]		   ;clear the screen
	tyo dspc,["C]
	type dspc,/ANote:  If you get into difficulties and wish to
abort this, just type a ^G (Control-G, the character that beeps)
/
	setom apltim
	skipe uname		   ;If there is no UNAME
	  jrst unchk		   ;  there can't be any valid password!

	setzm ttyflg		   ;turn on the TTY
	move x,[
call [type dspc,/AHere are a few questions about your desire for an account.

A login name may be up to 6 characters, preferably letters.
There may be no spaces in this name.
Case is not preserved.  It should *NOT* end in digits.
Enter your chosen login name:
/
		setzm ttyflg	   ;turn on the TTY
		skipn uname	   ;if there is a uname
		  type tyoc,/
Enter your chosen login name:  /
		ret]]
	movem x,helper		   ;print help on this phase of the world
	movem x,dsprmp
	xct x			   ;print out the help
	type tyoc,/
(You may type "^_H" (Control-underscore H)
  (or the [HELP] key if you have one)
  for more help at any point in this program.)
/

aurd0:	type tyoc,/(End your input with a Carriage Return)
Enter your chosen login name:  / 

auread:	move bp,[440700,,msgbuf]	   ;input buffer
	setz count,		   ;no characters read yet.
	call read6		   ;read a 6-bit word
	  jrst aurd0		   ;  ask him for it again
	cain ch,40		   ;did he end with a space?
	  jrst [type dspc,/AThe name must not have any spaces in it!
Enter your chosen user-name:  /
		jrst auread]
	skipn t,arg6		   ;get his chosen UNAME
	  jrst [xct helper	   ;  help him out
	        jrst auread]	   ;  try some more
	movem t,uname		   ;remember this name

;;; check the UNAME for trailing digits
unchk:	type dspc,/AYou have given the login name "/
	6type tyoc,uname
	type tyoc,/"
/
	move t,uname		   ;get the UNAME we want to check
	setz tt,		   ;clear TT for shifting into
	lshc t,-6		   ;get the last 6bit char
	jumpe tt,.-1		   ;looping until we get it!
	lsh tt,-36		   ;right justify it
	cail tt,'0		   ;is it between 0
	  caile tt,'9		   ;  and 9?
	    caia		   ;    no, so don't complain
	      jrst [type dspc,/AThe name must not end in a digit!
Please try again./
		    jrst aurd0]	   ;  gobble down another attempt

				   ;now that we've got the UNAME, do the work

	call pwdmap		   ;map in the database
	call pwdini		   ;get a password, (or make it!)
	ldb x,[pi$sta pdinfo]
	caie x,ps%hld		   ; Is it a account held for more info
	  cain x,ps%new		   ;   or a new account?
	    caia		   ;     Great, let him hack it
	      jrst accuse	   ;	   Nope, tell him it's in use

acounx:	call pwdlok		   ;is he in the database?  Can't let him ask
				   ;for somebody elses!
	  jrst ungot		   ;  not there.  Get info
accuse:	type dspc,/AThat name is in use already.  Please choose another.
/
	jrst acexit		   ;and exit


ungot:	setom apltim
	move bp,[440700,,msgbuf]
	write bp,/Name:  /
	movem bp,namloc		   ;remember where his name starts!
	call maplsr		   ;map in the database
	movei a,lsrc		   ;tell LSRTNS what channel it can hack
	move b,uname		   ;ask about this UNAME
	setzm gotinq		   ; Set by ASKNAM if INQUIR entry exists
	call lsrtns"lsrunm	   ;is it there?
namfoo:	  do [	type dspc,/AEnter your FULL name.
(end your input with a Carriage Return)
/
		move x,[type dspc,/CPlease type your full name, followed by
a carriage return.
/]
		movem helper
		call readln	   ; Read a single line
		  jrst qitnam	   ;    nope, he quit on us.  Don't 
][
		call asknam	   ;  ask if he's the right one  
		  jrst qitnam]	   ;    nope, stop this!

	setz ch,		   ;a null byte terminates the name
	idpb ch,bp		   ;so we can hack the name separately
	movem bp,uinfo		   ;UINFO gets point to start of user info
	write bp,/From net site /
	move t,[440700,,hstnam]
	copy t,bp
	write bp,/
/
	write bp,/Purpose:  /
	type tyoc,/
What do you wish to use the machine for?
(end your input with a ^C ([Control-C]))
/
	move x,[type dspc,/CPlease explain briefly what you indend to use
our machine for. 
End your input with a control-C.
(type a ^C (Control-C) by holding down the control key
and typeing "C")
/]
	movem x,helper
	call readsn		   ; Read multiple lines
	  jrst qitnam
	type dspc,/APlease give us your telephone number and (paper postal) mailing
address where you can be contacted.
(End your input with a ^C)
/

	write bp,/Address:  /
	move x,[type dspc,/CEnter your U.S. MAIL adress and phone number:
/]
	movem x,helper
	call readsn		   ; Read multiple lines
	  jrst qitnam
	write bp,/Affiliation:  /
	type dspc,/AWhat, if any, is your affiliation?
(End your input with a ^C)
/

	move x,[type dspc,/CEnter your affiliation.  Just a name of
an organization connected with this machine or the net, a school, or
simply "none".
(End your input with a ^C)
/
]

	movem x,helper
	call readsn		   ;read the frob
	  jrst qitnam		   ;  quit!

	type dspc,/ANow you get to tell what password you wish.
/
	move t,uname
	move b,[sixbit /ACOUNT/]   ;gotta open an output file for the account
	call opnout		   ;open an output file
	typout dsko,aplmal+ml.txt  ;output the text of the application
	movei b,aplnam		   ;rename to final application file name
	call rnmfn2
	call pwdchg		   ;get him a password
	  jrst .-1		   ;  keep at him!

	movei x,ps%apl		   ; Now lets set the account state
	dpb x,[pi$sta pdinfo]	   ; to 'Applied'

	call pwdput		   ;and install it

	.mail aplmal		   ;mail in an application
	.mail telmal		   ;and notify

type dspc,/A
Please wait now for a few minutes; Someone may
contact you online.  If not, then check back in a day or so;
try loging in.  If it hasn't been granted yet, there may be mail for
you.  You may read it by doing
:PRMAIL /
	6type tyoc,uname	   ;spell it out for him!
	type tyoc,/

Should you desire to change your password, you may do
:HELP LOGIN for info on how to change your password, or
simply do:
":LOGIN /
	6type tyoc,uname
	type tyoc,/ -CHANGE"
It will then ask you for your old password (to make sure you are you!)
and then it will ask you to give it a new password, of your
own chosing.
/
	skipn gotinq		   ; If he lacks an INQUIR entry, tell him
				   ; about INQUIR
	  type dspc,/A
The first time you log in, a program will be automatically
run to get certain information about you.  Please answer it
as well as you can.  Don't be intimidated, think of it as
your introducing yourself to us.  In return, you will find
us quite friendly.
/
acexit:	setzm apltim
	ret			   ;that's all, folks!

qitnam:	syscal delewo,[argi dsko]  ;flush the mail file
	  jfcl
	.close dsko,		   ;close the file too!
	jrst acexit		   ;and exit

.upure
uinfo:	0			   ;byte pointer to user info block
namloc:	0			   ;byte pointer to start of user's name!
.pure

]  ;; END IFE $$PAND,


SUBTTL	Command Handlers

ife $$pand,[
;;; TCTYP
jtctyp: move t,[ftctyp,,j.file]
	blt t,j.file+4
	call infcr
	syscal cnsget,[argi tyic ? val x ? val x ? val x ? val x ? val ttyopt]
	  loss
	setzm hfdupf		   ; Reset default terminal characteristics.
	setzm bsflag
	setzm sailp
	move x,ttyopt		   ; Now check this TTY out.
	tlne x,%tosai		   ; does this TTY know about sail characters?
	  setom sailp		   ;   yes, so echo contols right
	tlne x,%tohdx		   ; Is this TTY a loser?
	  setom hfdupf		   ;  yep, note the fact!
	tlne x,%tomvb		   ; can this TTY move backwards?
	  setom bsflag		   ;  yep, notice it for half-duplex jobs that
	ret			   ;  try ^H !

ftctyp:	sixbit /DSK/
	sixbit /TS/
	sixbit /TCTYP/
	sixbit /SYS1/
]  ;; End IFE $$PAND

;;; LOADP
jloadp:	move t,[floadp,,j.file]
	jrst jwho1
floadp:	sixbit /DSK/
	sixbit /TS/
	sixbit /LOADP/
	sixbit /SYS2/

;;; WHO
jwho:	move t,[fwho,,j.file]
jwho1:	blt t,j.file+4
	call infcr
	ret
fwho:	sixbit /DSK/
	sixbit /TS/
	sixbit /WHO/
	sixbit /SYS1/

;;; HOST
j.hst:	move t,[f.hst,,j.file]
j.hst1:	blt t,j.file+4
	call infcr
	ret
f.hst:	sixbit /DSK/
	sixbit /TS/
	sixbit /HOST/
	sixbit /SYS3/


;;; NAME
j.name:	move t,[f.name,,j.file]
	blt t,j.file+4
	call infcr
	ret

f.name:	sixbit /DSK/
	sixbit /TS/
	sixbit /NAME/
	sixbit /SYS/

;;; LUSER 
jluser:	move t,[f.LUSE,,j.file]
	blt t,j.file+4
	call infcr
	ret

f.luse:	sixbit /DSK/
	sixbit /TS/
	sixbit /LUSER/
	sixbit /SYS1/

joctps:	move t,[f.octp,,j.file]
	blt t,j.file+4
	call infcr
	ret

f.octp:	sixbit /DSK/
	sixbit /TS/
	sixbit /OCTPUS/
	sixbit /SYS2/

;;; DATE
jdate:	move t,[f.date,,j.file]
	blt t,j.file+4
	call infcr
	ret

f.date:	sixbit /DSK/
	sixbit /TS/
	sixbit /DATE/
	sixbit /SYS1/

jtime:	move t,[f.time,,j.file]
	blt t,j.file+4
	call infcr
	ret

f.time:	sixbit /DSK/
	sixbit /TS/
	sixbit /TIME/
	sixbit /SYS1/

jtimes:	move t,[f.tims,,j.file]
	blt t,j.file+4
	call infcr
	ret

f.tims:	sixbit /DSK/
	sixbit /TS/
	sixbit /TIMES/
	sixbit /SYS1/

jtimoo:	move t,[f.timo,,j.file]
	blt t,j.file+4
	call infcr
	ret

f.timo:	sixbit /DSK/
	sixbit /TS/
	sixbit /TIMOON/
	sixbit /SYS1/


SUBTTL	:SSTATUS

;;; Command to print out system info

ksstat:	syscal sstatu,[val shutdn  ;collect info from ITS for header
		val sysdbg
		val susrs
		val parnxm
		val time
		val machin
		val itsver]
	  loss
	aos susrs		   ;count ourself
	6type tyoc,machin	   ;MC
	tyo tyoc,[40]		   ;space
	type tyoc,/ITS./	   ;ITS.
	6type tyoc,itsver	   ;1097
ife $$pand,type tyoc,/. PWORD./
ifn $$pand,type tyoc,/. PANDA./
	6type tyoc,[.fnam2]	   ;<our version #>
	type tyoc,/.
TTY /				   ;more stuff
	8type tyoc,consol	   ;type our TTY #
	type tyoc,/
/
	10type tyoc,susrs	   ;type out # of users.
	type tyoc,/. Lusers, Fair Share = /
	eval tt,sloadu		   ;get the system load
	movei t,10000.		   ;magic # to divide into to get %
	idiv t,tt		   ;perform it
	10type tyoc,t		   ;and type it
	type tyoc,/%
/
	skipl shutdn
	  call sysded		   ;  handle system going down, as if got
				   ;interrupt 
	skipe sysdbg		   ;debuging?
	  call sysbug		   ;  handle ITS Being debugged message
	ret

sysdwn:	.dtty
	  jfcl
	.iopush dski,		   ;prevent any conflict of channels
	uuopsh
	call sysded		   ;call the routine
	uuopop
	skipe infp		   ;  are we in an inferior job?
	  jrst [.atty usrc,	   ;give the TTY back
	          jfcl
		jrst .+1]
	.iopop dski,		   ;  restore the channel
	jrst dismis		   ;dismiss the interrupt

syshak:	.dtty
	  jfcl
	uuopsh
	call sysbug		   ;call the routine
	uuopop
	jrst gobak		   ;return, maybe give back TTY to inferior



				   ;interrupt routine, so save the AC's
sysded:	save [X,T,TT,A,B,ch,siotct,ttyflg,iobuf,dskbp,ttyprp,prmode,pbufl,pbtsiz,remain,foobp]
	syscal sstatu,[val shutdn] ;gotta make sure it's current
	  loss

	terpri			   ;make it look nice
	6type tyoc,machin	   ;type the machine name

	skipg shutdn		   ;is it going down or up?
	  pjrst [type tyoc,/ ITS Revived.
/
		 jrst popded]	   ;restore our AC's
	type tyoc,/ ITS Going down in /

;; <
;; The following has the following flow structure, for leading zero suppression
;; hours ?   -->  print hours
;;     |              |
;;     | (0 hours)    |
;;     |	      |
;; minutes?  -->  print minutes
;;     |	      |
;;     | (0 mins)     |
;;     |	      |
;;     +--------->print seconds
;;		      |
;;		      |
;;		      V
;;

	move a,shutdn		   ;get the current time-to-go
	idivi a,3600.*30.	   ;grab # of hours
	skipe a			   ;is it that long?
	  jrst hprt		   ;  yes, print the hours
	exch a,b		   ;let's hack the remainder
	idivi a,60.*30.		   ;convert to minutes and seconds*30.
	skipe a			   ;are there any minutes?
	  jrst mprt		   ;  yes, type them out
	jrst sprt		   ;there must be seconds!

hprt:	10type tyoc,a		   ;print it with leading 0's suppressed
	tyo tyoc,[":]		   ;separator
	exch a,b		   ;let's hack the remainder
	idivi a,60.*30.		   ;convert to minutes and seconds*30.
mprt:	call tprt		   ;print it as NN
	tyo tyoc,[":]		   ;and the separator
sprt:	exch a,b		   ;let's hack the rest of it
	idivi a,30.		   ;convert to seconds
	call tprt		   ;print it as NN
	terpri			   ;look pretty

	move x,[dskbuf+buflen]
	movem x,iobuf		   ;use the other buffer!

	syscal open,[cnti .uai	   ;access the info as to why we're going down!
	       argi dski
	       [sixbit /DSK/]
	       [sixbit /DOWN/]
	       [sixbit /MAIL/]
	       [sixbit /SYS/]]
	  caia			   ;  Not there?  Don't bother printing it then
	    call printf		   ;    it's there, print it!
	terpri
				   ;restore the AC's etc.
popded:	restore [foobp,remain,pbtsiz,pbufl,prmode,ttyprp,dskbp,iobuf,ttyflg,siotct,ch,b,a,tt,t,x]
	ret

tprt:	move t,a		   ;get copy to work with
	idivi t,10.		   ;split into tens and units
	addi t,60		   ;convert to ascii decimal
	tyo tyoc,t		   ;type it
	addi tt,60		   ;convert to ascii decimal
	tyo tyoc,tt		   ;type it
	ret

sysbug:	save [X,T,TT]		   ;interrupt routine, save the AC's

	terpri
	6type tyoc,machin
	type tyoc,/ ITS being debugged.
/
	restore [TT,T,X]
	ret


SUBTTL	Logout

ife $$PAND,[
kquit:	type dspc,/AThe proper command for logging off of this system is
:LOGOUT
/
	phaser

klogou:	move x,crgbts		   ;did he ask for the -BYE option?
	trnn x,cf$lby
	  phaser		   ;  nope, bye-bye
	move x,[fbye,,j.file]
	blt x,j.file+4		   ;tell it what file to load from
	call infcr		   ;run it
	phaser

fbye:	sixbit /DSK/
	sixbit /TS/		   ;file names for the BYE program
	sixbit /BYE/
	sixbit /SYS1/

]; END IF# $$PAND

ifn $$PAND,[
klogou:
kquit:	.logout 1,]; END IFN $$PAND,


SUBTTL	Some more commands

ulistj:	type dspc,/A* CONIVR P 63
  EMACS P 24
  MAIL P 25
  LISP R 5
  FOO - 17
  MACSYM R 34
  PLANER R 45
  DIRECT P 57
  UNIVERSE-SIMULATION W 107
/
	ret

ulogou:	phaser			   ;that's all, folks!


khelp:	skipn arg6		   ;find out about our argument
	  call r6arg
	move tt,arg6
	jumpe tt,bhelp		   ; If no arg print what we have help on
	camn tt,[sixbit /ALL/]	   ; Does he want help on everything?
	  jrst allhlp		   ;   Yes, a moby luser, give it to him!
	call ttkget		   ; Look up the command.
	 jrst khelp1
	movei a,(t)		   ; Save it from the hungry typers
	move tt,cm$flg(t)	   ; Get the info on this.
	tlnn tt,%cohlp		   ; Is this forbotten?
	 jrst [ type dspc,/C/	   ;  OK. Clear the screen first.
		jrst docit ]
khelp1:	type dspc,/AI know nothing of the /	   ; Else complain.
	6type tyoc,arg6		   ; Tell him what he typed
	type tyoc,/ command!
/
	ret			   ; Return unsuccesfully.


docit:	type tyoc,/Help info on /  ;print header
	6type tyoc,arg6		   ;including the command requested
	type tyoc,/:

 /
	move tt,crgbts		   ;get the switches he gave
	push sp,arg6		   ;get the help string for this
	trne tt,cf$hbf		   ;did he ask for -bf or -brief
	  do [call psdoc	   ;  yes, print short documentation
	     ][call pldoc]	   ;  no, print the long documentation
	pop sp,nul		   ;restore the stack
	terpri
	jrst popj1		   ;and return, successful

allhlp:	save [a,b,t,tt]
	move a,[-cmdcnt,,cmdtab]   ; AOBJN ptr to everything there's help on!
allhl1:	move tt,cm$nam(a)	   ;Get the name of the command
IFE $$PAND,[	  	;No bad commands in PANDA!
	call bdcmd		   ;If this is a baddie command?
	 jrst allhl4		   ;  dont bother to mention it.
]
allhl3:	movem tt,arg6		   ; that's our argument
	call docit		   ; document it
	  jfcl
allhl4:	addi a,cm$len-1
	aobjn a,allhl1		   ; do it for the next one
	restore [tt,t,b,a]
	ret			   ; and then ret


jmail:	move t,[fmail,,j.file]
	blt t,j.file+4
	call infcr
	ret

IFN $$PAND,[
fmail:	sixbit /DSK/
	sixbit /TS/
	sixbit /QMAIL/		   ; Use regular QMAIL program.
	sixbit /SYS/
]

IFE $$PAND,[
fmail:	sixbit /DSK/
	sixbit /TS/
	sixbit /PWMAIL/		   ; Use hacked up QMAIL program.
	sixbit /SYS/
]

uprrma:	skipa a,[sixbit /RMAIL/]   ; Access RMAIL file
uprmail:
kprmail:
	move a,[sixbit /MAIL/]   ;   access MAIL file
	move tt,[sixbit /PRMAIL/]
	movem tt,comand
	call bdcmd
	 jrst rtbadc
	call r6arg		   ; Parse the argument
kprma5:	skipn b,arg6		   ; whose mail to read
	  move b,sndflt
	movem b,sndflt		   ; remember this as our default
	jumpe b,[ type dspc,/ARead whose mail?
/
		  ret]
	setz c,			   ; find it wherever it goes
	call gtmail		   ; find it
	  jrst [ type dspc,/ANo mail
/
		 ret]
	pjrst printf		   ;print it


.upure
netabp:	0			   ; Byte Pointer to NETADR entry in INQUIR
.pure
;;; Stolen from DDT

;; OPMAIL clobbers A, takes the XUNAME to look for in B, and either 0 in C
;; or an ITS to over-ride the one specified in INQUIR.  It will return
;; the HSNAME in A, the XUNAME in B, and the ITS name in C

opmail:	push p,d	;Don't clobber D
	push p,c	;remember the ITS name we were given
	push p,b	;save XUNAME for later
	call maplsr	;map in the database
	movei a,lsrc
	movei d,dski
	call lsrtns"lsrunm  ;find this person in INQUIR
	  jrst [setz b,	;  Remember that there was no INQUIR entry
	        jrst inqmal]  ;and get his HSNAME from INQUIR
	jumpn c,inqmal	;If we were given an explicit ITS, look only there
	movei a,lsrtns"i$neta  ;check out the network address field
	call lsrtns"lsritm  ;dig it out!
	  jrst inqmal
	movem a,netabp	;remember where this info is
	move d,a	;D gets the BP to the NET Adress
	call lread6	;read a token
	  jrst inqmal
	caie c,"%	;Did he terminate in an % or @?
	  cain c,"@
	    jrst [call getits  ;yes, use this for the XUNAME
		    jrst inqmal	 ;somehow this is garbage!
		  jrst inqml0]  ;OK, NOW we got the site
	call mchokp	;Is this a valid ITS?
	  jrst [ call notits  ;  Tell him about forwarded mail
		 jrst inqmal]  ; and don't fuck with the machine name
inqml0:	movem a,-1(p)	;salt machine name away

inqmal:	move a,(p)	;remember our XUNAME
	movei d,dski	;channel to open the directory on
	move c,-1(p)	;remember our ITS
	skipn c		;is it unspecified?
	  move c,machin	;  Use current
	movem c,-1(p)	;and salt this improved version away
	call lsrtns"lsrhsn  ;get the HSNAME
	  jrst [  type tyoc,/(Net or INQUIR error)
/		        ;  Eh???  Tell the user.
		  move a,(p)  ;use our XUNAME as the HSNAME
		  jrst inqml5]
	  aos -3(p)	;  Skip return
	move a,d	;collect the HSNAME
inqml5:	call unmapl	;don't need these any more, release
	pop p,b		;and the XUNAME
	pop p,c		;recover the ITS name
	pop p,d		;remember D (unchanged)
	ret


lread6:	setzb a,t
	push p,b
	move b,[440600,,a]
6readl:	ildb c,d
	aos t
	cain c,40
	 jrst 6readl		; spaces are ignored.
	cain c,"%		; % is a terminator
	  jrst mpopj1
	caie c,"@		; @, comma are terminators
	 cain c,",
	  jrst mpopj1
	cain c,^Q		; let ^Q quote a character.
	 ildb c,d
	caige c,40
	 jrst mpopj1		; control chars terminate even if ^Q'd
	cail c,140
	 subi c,40
	subi c,40
	tlne b,770000
	 idpb c,b
	jrst 6readl

mpopj1:	pop p,b
	skipe a			;unless this is a null entry
	aos (p)
	popj p,


;; person said FOO@BAR

getits: push p,a		   ;remember the FOO part
	pushj p,lread6		   ;get more of it
	  setz a,		   ;  not there!  Fail return
	jumpe a,[pop p,a ? ret]	   ;if null, same as not there
	call mchokp		   ;is this a known machine?
	  jrst gtitsx		   ;If not an ITS, same as not there!
	move c,a		   ;That was the ITS name
	movei a,lsrc
	pop p,b			   ;recover our XUNAME
	movem b,-1(p)		   ;and set the XUNAME saved on the stack
	call lsrtns"lsrunm	   ;Find the new frobule
	  setz b,		   ;  No INQUIR entry for that XUNAME
	move a,c
	jrst popj1

gtitsx:	pop p,a
	move a,-2(p)		   ;use whatever ITS was specified!
	jrst notits		   ;Tell him the mail goes off of ITS
	ret

mchcnt==:4		;4 ITS's
mchtab: irp machine,,[AI,ML,MC,DM]
sixbit /machine/
termin

;;; Expects BP to net address in NETABP, prints same with message
notits:	type dspc,/A(This person's mail is forwarded to /
notit1:	ildb d,netabp	;get a char
	jumpe d,[ type tyoc,/)
/			;  if that's the end, that's all, so finish the line
		  popj p,]
	tyo tyoc,d	;type the char
	jrst notit1	;and get the next

;;; canonicalize and check the machine name.  (Handles MIT-MC and MC)
;;; Takes machine in A, returns canonicalized machine in A.
;;; Stolen from DDT

mchokp:	camn b,[sixbit /DSK/]  ;= machine we're on
	  jrst [move a,machin ? jrst popj1]
	push p,b
	ldb b,[143000,,a]	;get the MIT- of MIT-xx
	camn b,[sixbit /  MIT-/]  ;Was it in that form?
	  jrst [ ldb a,[001400,,a]  ;Get the xx part
		 lsh a,30	;put it in it's place
		 jrst .+1]
	call mchok0		;is this a real machine?
	  caia
bret:	    aos -1(p)
	pop p,b
	popj p,			;no more nexts, bad!

mchok0:	movsi b,-mchcnt		;for all the machines
mchok1:	camn a,mchtab(b)	;is it this one?
	  jrst popj1		;  yes, it's OK
	aobjn b,mchok1		;no, try next
	ret

;;; GTMAIL takes in A the FN2, B a XUNAME, an ITS name in C, or 0 meaning
;;; wherever his mail would normally be found, and opens on DSKI the mail file
;;; for that user. If it fails, it will not skip, and return a .CALL type error
;;; code in D.  It will also return the HSNAME in A, the XUNAME in B, and the
;;; ITS name in C.  Stolen from DDT

gtmail:	movem a,fd.fn2	;save the fn2 of the file we're after
	call opmail	;Find the mail to look at
	  ret
	movem b,fd.fn1
	camn c,machin	;Is it from this ITS?
	  movsi c,'DSK	;  yes, use DSK instead
	movem c,fd.dev
	movem a,fd.snm
	camn b,xuname	;is this the same XUNAME and
	  came c,machin	;  is this from this machine?
	    caia	;    no, gotta tell the user
	      jrst gtmal9  ;   yes, don't bother telling user.
gtmal5:	type dspc,/A(Checking mail from /
	movei b,dirnam
	move d,[440700,,dskbuf]
	call rfn"pfn		   ; generate the filename string
	output tyoc,dskbuf	   ; and print it out
	move a,fd.snm	;recover A from it's hiding place in B
	move b,fd.fn1	;recover B from it's hiding place in file block
	move c,fd.dev	;recover C from it's hiding place in file block
	tyo tyoc,[")]	;balance!
	terpri		;new line!
gtmal9:	movei b,dirnam
	.call uaiopn	;open the file
	  caia		;  no skip
	    jrst [ aos (p)	   ;   found it, skip return
		   jrst gtmalx]	   ;   (cause that's all!)
	move d,calerr		   ; check out what kind of error it was
	jumpe d,gtmalx	;no error, we win!
	caie d,%ensfl	;Was it that the file wasn't there?
	  filoss dirnam	;  no, complain of another kind of error
gtmalx:	push p,b	;save B across umapping and flush old A
	pop p,b		;restore B to it's rightful placs
	ret

.upure
sndflt:	0			   ; default SENDS file to use
.pure
kprse1:	skipn a,arg6		   ; get whose SENDs to hack
	  move a,sndflt
	caia
kprsen:	  move a,arg6		   ; remember this as the default SENDS file
	movem a,sndflt
	syscal open,[cnti .uai	   ;open the sends file
	       argi dski
	       [sixbit /DSK/]
	       a
	       [sixbit /SENDS/]
	       cladir]
	  jrst [type dspc,/ANo sends
/
	        ret]
	pjrst printf		   ;print it


;; SEND command.
;; Note: if the SEND command is disallowed, failing sends will
;; turn into mail regardless of whether the MAIL command is allowed.

ksend:	move bp,snaptr		   ; Pointer to who to send to
	move ct,snacnt		   ; Ensure it points to something plausible
	skipn ct		   ; Complain if there's no one to send to
	 jrst [	type dspc,/AYou must specify who to SEND to.
/
		ret ]
	caile ct,6.		   ; Complain if rcpt could not be a UNAME
	 jrst ksen11		   ;   Probably trying to send across network
	setz a,			   ; Accumulate UNAME in A
	move b,[440600,,a]	   ; Bp to UNAME
ksen10:	ildb ch,bp		   ; Get a char from string
	cain ch,",
	 jrst [	type dspc,/ASEND only lets you send to one person at a time.
/
		ret ]
	caie ch,"%		   ; FOO@BAR doesn't work
	 cain ch,"@
ksen11:	  jrst [ type dspc,/ASEND does not work across the network.
/
		 ret ]
	caige ch,40		   ; Control chars terminate reading
	  soja ct,ksen20
	cail ch,140		   ; SIXBITify the character
	 subi ch,40
	subi ch,40
	tlne b,770000
	 idpb ch,b		   ; Deposit it into the UNAME
	sojg ct,ksen10		   ; Loop until end
ksen20:	movem bp,snaptr		   ; Got it, update the BP
	movem ct,snacnt		   ;         and the count
	jumpl ct,cpopj		   ; Huh?
	syscal OPEN,[ cnti .uao ? argi dsko ? [sixbit /CLI/] ? a
		       [sixbit /HACTRN/]]
	  jrst gomail
	call sndtim		   ; Get the time word in A
	.iot dsko,[177]
	typout dsko,sndtyp
	.close dsko,
	ret


gomail:	move d,[440700,,tmpbuf]
	idpb6 a,d		   ; generate asciz for the TO: field
	setz e,			   ; and make sure it's ASCIZ
	idpb e,d
	.mail sndmal		   ; Send it as mail
	type dspc,/A(Mailed)
/
	ret


;; table of special devices NOT to set our default to

devtab:	irp dev,,[TTY,T,MLTTY,MCTTY,DMTTY,AITTY,D,MCD,MLD,AID,DMD,XGP,TPL,GLP,DVR,COR,DIR,DIRML,DIRAI,DIRCOM,DIRSYS,DIRDSK,CLO,CLI,CLA,CLU]
	sixbit /dev/
	termin
devlen==.-devtab		   ;# of devices

ulistf:	move tt,[sixbit /LISTF/]
	movem tt,comand
	call bdcmd
	 jrst rtbadc
	skipn t,arg6		   ;null command says, same as before
	  jrst kc.fop		   ;  so hack without any setup
	setzm fd.dev		   ;clear out any old ones
	setzm fd.snm		   ;Clear out SNAME left over from :LISTF FOO;
	movem t,fd.fn1		   ;put in FN1 slot for KLISTF
	jrst kc.fop		   ;and continue with hack

;;; A non-zero name in FD.FN1 is from FOO^F or :LISTF FOO, and is tried as
;;; both a directory with the DSK device and as a device

klistf:	setzm fd.fn1		   ;eliminate pre-conceived notions
	setzm fd.snm		   ;:LISTF FOO;
	move x,fi.dev
	movem x,fd.dev		   ;and :LISTF FOO:

	move d,argptr		   ;pointer to the file-name
	movei b,dirnam		   ;pointer to file name!
	call rfn"rfn		   ;read the names
kc.fop:	call dirdev		   ;get the dir and dev

	movem t,fx.snm		   ;save our new-found names in a fileblock
	movem tt,fx.dev		   ;where we can can open and print
	movei b,fdxnam		   ;B get's location of that fileblock
	call prtopn		   ;open that file
	  jrst [skipn tt,fd.fn1	   ;  nothing to fill in with?            
		  filoss (b)	   ;      yes -- give error
		move x,calerr	   ;what was the error?
		caie x,%ensdr	   ;  non-existant directory?
		  filoss (b)	   ;    nope, give the error
		skipn t,fd.snm	   ;  was there a directory given?
		  move t,fi.snm	   ;    no, get the default
		save [fx.dev,fx.snm,calerr]  ;save circumstances of error
		movem t,fx.snm	   ;  save our new-found names
		movem tt,fx.dev
		call prtopn	   ;  open our file in the right mode
		  jrst [restore [calerr,fx.snm,fx.dev]
		        filoss (b)]  ;  still nothing, give error
		restore [calerr,fx.snm,fx.dev]
		jrst .+1]
	tyo dspc,[^P]		   ;clear the screen
	tyo dspc,["C]

	movem t,fi.snm		   ;we found it, make it the default
	hrlzi t,-devlen		   ;AOBJN ptr for DEVTAB
kc.fdv:	camn tt,devtab(t)	   ;is it a dir only device?
	  pjrst printf		   ;  yes, just print out and return
	aobjn t,kc.fdv		   ;try the next one
	movem tt,fi.dev		   ;it's not one of them, so make it the
				   ;default
	pjrst printf


;; get the dir in T and dev in TT
dirdev:	skipn t,fd.snm		   ;was a sname given?
	  skipe t,fd.fn1	   ;  or was a FN1 given?
	    caia 		   ;    yes, use it
	      move t,fi.snm	   ;	  no, use the default

	skipn tt,fd.dev		   ;was a device given?
	  move tt,[sixbit /DSK/]   ;  no, use the DSK instead
	ret			   ;return

;; Prompt for file name with defaulting.
;;; X should be the address of default file block, or zero.

flprmp:	save [b,d]
	output dspc,@filprm	   ;output a prompt for the frob
	type dspc,/ADefault = /  ;prompt for the file
	move d,[440700,,DSKBUF]	   ;use DSKBUF, since we don't need it yet
	movei b,filnam		   ; The default default.
	skipe x			   ; If we were given a new default
	 move b,x		   ;   use it instead.
	call rfn"pfn		   ;convert it back again
	output tyoc,dskbuf	   ;and type it out
	type dspc,/AFILE = /
	restore [d,b]
	ret
.upure
filprm: 0			   ;prompt for file operation
.pure

uprint:				   ;Here from ^R
kprint:	move tt,[sixbit /PRINT/]
	movem tt,comand
	call bdcmd
	 jrst rtbadc
	move d,argptr		   ;pointer to the file-name
	movei b,filnam		   ;pointer to file name!
	call rfn"rfn		   ;read the names

	move x,fi.dev		   ;for sake of TTY^F ^R<CR>^F
	movem x,fd.dev		   ;reset it to it's default
	setzm x,fd.fn1		   ;this should work for ML^F ^R<CR> ^F

	movei b,filnam		   ;point to the file we are using
	call prtopn		   ;open it
	  filoss (b)		   ;  we lost, tell him
	tyo dspc,[^P]		   ;clear the screen first
	tyo dspc,["C]
	pjrst printf		   ;print it out

;;; USERS command

jusers:	terpri			   ;make sure you start on a new line
	move t,[f.usrs,,j.file]	   ;run the damn thing already!
	blt t,j.file+4
	pjrst infcr

f.usrs:	sixbit /DSK/		   ;here's home for the USERS command
	sixbit /TS/
	sixbit /USERS/
	sixbit /SYS2/

;;;; Here goes the documentation printer etc.

; The documentation printers take a sixbit command to document, and
; look it up and print either the short or the entire documentation.

; print short documentation
psdoc:	move tt,-1(sp)		   ; Get the command to document
	call ttkget		   ; Get the command index
	  error /Attempt to document non-existant command/
psdoc1: hrrz tt,cm$sdc(t)	   ; Get address of short doc
	hlrz t,cm$sdc(t)	   ; Get length of short doc
psdoc2:	hrli tt,440700		   ;make t into a byte pointer
	syscal siot,[argi tyoc ? tt ? t]  ;type it out
	  loss
	ret

; print long documentation 
pldoc:	move tt,-1(sp)		   ; Get the command to document
	call ttkget		   ; Get command index
	  error /Attempt to document non-existant command/
	push sp,t		   ; Remember the index
	call psdoc1		   ; Print out the short documentation first
	pop sp,t
	hrrz tt,cm$ldc(t)	   ; Get address of long documentation
	hlrz t,cm$ldc(t)	   ; Get length of long documentation
	pjrst psdoc2		   ; Print it out

;;; type out a list of all the commands, 5 to a line

bhelp:	type dspc,/CThese are the topics for which HELP can give more info.
Type:
:HELP <topic>
for more info on a given topic.

/
	save [b,tt]		   ;Save B for use as count of commands off
	move a,[-cmdcnt,,cmdtab]   ;aobjn pointer to name table
	move t,cmhcnt		   ;cmhcnt per line
	movem t,hcnt		   ;so set hcnt
bhelp0:	move tt,cm$nam(a)	   ;Get the name of the command
IFE $$PAND,[
	call bdcmd		   ;Is this an OK command?
	 jrst bhelp3		   ;  Nope. 
]
bhelp2:	move t,cm$flg(a)	   ;get the flags
	tlne t,%cohlp\%conls	   ;maybe no need to print?
	  jrst bhelp3		   ;just do your thing.
	tyo tyoc,[^I]		   ;tab to next location
	6type tyoc,cm$nam(a)	   ;type the name
	sosg hcnt		   ;hcnt is count of times we've typed entries
	  do [	terpri		   ;if we've typed enough on this line
		move t,cmhcnt	   ;just go to another.
		movem t,hcnt]
bhelp3:	addi a,cm$len-1
	aobjn a,bhelp0		   ;loop for all of them
	terpri
	restore [tt,b]
	ret



SUBTTL	Interrupt handlers and Inferior hackery

;;;; Here goes the inferior handler routines
;;;; Here go the interrupt handlers

intspc==:100000			   ;push extra debugging info
tsint:	intspc,,sp
	%pimpv\%piwro\%pioob\%piilo\%pidis ? 0 ? -1 ? -1 ? badint
	%pipdl ? 0 ? -1 ? -1 ? pdlovr
	%piioc ? 0 ? -1 ? -1 ? iocerr
	0 ? <1_tyoc>\<1_dspc> ? 0 ? 0 ? morint
	%piltp ? 0 ? -1 ? -1 ? clock
	0 ? 1_tlnc ? -1 ? -1 ? telbye
	0 ? 1_tyic ? %picli ? -1 ? ttyint
	0 ? -1,,0 ? %picli ? -1 ? infint
	%picli ? 0 ? %picli ? -1,,0 ? cliget
	%pidbg ? 0 ? #%pimpv#%pipdl#%piioc#%piltp ? -1,,0 ? syshak
	%pidwn ? 0 ? #%pimpv#%pipdl#%piioc#%piltp ? -1,,0 ? sysdwn  ;Gronk
	%pirlt ? 0 ? #%pimpv#%pipdl#%piioc#%piltp#%pirlt ? -1 ? timout
				   ;%PIRLT's don't defer themselves, so
				   ;hung terminals might log out.
intlng==.-tsint

gobak:	skipe infp		   ;If we're in an inferior
	  .atty usrc,		   ;  give back the TTY
	    jfcl
dismis:	syscal dismis,[cnti intspc ? sp]   ;Go back to what you were doing.
	  loss


nlitim==5.	;Not Logged In lusers time out after five minutes.
.upure
apltim:	0			   ; -1 => luser applying, don't time out
timflg:	-1			   ;set >= 0 if we've already warned about time
.pure

timout:	uuopsh
	push p,t
	syscal cnsget,[argi tyic ? val nul ? val nul ? val nul ? val TTYCOM]
	  loss
	skipe apltim		   ; If luser is applying for an account
	 jrst timou1		   ;  don't hassle him.
	hrrz t,ttycom		   ; Get com mode info.
	camn t,[0,,-1]		   ; TTY linked to someone?
	 jrst timou2		   ;   No, see if completely timed out.
timou1:	move t,[move [nlitim*60.*60.]]	   ; Yes, restart the countdown.
	.realt t,
	  jfcl
	pop p,t
	uuopop
	jrst dismis

timou2:	aose timflg		   ; Is this the first time?
	  .logout 1,		   ;   no, time to flush.
	move t,[move [2*60.*60.]]  ; Else give 2 more minutes
	.realt t,		   ; till final bye-bye.
	 jfcl
	.dtty			   ; Make sure we have the TTY.
	  jfcl
	type dspc,/A
Timeout:  You have two minutes remaining in which to log in or be logged out.
This policy is necessary to avoid tying up job slots and network ports.
If you are having difficulties and need assistance, please type:

:LUSER
and someone will assist you.
/
	pop p,t
	uuopop
	jrst gobak		   ; Relinquish TTY and dismiss.


cliget:	.dtty
	  jfcl
	.iopush dski,		   ;don't clobber anything we may be doing!
	syscal open,[cnti .uii	   ;image mode, to get the UNAME/JNAME
		 argi dski
		 [sixbit /CLA/]]
	    jrst [.iopop dski,	   ;  Restore the channel
		  jrst gobak]	   ;  And return, maybe give back TTY

;;; save the world
	save [x,t,tt,a,ch,siotct,ttyflg,iobuf,dskbp,ttyprp,prmode,pbufl,pbtsiz,remain,foobp]
	uuopsh
	syscal cnsget,[argi tyic ? val nul ? val nul ? val nul ? val TTYCOM]
	  loss
	move t,ttycom
	tlo t,%tcoco		   ;turn on OCO!
	syscal cnsset,[argi tyic ? [-1] ? [-1] ? [-1] ? t]
	  loss

	.iot dski,nuprt		   ;get the UNAME
	.iot dski,njprt		   ;and the JNAME
	.iot dski,savewd	   ;get first char, plus a few
	move a,[440700,,savewd]	   ;BP to first char
	ildb ch,a		   ;get the first one
	cain ch,177		   ;is it a rubout?
	  jrst nujprt		   ;  yes, don't print message from ... etc
	movem ch,chsave		   ;save for later re-typeout
	type dspc,/AMessage from /
	6type tyoc,nuprt	   ;type the UNAME
	tyo tyoc,[40]		   ;space
	6type tyoc,njprt	   ;JNAME
	terpri
	tyo tyoc,chsave		   ;time to type it

;; this has the bug that short messages (< 5 chars) still get 5 chars (4 if
;; first is a rubout) typed.  Tough shit.
nujprt:	movei t,4		   ;4 characters
	movem t,siotct		   ;make ^S win!
	syscal siot,[argi tyoc ? a ? siotct]  ;to type
	  loss

	move x,[dskbuf+buflen]
	movem x,iobuf		   ;use the other buffer!
	call printf		   ;print the rest
				   ;restore OCO to it's former state !!
	syscal cnsset,[argi tyic ? [-1] ? [-1] ? [-1] ? ttycom]
	  loss
				   ;restore world
	uuopop
	restore [foobp,remain,pbtsiz,pbufl,prmode,ttyprp,dskbp,iobuf,ttyflg,siotct,ch,a,tt,t,x]

	.iopop dski,		   ;restore the channel
	terpri			   ;make sure don't leave it hanging
	jrst gobak


;;; TTY interrupt handlers

ttyint:	uuopsh
	save [ch]
ttypsh==.-ttyint
	syscal whyint,[argi tyic ? val nul ? val ch]
	  jrst ttidsm		   ;  dismissed!
	cain ch,^Z		   ;quit?
	  jrst c.quit		   ;  quit!

	cain ch,^G		   ;quit?
	  jrst g.quit		   ;  quit with funny message!

	caie ch,^S		   ;is it ^S?
	  jrst ttidsm
	syscal ttyfls,[cnti 0 ? argi tyic]  ;flush the ^S, but not typeahead
	  loss
	.reset tyoc,		   ; flush typeout
	setzm siotct		   ; no more!
	setzm ttyflg		   ; turn on the TTY while handling it
	hrrz ch,-ttypsh(p)	   ; get where we interrupted from
	skipe morflg		   ; are we inside a more?
	  caie ch,tyiiot	   ;   waiting in a TYI?
	    caia		   ;     nope
	      jrst [ restore [ch]  ;	   yes
		     movei ch,177  ;	   we're gonna pretend we saw a rubout
		     aos -ttypsh+1(p)  ;   pretend the .IOT returned
		     jrst ttids1]  ;	   dismis to next instruction
	$echo ^S		   ; echo it now.  Don't echo in a --MORE--,
				   ; since that would just get flushed anyway
	cain ch,tyiiot		   ; were we reading?
	  jrst ttidsm
	setom ttyflg		   ; prevent more cruft from starting
ttidsm:	restore [ch]
ttids1:	uuopop
	jrst dismis		   ; and return to what you were doing!

g.quit:	call ttyclr		   ; clear output/input on TTY
	type tyoc,/ (Quit)
/
	quit			   ; reset the world

c.quit:	call ttyclr		   ; clear the TTY I/O
	 quit

ttyclr:	.reset tyoc,		   ;clear the output
	syscal ttyfls,[cnti 1 ? argi tyic]  ;flush typein up to interrupt char
	  loss
	setzm siotct		   ;clear the SIOT count!
	ret

;;; --MORE-- interrupt
morint:	skipe ttyflg		   ; if we aren't typing anyway
	  jrst dismis		   ;   just ignore it
	save [ch,x]
	uuopsh
	push sp,siotct		   ;save SIOTCT seperately
	syscal finish,[argi tyoc]  ;wait for it to come out
	  jfcl			   ;  ignore failure
	type tyoc,/--MORE-- (Space yes, rubout no, ? for help)/
	setom morflg		   ;note we are at a more
morin1:	tyi
	  jrst flushd
	  jrst [
type dspc,/TLWhen you see --MORE-- at the bottom of your screen,
it means that there is more output to come, but the system
is waiting for you to finish reading it.  When you are
ready for more output, just type a space, and it will type
out the next screenful.

On the other hand, if you do not wish to see the output, you
may type a rubout instead.  This will throw away the remaining
output.

-----------
ZH3/
	  jrst morin1]
	  jrst flushd		   ; rubbed out, flush.
	setzm morflg		   ;turn of --MORE-- flag
	cain ch,40		   ;is it a space?
	  jrst [type dspc,/
/				   ;  yes, go to top
	        jrst mordsm]	   ;  to continue typeing

	caie ch,^M		   ;loser type a CR anyway?
	  movem ch,reread	   ;  garbage char, re-read it later


flushd:	setzm morflg		   ;^G or ^D -- turn off --MORE-- flag
	.reset tyoc,		   ;throw it all away
	type dspc,/ZL--FLUSHED--TL/  ;tell him about it
	setom ttyflg		   ;no more output
	setzm siotct		   ;flush ongoing output
mordsm:	pop sp,nul		   ;throw away old SIOTCT
	uuopop
	restor [x,ch]
	jrst dismis		   ;and end of interrupt

;;; error interrupt handlers
badint:	error /Unknown Interrupt./
pdlovr:	error /PDL Overflow./
pdlund:	error /PDL Underflow./

iocerr:	.suset [.rbchn,,iocchn]	   ;find out what channel lost
	syscal status,[iocchn ? val iocsts]  ;get the status
	  loss
	syscal open,[cnti .uai
		argi dski
		[sixbit /ERR/]
		argi 3		   ;means 2nd file name is status word
		iocsts]
	  loss
	movem x,erracs		   ;save X for analysys
	move x,[1,,erracs+1]	   ;and use it to BLT the rest of the AC's to
	blt x,erracs+17		   ;safty
	call printf		   ;print the error message
	ldb t,[330500,,iocsts]	   ;get the error #
	movei tt,1		   ;set up to shift one bit into position
	lsh tt,(t)		   ;shift it
	tdnn tt,iocfpr		   ;Should the file name be printed?
	  do [	syscal rfname,[argi %jself  ;yep, find out the true filename
		       iocchn
		       val fi.dev
		       val fi.fn1
		       val fi.fn2
		       val fi.snm]
		  loss
		type dspc,/ABad file = /
		move d,[440700,,msgbuf]	;use msgbuf, since we don't need it now
		movei b,filnam	   ;
		call rfn"pfn	   ;  convert it back again
		output tyoc,msgbuf] ;  type that string again!

        syscal delewo,[argi dsko]  ;flush any writing we may be doing
	  jfcl			   ;must not have been there or doable

	ldb t,[330500,,iocsts]	   ;get the error #
	movei tt,1		   ;set up to shift one bit into position
	lsh tt,(t)		   ;shift it
	ldb t,[330500,,iocsts]	   ;get the error #
	movei tt,1		   ;set up to shift one bit into position
	lsh tt,(t)		   ;shift it
	tdne tt,iocbad		   ;Is this safely ignorable?
	  jrst gotop
	errdmp 4,[asciz /Input-Output Error/]  ;AC's have been saved

gotop:	move sp,[-pdllen,,pdl]	   ;clean out the stack
	.uclose usrc,
	.suset [.sdf1,,[0]]	   ; Re-enable interrupts
	.suset [.sdf2,,[0]]
	jrst rdloop		   ;back to reading


;;; IOC errors to print file names for
; 11 - Device Full
; 14 - Directory Full
iocfpr:	irp x,,[11,14]
<1_x>\termin

;;; IOC errors to continue after
;  7 - USR Operation Channel does not have USR device open
; 10 - Channel not open
; 13 - Illegal Character after ^P on display channel

iocbad:	irp x,,[7,10,13]
<1_x>\termin 


infint:	save [x,t,tt]
	uuopsh
	.dtty			;get back the TTY
	 jfcl
	syscal usrvar,[argi usrc	;get his interrupts
		[sixbit /PIRQC/]
		val t]
	 loss
	trne t,%pibrk		   ;break?
	  jrst break		   ;  handle that
	setzm infp		   ;note we aren't in inferior anymore
	trne t,%pival		   ;.VALUE?
	  jrst value		   ;  go barf at him, I didn't say I was DDT
	trnn t,<%pic.z>		   ;^Z ?
	  tlne t,%pjdcl		   ;  or ^_D ?
	    jrst kjob		   ;  kill it off.
	
	type dspc,/AInferior got random interrupt!/
	jrst gotop

define pagmak a
	andi a,-1		;clear left half
	lshc a,-12		;split off page number from rest
	lsh <a+1>,12-44		;and make remainder
termin

accum==:.bp <740,,0>
index==:.bp <17,,0>
indirc==:.bp <20,,0>
opcode==:.bp <777000,,0>

break:	move t,[-6,,[sixbit /PIRQC/ ? trz %pibrk  ;turn off the interrupt
		     sixbit /UPC/ ? movem j.upc  ;get the PC to restart at, and
				   ;for debugging
		     sixbit /SV40/ ? movem jinstr]]  ;get the causing inst.
	syscal usrvar,[argi usrc ? t]  ;get the info
	  loss

	ldb t,[accum jinstr]	   ;pick out the accumulator
	movem  t,jaccum

	hrrz t,jinstr		   ;t <- address field
	movem t,jaddr		   ;address field

	ldb t,[opcode jinstr]	   ;get the opcode
	movem t,jopcod		   ;and save it for debuging's sake.
	cain t,c.op		   ;is it a .oper ?
	  jrst kjob		   ;  just kill it

	move t,jaccum		   ;check the accumulator
	cain t,12		   ;is it a .BREAK 12, ?
	  jrst brk12		   ;  yes

	setzm infp		   ;note we aren't in inferior any more
	caie t,16		   ;is it garbage?
	 jrst unbrk		   ;go handle unknown break

kjob:	setzm infp		   ;note we aren't in inferior anymore
	syscal rfname,[argi usrc
	       val t]		   ;is there an inferior?
	  loss
	skipn t
	  ERROR /Attempt to kill non-existant inferior./
	.uclose usrc,		   ;kill it
	type dspc,/A:KILL
/
	.uclose usrc,		   ;it must have been asking to die since we
				   ;told it we weren't a DDT
	jrst infdon

brk12:	syscal usrmem,[argi usrc ? jaddr ? val t]  ;A <- cont (e.a)
	  jrst kjob		   ;  lose!
	jumpl t,[hlrz t,t	;if writing
		caie t,400005	; if clearing JCL
		  jrst [setzm jclct  ;clear it and
			jrst infdon]  ;be done
		ERROR /Inferior trying to write superior./]
				   ;complain
	hlrz tt,t		   ;get operation
	trne tt,200000		   ;is it block mode?
	  error /Inferior trying to use block mode .BREAK 12,/
	cail tt,brktbl		   ;is it out-of-range?
	 jrst unbrk
	xct brktb(tt)


unbrk:	error /Inferior got a bad .BREAK interrupt./

brktb:	jrst unbrk
	jrst unbrk
	jrst unbrk
	jrst unbrk
	jrst unbrk
	jrst getjcl
brktbl==.-brktb

getjcl:	hrrz t,t		   ;get address again
	pagmak t		   ;make it into a page # and loc in that page
	movem t,jclpag		   ;save page and location in page
	movem tt,jclloc		   ;for JCL
	syscal corblk,[cnti %cbndw ;need write access
		argi 0		   ;no XORing, please
		argi %jself	   ;map into ourself
		argi tmpag1	   ;at the highest possible location
		argi usrc	   ;our inferior's
		jclpag]		   ;page which is contained in A
	  jrst jclovf
	aos jclpag		   ;get next page too
	skipn t,jclct		   ;get length pointer of JCL
	  jrst infcnt		   ;  no JCL, continue
	addi t,4+1		   ; (+1 to count ^M)
	idivi t,5		   ;(ptr+4)/5==length in words
	add t,jclloc		   ;the final loc
	cail t,2000		   ;overflow?
	 do [syscal corblk,[cnti %cbndw  ;need writing
			argi 0	   ;barf, no XOR, please
			argi %jself
			argi tmpag2  ;very moby
			argi usrc  ;our very inferior inferior
			jclpag]	   ;and the next page
		  jrst jclovf]	   ;complain of indigestion


	move t,jclct		   ;get the JCL length
	addi t,4+1		   ;convert to words (+1 to count ^M)
	idivi t,5		   ;from characters
	move tt,jclloc		   ;get the offset for the address
	add t,tt		   ;include it in the final total end address
	hrri tt,<tmpag1_12>(tt)	   ;and put in right half for blt
	hrli tt,jclbuf		   ;get our source for the BLT from the JCLPTR
	blt tt,<tmpag1_12>-1(t)	   ;and perform the transfer
	jrst infcnt

infcnt:	uuopop
	restor [tt,t,x]

	.atty usrc,		;give it to him
	  jrst [.dtty 		;get it back
		.atty usrc,	;and try again
		  loss		;nope, we're screwed somehow
		jrst infcn1]	;good, one with the show

	call start

infcn1:	syscal dismis,[cnti intspc
		sp]
	  loss
	
jclovf:	ERROR /Inferior tried to read JCL
into pure or non-existant memory./

value:	syscal usrvar,[argi usrc	;turn off the interrupt
		[sixbit /APIRQC/]
		[%PIVAL]]
	  loss
	type dspc,/AInferior .VALUE'd /
	
	.uclose usrc,
	jrst infdon


infdon:	uuopop
	restore [tt,t,x]

	syscal dismis,[cnti intspc
		sp]
	  loss

start:	syscal usrvar,[argi usrc	;copy his old state
		[sixbit /OPTION/]
		val t]
	 loss
	tlz a,optcmd+optbrk	   ;clear the OPTCMD bit (+ the OPTBRK since 
				   ;LISP demands it!)
	skipe jclct		   ;if there is JCL
	 tlo t,optcmd+optbrk	   ;set it again
	syscal usrvar,[argi usrc   ;and set it up
		[sixbit /OPTION/]
		t]		   ;write it back again
	  loss

	setom infp		   ;note we are in inferior
	syscal usrvar,[argi usrc	;GO!
		[sixbit /USTP/]
		argi 0]
	  loss

	ret



;;; run an inferior.  Takes a job name in COMAND, and file names in
;;; INFFN1, FINFN2, and INFSNM

infcr:	call jclcop		   ; Set up the JCL
	.status usrc,t		   ; look at the channel
	caie t,0		   ; if there is something open
	  .uclose usrc,		   ;   kill it

	syscal open,[cnti .uii	   ; create a job
		argi usrc
		[sixbit /USR/]
		argi 0		   ; same UNAME as ourselves
		COMAND]		   ; we look in COMAND for the UNAME
	  jrst [type dspc,/ACannot create inferior, maybe system full?
/
		ret]
	syscal open,[cnti .uii	   ; open a file to load into it
		argi dski
		[sixbit /DSK   /]
		inffn1
		inffn2
		infsnm]
	  error /Program missing/

	syscal load,[argi usrc	   ; load it
		argi dski]
	  jrst [move x,errret	   ;   fetch the error code
		cain x,%enacr	   ;   no core?
		  jrst [type dspc,/AThe system is overcrowded to the point that you cannot even log in,
so I am logging you out.
/
			phaser]
ifn $$PAND,[	cain x,%erojb	   ; Have we got a non-inferior?
		  jrst [type dspc,/AJob not inferior!
/
			ret]
]	   ; END IFN $$PAND,
		error /Can't load job/]
	syscal iot,[argi dski	   ;get starting address
		argi t]		   ;in a
	 loss
	andi t,-1		   ;ignore the JRST part

	syscal close,[argi dski]  ;close it
	 loss

	syscal usrvar,[argi usrc  ;make it start there
		[sixbit /UPC/]
		t]		   ;a has address
	 loss

	syscal usrvar,[argi usrc  ;get what bit to enable
		[sixbit /INTB/]
		val t]
	 loss

	syscal usrvar,[argi %jself	;and enable it
		[sixbit /IMSK2/]
		t]
	 loss

TTYGO:	call start
	.atty usrc,		;give up the TTY and wait for return
	  jfcl
	skipe infp		   ;until we aren't in inferior
	  .hang
	.dtty
	  jfcl
	ret




SUBTTL	Initialization

;;;; Here goes the initialization code

ife $$pand,[
;; Following due to EAK

comchk:	move t,ttycom		   ; Get our TTY com var
	.suset [.runame,,uname]	   ; Make sure we know our UNAME for logging
	tlne t,%tcrft\%tcico	   ; Did this loser slave another terminal
	  jrst ttyhak		   ;   Yes, don't give him DDT as a reward.
	movei count,100		   ;if 100 TTY's are linked, we' must be
				   ;looping looking for TTY that isn't there
				   ;any more
comch0:	syscal cnsget,[argi %jsnum(b)  ;get the TTYCOM for given terminal
	       val t ? val t ? val t
	       val b]
	  loss
	hrrzs b			   ; throw away the bits
	camn b,consol		   ;are we back to the start?
	  jrst ttyhak		   ;  yes, so must not be any winners, ask for
				   ;password
	cain b,-1
	  jrst ttyhak
	syscal styget,[argi %jsnum(b)  ;get a job  for that TTY
		      val t ? val t
		      val c]
	  loss
	jumple c,[sojg count,comch0  ;if it's free, try next
	           jrst ttyhak]	   ;  oops, must be looping, no winners
	syscal usrvar,[argi %jsnum(c)
		      [sixbit /UNAME/]
		      val c]	   ; find UNAME of linker
	  loss
	movem c,linker		   ; remember who lunk to
	hlrz c,c		   ; linker logged in?
	caie c,-1		   ; 
	  jrst goddt4		   ;winner, get him a DDT
	sojg count,comch0	   ;  he's not responsible, try another
	jrst ttyhak		   ;infinite loop, try again
] ;; end IFE $$PAND

run:	setom debug		   ;this is the debug starting address
	setom noddt		   ;don't get DDT for any TTY's

go:	.close 1,		   ;if we're loaded by system, CH1 is open
	move sp,[-pdllen,,pdl]	   ;initialize pdl
	call ginit1		   ;do early initialization

ife $$pand,jrst goddt5		   ;  lost somehow, bad....try to get DDT
ifn $$pand,.lose
ife $$pand,[
	move t,ttycom		   ;check out the TTYCOM status
	jumpl t,comchk		   ;it's in com link, don't do the default
				   ;stuff
	skipe noddt		   ; special debugging crock?
	  jrst ttyhak		   ;   yes, be sure to get PWORD

;;; Ok, now we check out to see if it's a very important console.
;;; If it is, we be damned sure to get us DDT rather than risking lossage
;;; The less hair the better, I.e. what if there is a bug in a system call,
;;; Or GOD FORBID, in this program.

	eval tt,syscn
	skipe b,consol		   ;is it machine console?
	  camn b,tt		   ;  or system console?
	    jrst goddt5		   ;    Go load up a DDT
	move x,ttytyp		   ;what type?
	tlne x,%TTLCL		   ;is it a local TTY?
	  jrst goddt5		   ;  Go load up a DDT

;;; Not a VIP terminal, go through regular checks.

	move x,ttytyp
	skipn debug		   ;  debugin?
	  trnn x,%tysty		   ;is it a STY?
	    jrst notsty

	syscal styget,[argi %jsnum(b) ? val tt] ;get info on this STY
	  loss
	syscal open,[cnti .bii\10  ;open as foreign job
	       argi tlnc	   ;telnet channel
	       [sixbit /USR/]
	       argi %jsnum(tt)	   ;open the telser by job number
	       argi 0]		   ;0 JNAME means <JOB> spec
	  loss
		
	syscal rfname,[argi tlnc  ;is there a job open on this channel?
	       val t		   ;  device
	       val x		   ;  UNAME
	       val tt]		   ;  JNAME
	  loss			   ;  eh?
	cain t,0		   ;is the Device 0?
	  jrst goddt5
	tlz x,777700		   ;clear out the TTY # part of nnTLNT
	came x,[sixbit /  TLNT/]   ;is it really a telser?
	  jrst goddt5
	came tt,[sixbit /TELSER/]  ;including JNAME?
	  jrst goddt5		   ;  nope
	.access tlnc,[tsrloc]	   ; Where to get cruft from TELSER
	move tt,[-1,,tsrtab]	   ; Transfer the first word
	.iot tlnc,tt
	move x,tsrtab		   ; Check it for validity
	came x,[sixbit /TERMID/]   ; Valid?
	  jrst ttyhak		   ;   Funny TELSER??
	move tt,[-<tsrcnt-1>,,<tsrtab+1>]
	.iot tlnc,tt		   ; input the rest of the data from the TELSER

	call ginit2		   ; Gotta get the local site!

	move a,lclsit		   ; Is this our local site?
	skipn b,fhost
	  jrst ttyhak		   ;   Huh?  Shouldn't be possible
	call netwrk"hstcmp	   ; If from local host, give PWORD
	  caia			   ;   
	    jrst ttyhak		   ;  so we can debug

	movei a,lucktb		   ; AOBJN ptr to LUCKTB of sites to let on
	call pwsget		   ; Get it into our buffer, T gets AOBJN ptr
luckp:	move a,fhost
	move b,(t)
	call netwrk"hstcmp
	  caia
	    jrst goddt5		   ;   Give him DDT
	aobjn t,luckp		   ; no, try next one
	jrst ttyhak		   ;   continue, check if system console.

notsty:	call ginit2		   ;perform rest of initialization
	skipe noddt		   ;are we debugging?
	  jrst ttyhak		   ;  yes, don't ever give DDT
	move b,consol		   ; Console bit...
	movei tt,1		   ;one bit
	setz t,
	lshc t,(b)		   ;translate into bit for this TTY
	tdnn tt,ddtty0		   ;  can we give him DDT for it?
	  tdne t,ddtty1
	    jrst goddt5		   ;  yes, win, get him DDT
;;; now check for dialups, for sake of TELSIT
	movei tt,1		   ;one bit
	setz t,
	move x,[440700,,[asciz /DIALUP/]]
	lshc t,(b)
	move bp,[440700,,hstnam]
	tdnn tt,dltty0		   ;is this a dialup?
	  tdne t,dltty1
	    copy x,bp		   ;    yes, claim to be a dialup!

];; end ife $$PAND 

ttyhak:	call ginit2		   ;perform rest of initialization
	hlrz tt,runame		   ;get left half
ife $$pand,[
	caie tt,-1		   ;is it logged in?
	  skipe debug		   ;  and debugging?
	    caia		   ;    debuggin, don't go
	      jrst goddt5	   ;      not debuging, just get him DDT.
	move t,[move [nlitim*60.*60.]] ;Start countdown
	.realt t,
	  jfcl
]
ifn $$pand,[
	call pwread		   ;read it
	  .logout 1,
	move x,[sixbit /FOO/]
	movem x,uname		   ;fake uname
	call pwdmak
	came t,spword
	  .logout 1,
	setzm deathp		   ;note no errors
	hlrz tt,runame		   ;check if we're logged in
	cain tt,-1		   ;  not logged in?
	  .logout 1,

	call pwdmap		   ;map in the database
	.close pwdc,		   ;don't need it anymore
] ; END IFN $$PAND

				   ;don't let him screw himself
	syscal cnsset,[argi tyic ? [-1] ? [-1] ? [-1] ? argi 0]
	  loss

	syscal sstatu,[val shutdn  ;collect info from ITS for header
		val sysdbg
		val susrs
		val parnxm
		val time
		val machin
		val itsver]
	  loss

	aos susrs		   ;count ourself

	
ife $$pand,[
	tyo dspc,[^P]		   ;clear the screen
	tyo dspc,["C]
	call ksstat		   ;print out statistics
	syscal open,[cnti .uai
		argi dski
		[sixbit /DSK/]
		[sixbit /SYSTEM/]
		[sixbit /MAIL/]
		[sixbit /SYS/]]
	  jrst nsysm		   ;no system mail
	call printf		   ;print the file

nsysm:	move x,ttytyp		   ;find out what kind of TTY we've got
	trne x,%tysty\%tydil	   ;is it a network sty? or dialup?
	  jrst jrst rdloop	   ;  yes, don't print local mail

nnet:	syscal open,[cnti .uai
		argi dski
		[sixbit /DSK/]
		[sixbit /LOCAL/]
		[sixbit /MAIL/]
		[sixbit /SYS/]]
	  jrst nlocal		   ;  no local mail
	call printf
] ;; end ife $$PAND

ifn $$pand,[
	tyo dspc,[^P]		   ;clear the screen
	tyo dspc,["C]
	type tyoc,/PANDA./
	6type tyoc,[.fnam2]	   ;<our version #>
]  ;; end IFN $$PAND



SUBTTL	Read Loop

nlocal::
rdloop:
ifn $$PAND,[
	setzm nodate		   ; be sure commands don't see this preset
	skipn rdxct		   ; some cleanup action needing to be done?
	  jrst rdlop1
	move a,rdxarg
	move bp,rdxbp
	xct rdxct		   ; run the cleanup handler
	  jfcl
	setzm rdxct
rdlop1:
]; end of IFN $$PAND,

	call readin		   ; main read loop
	  jrst [cain ch,^D	   ;    or a ^D quit?
		  type tyoc,/ ^D XXX?
/
		jrst rdloop]	   ;  we've over rubbed out, or null operation


;; here is where we come if we successfully got a command

	setz count,		   ;no input any more

;; Here is is where we come if we successfully get a command

	terpri
	call kdspch		   ;yes, dispatch off of it.
	jrst rdloop		   ;loop even though we failed
	jrst rdloop		   ;We won, do it again

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Here goes the input parser/rubout processor
;;;; 
;;;; Theory of operation of the command reader.
;;;; This operates in a "Parse as you go" mode.
;;;; The format of the input lines is as follows:
;;;; 
;;;; 1) The line starts out with :'s, spaces, and tabs.  These are ignored.
;;;; 	Only :'s are echoed.
;;;; 
;;;; 2) Next is the command name, which is read as a single word of sixbit.
;;;; 	It is stored in the location COMAND when read
;;;; 
;;;; 3) The command name is terminated with [SPACE], CR, ^K or [ALTMODE]
;;;; 
;;;; 	If terminated with [ALTMODE], COMAND is taken to be a UNAME to log in 
;;;; 	as, and it is fed to the ULOGIN routine to watch for <n>U or U.  If
;;;; 	these are not given, it is an error.
;;;; 
;;;; 	If CR or ^K is given, the command line is complete, and the successful
;;;; 	return is taken.  (If it is over-rubbed out, the failure return is
;;;; 	taken.)
;;;; 
;;;; 	If [SPACE] terminates the command name, the command is looked up.
;;;; 	If it doesn't exist, It goes into a BEEP loop waiting for him to rubout
;;;; 	the faulty command.  If it does exist, the space is echoed, and the
;;;; 	command-name reader checks the commands flag bits to see who should
;;;; 	be called next.
;;;; 	If %COARG is present, it calls the 6bit argument reader, which is then
;;;; 	resposible for checking the %COCRG and %COJCL bits to decide who
;;;; 	to call after that.  More on the 6bit argument reader (R6ARG) in a bit.
;;;; 	If %COARG is absent, and %COCRG is present, it calls the the control-
;;;; 	argument reader, which reads control-arguments.  These are members of
;;;; 	an explicit set of possible arguments stored in the CARGHS table
;;;; 	The control-argument reader (RCARG) will either return successfully
;;;;	with the offsets of the control-argument strings in the control
;;;;	arg buffer (CARGB)
;;;; 	If %COCRG is absent as well, but %COJCL is present, it will call the
;;;; 	JCL reader.  This simply reads in the characters until a ^C, ^_, or ^M
;;;; 	is encountered, and sets up the pointers to this string (in msgbuf)
;;;; 	in the reader data area
;;;;	If none of %COJCL, %COCRG or %COARG is present, it
;;;; 	simply returns successful, since the command is one that ignores it's
;;;; 	arguments.
;;;; 
;;;; 5) R6ARG is responsible for reading a 6bit argument, for commands such
;;;; 	as SEND and HELP.  It does so in a manner very similar to the
;;;; 	command reader which calls it, but stores the result in ARGUMENT
;;;; 	and doesn't hack [ALTMODE].
;;;; 	R6ARG checks the command's flags that it is reading for, when it
;;;; 	is done, if terminated with other than line terminators, and if it has
;;;; 	%COCRG, it calls the command reader.  If not, if it has %COJCL, it
;;;; 	calls the JCL reader, otherwise it returns successfully.
;;;; 
;;;; 6)	RCARG is responsible for reading control-arguments.  This is for
;;;; 	dual purpose of allowing the HELP or ? keys to print which arguments
;;;; 	are available for a given command, and to pre-parse the input line
;;;; 	so that individual commands don't have to do any parsing of their input
;;;; 	It will not accept illegal control-arguments.
;;;; 	It does not call further parsers, but returns successfully in all
;;;; 	cases except over rubout.
;;;; 
;;;; 7)	RJCL is the routine which reads random JCL, such as that passed to
;;;;	other programs or the SEND command.  This does no parsing, but
;;;; 	simply saves the pointer into the input buffer when it is called, and
;;;; 	the count before and after, and returns successfully when an line
;;;; 	termination character is encountered, or unsuccessfully on over-rubout.
;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 
;;;; How the rubout processing works.
;;;; 
;;;; The rubout processing works quite simply:
;;;; Each reader is responsible for being able to rub out within its region.
;;;; If it calls another reader after it is done, it must be a returnable
;;;; call, which can either be successful, in which case, it may return
;;;; successfully as well, or unsuccessful, in which case it should wipe out
;;;; the character which terminated it's reading, and revert to reading (or
;;;; possibly rubing out instead).
;;;; 
;;;; The routine WIPECH is the routine which handles erasing the characters
;;;; from the screen.  It expects the character which would appear on the 
;;;; screen to be rubbed out to be in CH.  If it is a printing terminal, it
;;;; will do EMACS style rubouts, where it backspace-/-backspace's each
;;;; character character, seting LFFLAG.  Each routine which echo's characters
;;;; should do so with the macro ECHO, which will do the LF when needed.
;;;; 

.upure
rstate:	%rsnul			   ; Reader State
ostate:	%rsnul			   ; Previous reader state (no stack needed)
comand:	0			   ; Command being hacked
altifx:	0			   ; Infix in Altmode commands (FOO<0U)
argcnt:	0			   ; Number of characters of argument
argptr:	0			   ; Byte Pointer to argument
snacnt:	0			   ; Number of characters of 'To:' line
snaptr:	0			   ; Pointer to To: line
posloc:				   ; (save as COLLOC) where we entered %RSPOS
colloc:	0			   ; Where on command line we entered %RSCOL
cmdloc:	0			   ; Where on command line we entered %RSCMD
argloc:	0			   ; Where on command line we entered %RSCOL
ps1loc:	0			   ; Where on command line we entered %RSPS1
6cnt:	0			   ; Number of characters 6bit reader read
arg6:	0			   ; Prefix frobs put their arg here
linbeg:	0			   ; Where line begins for rubbing out.


sndrds:	0			   ; We've redisplayed the :SEND line
.pure

%RS==:400000,,-1		   ; Typeout mask for %RS symbols

.foo==0
IRPW X,,[
  %RSNUL			   ; Empty
  %RSCOL			   ; Initial colons and spaces
  %RSCMD			   ; Reading 6bit command name
  %RSPOS			   ; Reading 6bit for postfix command
  %RSPS1			   ; 1 Altmode of postfix command
  %RSPS2			   ; 2 Altmodes of postfix command
  %RSALT			   ; Altmode at beginning of line
  %RSAL2			   ; Second Altmode at beginning of line
  %RSARG			   ; Reading arguments to a command
  %RSFIL			   ; Reading filenames for a file, hack ALT
  %RSSND			   ; Reading text for a :SEND
  %RSSNA			   ; Reading addressee's for a :SEND
  %RSTXT			   ; Reading text ended with ^C
  %RSBAD			   ; Illegal gubbish on the line
  %RS6BT			   ; Reading a word of 6bit
 ]
IRPS y,,[x]
 Y==.foo
TERMIN
 .foo==.foo+1
TERMIN

define TRANSITION state
	  jrst [movei x,%RS!state ? jrst newstate]
termin


;;  STATE TRANSITION TABLE (reading forward)
;;
;;  +--------+ :  +--------+ 6bit +--------+    +--------+
;;  | %RSNUL |--->| %RSCOL |----->| %RSCMD |--->| %RSARG |
;;  +--------+    +--------+      +--------+    +--------+
;;      | |    +....................^  | |
;;      | +----|------+                | +----------+
;;      V  ....+      V                V            V
;;  +--------+    +--------+       +--------+   +--------+
;;  | %RSPOS |    | %RSALT |---+   | %RSFIL |   | %RSSNA |
;;  +--------+    +--------+   |   +--------+   +--------+
;;      |	               +-------+            |
;;  	V                              V            V
;;  +--------+    +--------+       +--------+   +--------+
;;  | %RSPS1 |--->| %RSPS2 |       | %RSAL2 |   | %RSSND |
;;  +--------+    +--------+       +--------+   +--------+
;;
;;  +--------+
;;  | %RS6BT |
;;  +--------+

rdinit:	movem bp,linbeg
	setzb ct,count
	setzm sndrds		   ; Say we haven't redisplayed :SEND buffer
	setzm argcnt
	setzm argloc
	setzm snacnt
	setzm arg6
	ret

read6:	save [a,c]
	call rdinit
	setz count,
	move a,[440600,,arg6]
	movei x,%rs6bt
	movem rstate
	call read0
	  jrst read6x
read6w:	restore [c,a]
	jrst popj1

read6x:	restore [c,a]
	ret

readln:	save [a,c]
	call rdinit		   ; read a line
	movem bp,argloc
	call readl0
	  jrst read6x
	  jrst read6w

readl0:	TRANSITION ARG

readtx:	move bp,[440700,,msgbuf]
readsn:	save [a,c]
	call rdinit		   ; Read multiple lines
	movem bp,argloc
	movem bp,argptr
	call reads0
	  jrst read6x
	  jrst read6w

reads0:	TRANSITION TXT

readfi:	move bp,[440700,,msgbuf]   ; Read a filename
	call rdinit
	movem bp,argloc
	movem bp,argptr
	TRANSITION FIL

readin:	move bp,[440700,,msgbuf]
	setzm helper		   ; Full command read has help built in
	setzm dsprmp		   ; No special prompting
rdrset:	call rdinit
	movei x,%rsnul		   ; Initial EMPTY state
	movem x,rstate
	call prompt		   ; Prompt
read0:	skipge ch,reread	   ; A character to be re-read?
	  .iot tyic,ch		   ; Get a chracter
	setom reread
	move t,rstate		   ; Get the state
	cain ch,^L		   ; Redisplay?
	  jrst readrd		   ;   Do it
	cain ch,177		   ; Rubout?
	  jrst readrb		   ;   Do it
	cain ch,%TXTOP+"H	   ; [HELP]?
	  jrst readhl

	echoch			   ; ECHO it

	cain ch,"?		   ;  ??
	  jrst readhl		   ;   Give help	caie ch,^D

	caie ch,^C
	  cain ch,^M
	    jrst readex

	caie ch,^D
	  cain ch,^G
	    jrst [ type tyoc,/ XXX? /
		   jrst readfl ]
	move x,rstate
	cain x,%RSPOS
	  jrst read1
	cain ch,^H		   ; Backspace instead of rubout?
	  jrst [ type dspc,/A;Use RUBOUT or DELETE to delete characters.
;BACKSPACE is for overstriking.
/
		 jrst redis ]
read1:	idpb ch,bp		   ; Store the byte
	aos ct			   ; Count it
	caile ct,msgbfl		   ; Overflow?
	  jrst [ type dspc,/A(Line too long)/
		 jrst redis ]	   ; Redisplay it for him to rub out

readc:	jrst @.+1(t)
	  RDNUL ? RDCOL ? RDCMD ? RDPOS ? RDPS1 ? RDPS2 ? RDALT ? RDAL2 ? RDARG
	  RDFIL ? RDSND ? RDSNA ? RDTXT ? RDBAD ? RD6BT

readex: move t,rstate
	jrst @.+1(t)
	  RTNUL ? RTCOL ? RTCMD ? RTPOS ? RTPS1 ? RTPS2 ? RTALT ? RTAL2 ? RTARG
	  RTFIL ? RTSND ? RTSNA ? RTTXT ? RTBAD ? RT6BT

readw1:	skipn comand		   ; Win if there's anything there
	  jrst readfl

readwn:	setz ch,		   ; ensure ends with a null
	push sp,bp
	idpb ch,bp
	pop sp,bp
	setom reread
	jrst popj1
readw0:	push p,bp
	setz x,
	idpb x,bp
	pop p,bp
	jrst readwn

RTBAD:	move x,ostate		   ; What state went bad?
	cain x,%rscmd		   ; Command reading?
	  jrst rtbadc		   ;   Barf about unknown command
	type dspc,/AI don't understand that.
/
	jrst readfl

rtbadc:	type dspc,/AI don't know the '/
	6type tyoc,comand
	type tyoc,/' command.
/
	jrst readfl

RTNUL:
RTCOL:
readfl:	setom reread
	ret

readrb:	ldb ch,bp		   ; Get the character to be eliminated
	call wipech		   ; Wipe it from the screen
	decbp bp		   ; Back up the pointer
	soja ct,@.+1(t)
	  RBNUL ? RBCOL ? RBCMD ? RBPOS ? RBPS1 ? RBPS2 ? RBALT ? RBAL2 ? RBARG
	  RBFIL ? RBSND ? RBSNA ? RBTXT ? RBBAD ? RB6BT

readhl:	jrst @.+1(t)
	  RHNUL ? RHCOL ? RHCMD ? RHPOS ? RHPS1 ? RHPS2 ? RHALT ? RBAL2 ? RHARG
	  RHFIL ? RHSND ? RHSNA ? RHTXT ? RHBAD ? RL6BT

readh0:	skipe helper		   ; Have we got a special helper?
	  xct helper		   ; Provide the help
	jrst redis		   ; and redisplay

readrd:	move t,rstate
	jrst @.+1(t)
	  RLNUL ? RLCOL ? RLCMD ? RLPOS ? RLPS1 ? RLPS2 ? RLALT ? RLAL2 ? RLARG
	  RLFIL ? RLSND ? RLSNA ? RLTXT ? RLBAD ? RL6BT

newstate:
	movem x,rstate
	jrst read0

RDNUL:	cain ch,40
	  jrst read0		   ; Spaces we ignore
	cain ch,^M		   ; Return
	  jrst readex
	cain ch,^R		   ;   A control-R to print a file
	  jrst read.r		   ;     Go do it now.
	cain ch,^F
	  jrst read.f
	movem ct,colloc
	cain ch,":
	  TRANSITION COL
	caie ch,%txtop+"H	   ; If he's asking for help, give it to him
	  cain ch,"?
	    jrst [call bhelp ? jrst read0]
	movem ct,posloc
	cain ch,33		   ; Altmode?
	  TRANSITION ALT
	caie ch,".
	  cain ch,"%
	    jrst begpos
	caie ch,"!
	  cain ch,"/
	    jrst begpos

	cail ch,"0
	  caile ch,"9
	    caia
	      jrst begpos
	cail ch,"a
	  caile ch,"z
	    caia
	      jrst begpos
	cail ch,"A
	  caile ch,"Z
	    caia
	      jrst begpos
	jrst gobad		   ; Go into BAD state

read.r:	move x,[sixbit /UPRINT/]	; Prepare to read ^R-style
	movem x,comand
	movei x,[asciz /A(Print File)/]
	movem x,filprm		   ; Set up prompt for printing a file
	setz x			   ; Use the normal default.
	call flprmp		   ; Prompt with the filename default
	movem ct,argloc		   ; Remember where the filename begins
	movem bp,argptr
	TRANSITION FIL		   ; Start reading the filename

rdflal:	move x,[asciz /A(Print File)/]
	movem x,filprm
	setz x
	call flprmp
	move bp,[440700,,msgbuf]
	call rdinit
	jrst read0

read.f:	move x,[sixbit /ULISTF/]
	movem x,comand
	setzm arg6
	jrst readwn

begpc:	move a,[440600,,comand]
	setzm comand		   ; Initialize it to blanks
	cail ch,140
	  subi ch,40
	subi ch,40
	idpb ch,a		   ; and deposit
	movei count,1		   ; 1 character
	ret

begcmd:	call begpc
	TRANSITION CMD		   ; We're now in %RSCMD state

begpos:	call begpc
	TRANSITION POS

RBNUL:	jrst rdrset		   ; Ignore rubouts here

RHCOL:	call bhelp
	jrst redis

RHNUL:	call bhelp		   ; Tell what commands exist
	jrst rdrset		   ; Flush blanks, etc, and reprompt

RLNUL:	type dspc,/C/
	jrst rdrset		   ; Show an empty line

RHBAD:	type dspc,/ARandom garbage on the command line, delete /
	10type tyoc,count
	type tyoc,/ character(s) to correct.
/
	jrst redis

RBBAD:	sojg count,read0	   ; Still bad ...
	move x,ostate		   ; Enough rubouts to fix up
	movem x,rstate		   ; so return to previous state
	jrst read0

gobad:	movei count,1		   ; Number of bad characters
	move x,rstate		   ; Remember what state we came from
	movem x,ostate
	TRANSITION BAD

RDBAD:	aoja count,read0	   ; More badness

RLCOL:
RLFIL:
RLARG:
RL6BT:
RLCMD:
RLPS2:
RLPS1:
RLALT:
RLAL2:
RLPOS:
RLBAD:	jrst credis

RDCOL:	caie ch,":		   ; Colon?
	  caig ch,40		   ;   non-printing character?
	    caia
	      jrst begcmd
	jrst read0		   ;     Just ignore them after 1st colon

RBCOL:	camge ct,colloc		   ; Anything left in buffer?
	  TRANSITION NUL
	jrst read0

RDPOS:	cain ch,^A		   ; Single-character commands
	  jrst readxm		   ;   PRMAIL
	cain ch,^F
	  jrst readxf		   ;   LISTF
	caie ch,^H
	  cain ch,^K
	    jrst readw1

	setzm altifx		   ; An infix arg to $U?
	cain ch,33		   ; Altmode?
	  TRANSITION PS1

	call rd6		   ; Do the work for reading in 6bit
	  caia
	    jrst read0
ife $$PAND,[
rtpos1:
	type dspc,/A(You must begin commands with a colon)
/
	jrst readfl

] ; END of IFE $$PAND,
.else [
	jrst rtcmd0
] ; End of IFN $$PAND, (.else)

readxm:	move x,comand
	movem x,arg6
	move x,[sixbit /PRMAIL/]
	movem x,comand
	jrst readwn

readxf:	move x,comand
	movem x,arg6
	move x,[sixbit /ULISTF/]
	movem x,comand
	jrst readwn

RTPOS:	skipn comand		   ; Anything there?
	  jrst readfl		   ;   Nope, just return failure
ife $$PANDA,[
	jrst rtpos1		   ; Yes, complain about no colon
] ; END of IFE $$PANDA,
.else	[
	jrst readwn		   ; We got a command
	]

RBPOS:	sojge count,rbcmd0	   ; If there's anything left, back up one
	TRANSITION NUL		   ; Nothing left

RDPS1:	cain ch,33		   ; Altmode?
	  TRANSITION PS2	   ;   Yes, it's two altmodes
	cail ch,"0
	  caile ch,"9
	    jrst rdps10
	      movem ch,altifx
	      jrst read0
rdps10:	cain ch,^A		   ; FOO

	  jrst rdps11
	caie ch,"u
	  cain ch,"U
	    caia
	      jrst gobad	   ;   Lossage, go into BAD state
	move x,comand
	movem x,arg6
	move x,[sixbit /ULOGIN/]
	movem x,comand
	jrst readwn

rdps11:	move x,comand
	movem x,arg6
	move x,[sixbit /UPRMAIL/]
	movem x,comand
	jrst readwn

RTPS1:	move x,comand		   ; Assume he meant to say 'U'
	movem x,arg6
	move x,[sixbit /ULOGIN/]
	movem x,comand
	jrst readwn

RBPS1:	camge ct,ps1loc		   ; Have we rubbed out all of this state?
	  TRANSITION POS	   ;   Yes, previous state
	setzm altifx		   ; No more infix then
	jrst read0

RDPS2:	cail ch,"0
	  caile ch,"9
	    jrst rdps20
	      movem ch,altifx
	      jrst read0
rdps20:	caie ch,^A
	  jrst rdalt0		   ; Complain if not ^A
	move x,comand
	movem x,arg6
	move x,[sixbit /PRRMAI/]
	movem x,comand
	jrst readwn
	
RBPS2:	TRANSITION PS1

RHPOS:	type dspc,/Acommand <==> :command
/
RHPS1:	type dspc,/AnameU  <==> :LOGIN name
name
 <==> :PRMAIL name
/
RHPS2:	type dspc,/Aname
 <==> :PRRMAIL name
/

RDALT:	setzm arg6
	cain ch,^A		   ; <alt>^A?
	  jrst [move x,[sixbit /UPRMAI/] ? movem x,comand ? jrst readwn]
	cain ch,33
	  TRANSITION AL2
rdalt0:	type dspc,/AHuh?  I don't understand that!
/
	jrst readfl

RBALT:	TRANSITION NUL


RDAL2:	caie ch,"v
	  cain ch,"V		   ; V?
	    jrst rdal20
	caie ch,"u
	  cain ch,"U
	    jrst rdal21
	cain ch,^A		   ; <alt><alt>^A?
	 jrst [ move x,[sixbit /PRRMAI/]
		movem x,comand
		jrst readwn ]
	cail ch,"0		   ; Numeric infix?
	  caile ch,"9
	   jrst rdalt0		   ;   nope, gubbish
	movem ch,altifx
	jrst read0

rdal20:	move x,[sixbit /LISTJ/]
	movem x,comand
	jrst readwn

rdal21:	move x,[sixbit /ULOGOU/]
	movem x,comand
	jrst readwn


RTPS2:
RTALT:
RTAL2:	type dspc,/AHuh?  I don't understand that.
/
	jrst readfl

RBAL2:	TRANSITION ALT		   ; Previous state

RHALT:	
RHAL2:	type dspc,/A
$U -- :LOGOUT   (Prepare to disconnect from ITS.)
V -- :LISTJ    (List what jobs you have.  Not applicable until logged in.)
/
	jrst redis
	
RD6BT:	call rd6		   ; Read in the 6bit
	  jrst readwn		   ;   Read won
	jrst read0		   ; More to come

RDCMD:	call rd6		   ; Read in the 6bit
	  jrst rtcmd0		   ;   Terminate it
	jrst read0		   ; More to come

rd6:	caie ch,^I
	  cain ch,40
	    ret			   ;   Ended
	cail count,6		   ; Is there any more room in the word?
	  aoja count,popj1	   ;   No, just count it
	cail ch,140
	  subi ch,40
	subi ch,40
	idpb ch,a		   ; Deposit the character
	aoja count,popj1

rtcmdx:	cail count,6		   ;   any blanks in the word?
	  ret			   ;     If not, just return
	move x,6blk(count)	   ; Else gotta clear them out
	andcam x,comand
	ret

6blk:	777777,,777777
	007777,,777777
	000077,,777777
	000000,,777777
	000000,,007777
	000000,,000077

RT6BT:	call rt6btx		   ; Pad with blanks
	skipn arg6
	  jrst readfl
	jrst readwn

rt6btx:	cail count,6		   ;   any blanks in the word?
	  ret			   ;     If not, just return
	move x,6blk(count)	   ; Else gotta clear them out
	andcam x,arg6
	ret


RTCMD:	call rtcmdx		   ; pad with blanks
	skipn comand		   ; Anything left of the command?
	  jrst readfl		   ;   No, a failure
	jrst readwn		   ; Yes, success

rtcmd0:	movem count,6cnt	   ; Remember in case we rub back here
	move tt,comand		   ; Get the command involved
	call ttkget		   ; Get ptr to it
	  jrst gobad		   ;   Undefined, it's bad
	movem bp,argptr		   ; Save pointer to where command's args begin
	setzm argcnt
	move x,cm$flg(t)	   ; Get the flag bits
	tlne x,%COFIL
	  transition FIL
	tlnn x,%COSND
	  transition ARG
	movem bp,snaptr		   ; Remember where name begins
	setzm snacnt
	transition SNA

RH6BT:	xct helper
	jrst read0

RHCMD:	cail ct,6		   ; If we have too few characters
	  jrst rhcmd0
	move x,6blk(ct)		   ; We must mask off the unfilled part of
	andcam x,comand		   ; the command name
rhcmd0:	move tt,comand		   ; Get the command
	call ttkget		   ; Get the index to it's info
	  jrst rhcmd1		   ;   No command, foo
	push sp,comand
	call pldoc		   ; print the documentation for this command
	pop sp,nul
	jrst read0		   ; Onward

rhcmd1:	call bhelp		   ; Tell him what he has to choose from
	jrst redis		   ; show what he's got

RB6BT:	sojl count,readfl	   ; Fail if we over-rubout
	call rt6btx		   ; Pad arg with blanks
	caige count,6		   ; If we're over, we're OK
	  move a,6bp(count)	   ;   Get the new byte pointer
	hrri a,arg6		   ; We're putting 6bit in ARG6, not COMAND
	jrst read0		   ; So now we're backed up

RBCMD:	sojl count,rbcmd1	   ; uncount it
rbcmd0:	call rtcmdx		   ; Pad command with blanks
	caige count,6		   ; If we're over, we're OK
	  move a,6bp(count)	   ; Get the new byte pointer
	jrst read0		   ; so now we're backed up.

rbcmd1:	TRANSITION COL

6bp:	440600,,comand
	360600,,comand
	300600,,comand
	220600,,comand
	140600,,comand
	060600,,comand

RTTXT:
RTSND:	cain ch,^C
	  jrst readw0
	movei ch,^M
	idpb ch,bp
	movei ch,^J
	idpb ch,bp
	movei x,2
	addm x,ct
	addm x,argcnt
	jrst read0

RTSNA:	movem bp,argptr
	setzm argcnt
	TRANSITION SND
      
RTARG:	
RTFIL:	setz ch,		   ; Ensure that it ends with a NUL
	idpb ch,bp		   ; For the sake of RFN
	jrst readwn

RDSNA:	caie ch,40		   ; Whitespace
	  cain ch,^I
	    jrst rtsna		   ;   Go on to SND state
	aos snacnt		   ; Count this character
	jrst read0		   ; Loop

RDTXT:
RDSND:	cain ch,^W
	  jrst rdsndw
	cain ch,^U
	  jrst rdsndu
	cain ch,^R
	  jrst rdsndr
	cain ch,^K
	  jrst rlsnd0

RDARG:	aos argcnt		   ; Count the argument
	jrst read0


snddis:	move x,argptr		   ; The line for rediplay begins with the text
	movem x,linbeg
	move ct,argcnt
	call sndhdr		   ; Print the :SEND header
	setom sndrds		   ; say we've reformated it
	pjrst redsj		   ; Redisplay our stuff

rdsndw:	call wipech		   ; Wipe the ^W from the screen
	decbp bp		   ; Back up the pointer
	sos ct			   ; over the ^W
	skipn sndrds		   ; Have we reformated the SEND buffer?
	  call snddis
	move c,argcnt		   ; Count of characters originally in buffer
	move d,bp
	call rdsnup		   ; Maybe move up to previous line
	jrst rdsnw1

rdsnw0:	decbp bp		   ; We've decided to delete it
rdsnw1:	jumple c,rdsnx		   ; Update the screen and return if empty
	ldb ch,bp		   ; Check out this character
	cain ch,^J		   ; Linefeed?
	  call lfnlck		   ;   Yes, see if part of a newline (CRLF)
	    jrst rdsnw2		   ;     No, just treat as control char
	      call rubnl	   ;	   Newline, flush it
	      soja c,rdsnw0	   ;	   and keep looking for the word
rdsnw2:	call alphap		   ; Special character?
	  soja c,rdsnw0		   ;   Yes, skip it

	decbp bp		   ; We've decided to delete this
	sojle c,rdsnx		   ; Update the screen and return if empty
rdsnw3:	ldb ch,bp		   ; Check out this character
	call alphap		   ; Special character?
	  jrst rdsnx		   ;   Yes, that delimits the word
	decbp bp		   ; Be sure to delete this one too.
	sojg c,rdsnw3		   ; Part of the word, flush it
	jrst rdsnx		   ; Start of word, update display

rdsndu:	call wipech		   ; Remove the ^U from the screen
	decbp bp		   ; Back over the ^U
	sos ct
	skipn sndrds		   ; Have we reformated the SEND buffer?
	  call snddis
	move c,argcnt		   ; Count of characters originally in buffer
	move d,bp
				   ; Let's back over the first character
	jumpe c,rdsnx		   ; if at beginning of line, will go to
				   ; previous line
	call rdsnup		   ; Maybe move up a line
	jrst rdsnu1		   ; hack all this

rdsnu0:	decbp bp
	sos c
	ldb ch,bp		   ; Check out this character
rdsnu1:	cain ch,^J		   ; Linefeed?
	  call lfnlck		   ;   Yes, see if part of a newline (CRLF)
	    caia
	      jrst rdsnx	   ;     Don't back over it, redisplay
	jumpg c,rdsnu0		   ; Update the screen and return if empty
	jrst rdsnx		   ; Empty, update screen

rdsnup:	ldb ch,bp
rdsup1:	caie ch,^J		   ; Is it a linefeed?
	  ret			   ;   No, this isn't a line begin
	call lfnlck		   ; Is this part of a newline (CRLF)?
	  ret			   ;   No, just hack as bare ^J
	decbp bp		   ; Move over the ^M as well
	sos c
	sos ct
	move x,ttyopt
	tlnn x,%tomvu		   ; Can we move up?
	  jrst rdsnrl		   ;   No, just redisplay previous line
	tlne x,%toovr		   ; no-overstrike (a way to erase)
	  tlnn x,%toers		   ;   Otherwise erasible?
	    caia		   ;     yes
	      jrst rdsnrl	   ;	   no, don't confusingly move up
	type dspc,/U/
	save [x,t,a,b]
	move t,bp		   ; copy some data temporarily
	move b,c
	call findnl		   ; Find out the beginning of this line
	call rdsnxa		   ; Find out where on this line we are
	type dspc,/H/		   ; let's position ourself on this line
	movei ch,10(a)
	tyo dspc,ch
	restore [b,a,t,x]
	ret

rdsndr:	decbp bp		   ; Back over the ^U
	sos ct
	skipn sndrds		   ; Have we reformated the SEND buffer?
	  call snddis
	call rdsnrl		   ; Redisplay the line
	jrst read0

rdsnrl:	save [x,t,b]
	move b,argcnt		   ; Count of characters originally in buffer
	move t,bp
	call findnl		   ; Find the beginning of the line
	caml b,argcnt		   ; Did we back up at all?
	  jrst rdsnrx		   ;   Nope, don't do anything
	move x,ttyopt
	tlne x,%toovr		   ; Can't over-strike?  Can erase that way!
	  tlne x,%TOERS		   ; Skip if can't erase
	    jrst rdsnrd		   ;   Aha, we can do it nicely
	type tyoc,/
/				   ; Nope, just start a new line
	caia
rdsnrd:	  type dspc,/HL/	   ; Display, we can clear this line
rdsnr0:	caml b,argcnt		   ; Are we back to where we began?
	  jrst rdsnrx		   ;   Yep, all done
	ildb ch,t		   ; Pick up a character
	echoch			   ; Echo it
	aoja b,rdsnr0		   ; next character

rdsnrx:	restore [b,t,x]
	ret

; In C is the count of characters in the edited argument.
; In ARGCNT is original count.  It will be updated to the new count
; In BP is the Byte pointer to the remaining argument
; In D is the old byte pointer
; Update the display and go to READ0

rdsnx:	caml c,argcnt		   ; Do we have anything to do?
	  jrst read0		   ;   No change, do nothing
	save [t,ch,b]
	move t,bp		   ; Copy of the BP
	move b,c		   ; Copy of the count
	call findnl		   ; Find the beginning of this line
	call rdsnxa		   ; Get in A the # of character positions
				   ; now on the line
	save [a,c]
	move c,argcnt		   ; Now we get to find out how character
	move t,argptr
	call rdsnxa		   ; positions were rubbed out
	move b,a		   ; B gets count
	restore [c,a]		   ; A recovers hpos
	movem c,argcnt		   ; We don't need the old count anymore
	move x,ttyopt
	tlne x,%toovr		   ; Can't over-strike?  Can erase that way!
	  tlne x,%TOERS		   ; Skip if can't erase
	    jrst rdsnxd		   ;   Aha, we can do it nicely
	cail a,20.		   ; If we're close to left we can always 
	  jrst rdsnx0
	tlnn x,%tomvb		   ;   back up, even if our TTY won't backspace
	  jrst rdsnxl		   ;     Otherwise, we're a loser

rdsnx0:	type dspc,/H/		   ; Win, let's do it with slashes
	movei x,10(a)		   ; Compute character to indicate our position
	tyo dspc,x		   ; output it

	sosl b
	  tyo tyoc,["/]		   ; Output a slash, b types
	sojge b,.-1
	type dspc,/H/
	movei x,10(a)
	tyo dspc,x
	setom lfflag
	restore [b,ch,t]
	move ct,argcnt
	jrst read0

rdsnxd:	restore [b,ch,t]
	type dspc,/H/
	movei x,10(a)
	tyo dspc,x
	type dspc,/L/
rdsnxx:	move ct,argcnt
	jrst read0

rdsnxl:	restore [b,ch,t]
	sojl b,rdsnxx		   ; When no more characters left, done
	ldb ch,d		   ; Get first character rubbed out
	tyo tyoc,ch		   ; Type it
	decbp d			   ; Back up the byte pointer
	jrst rdsnxl		   ; loop until sick of it

;; FINDNL takes a Byte Pointer in T, a count in B, and sets them to point 
;; to the last NL or the beginning of the buffer.


findnl:	jumpe b,cpopj
fndnl0:	ldb ch,t
	cain ch,^J		   ; Looking for a linefeed
	  ret
	decbp t			   ; Back up pointer
	sojg b,fndnl0		   ; or the beginning of the buffer
	ret

; Get the current horizontal position in A
; C has the count to end at, T has the Byte Pointer to follow.

rdsnxa:	setz a,			   ; A counts the character positions
	caml b,c		   ; Already to the end?
	  ret
rdsxa0:	ildb ch,t		   ; Check out a character
	cain ch,^I		   ; TAB?
	  jrst rdsnxI		   ;   Special case
	caie ch,177		   ; Rubout?
	  caige ch,40		   ;   Control?
	    aos a		   ;     count the uparrow
	aos a			   ; Count it
	aos b
rdsxa1:	came b,c		   ; Is this all?
	  jrst rdsxa0		   ;   Nope, keep counting
	ret
	
rdsnxI:	addi a,7		   ; Go to next tab stop
	andi a,-10		   ; but no further
	aoja b,rdsxa1		   ; Return to the loop

alphap:	caige ch,"A		   ; Special character?
	  caig ch,"9
	    caia
	      ret
	caige ch,"0		   ; Special character?
	  ret
	jrst popj1


;Check to see if a LF is part of a CRLF pair.  Skip if so.
lfnlck:	caig c,1		   ; Is this the last character?
	  ret			   ;   Yes, it's not part of CRLF
	push sp,x
	move x,bp
	decbp x
	ldb x,x
	cain x,^M		   ; A ^M to match it?
	  aos -1(sp)
	pop sp,x
	ret

;Handle backing over a newline.
rubnl:	move x,ttyopt		   ; Get TTY characteristics
	tlnn x,%tomvu		   ; Can it move up?
	  jrst rubnl1		   ;   No, do something else
rubnl0:	type dspc,/H/	   ; Go to beginning of this line
	call findnl
	ret			   ; Return

rubnl1:	tlne x,%toovr		   ; Can't over-strike?  Can erase that way!
	  tlne x,%TOERS		   ; Skip if can't erase
	    caia		   ;   Aha, we can do it nicely
	      jrst rubnl0	   ;     Boo, can't do it

rlsnd0:	type dspc,/A/
	decbp bp		   ; Back over the ^K
	sos ct
	jrst rlsnd1


RLTXT:	type dspc,/C/
	setom sndrds
	jrst rlsnd2

RLSND:	type dspc,/C/
rlsnd1:	setom sndrds
	call sndhdr		   ; Print the header
rlsnd2:	move x,argptr		   ; Say things begin with the argument
	movem x,linbeg
	move ct,argcnt
RLSNA:	jrst redis

sndtyp:	-11,,snddsc		   ; Header and message
sndltp:	-10,,snddsc		   ; Just header

snddsc: 440700,,[asciz /[Message from /]
	tp$6bt runame
	440700,,[asciz / at MIT-/]
	tp$6bt machin
	440700,,[asciz /  /]
	tp$6bt a
	tp$ind (b)[ 440700,,[asciz /am/]
		    440700,,[asciz /pm/] ]
	440700,,[asciz /]
/]
	tp$ind argptr

sndhdr:	move x,rstate
	caie x,%rssnd		   ; Is this really sending?
	  ret			   ;   nope, don't print SEND header!
	terpri
	call sndtim
	typout tyoc,sndltp
	ret

sndtim:	.rtime tt,		   ; Get 0 ? HHMMSS 
	and tt,[-10000]		   ; Get 0 ? HHMM__
	setz t,
	lshc t,14		   ; Get HH ? MM____
	setz b,			   ; flags pm instead of am
	cail t,(sixbit / 12/)	   ; Is it 12:00-23:59?
	  aos b			   ;   yes, it's PM
	caile t,(sixbit / 12/)	   ; Is it 24hour time?
	  jrst [subi t,100	   ;   Convert it.  Subtract the 10
	        ldb x,[000600,,t]  ;   Get the second digit
		caige x,'2	   ;   Is it less than 2?
		  subi t,000070	   ;     Must perform a borrow type operation
		cail x,'2	   ;   Otherwise
		  subi t,2	   ;     Can just decrement by 2
		jrst .+1]
	lsh t,6			   ; Get HH0 ? MM____
	iori t,(sixbit /  :/)	   ; Get HH: ? MM____
	lshc t,-14		   ; Get H ? H:MM__
	caie t,(sixbit /  0/)	   ; Leading zero?
	  lshc t,-6		   ;   No, include it
	move a,tt		   ; Because TYPOUT can't hack TT
	ret

RDFIL:	aos argcnt		   ; Count the argument
	caie ch,33
	  jrst read0
	setz ch,		   ; Let's make this an ASCIZ string
	dpb ch,bp		   ; replacing the altmode with a NUL

	move d,bp		   ;pointer to the file-name
	movei b,filnam		   ;pointer to filename block
	call rfn"rfn		   ;read the names

	movei x,[asciz /(Print File)/]
	movem x,filprm
	movei x,filnam
	call flprmp		   ; Reprompt with our new info
	setz argcnt
	move bp,argptr		   ; Re-initialize our reader to be just after
	move ct,argloc		   ; where we began
	jrst read0		   ; and read in the filename.

RBSNA:	move count,6cnt		   ; In case we rub back into the command
	sosge snacnt		   ; uncount this character
	  TRANSITION CMD	   ;   Underflow
	jrst read0

RBTXT:
RBSND:	sosge c,argcnt		   ; uncount this char
	  transition SNA	   ;   underflow
	jumpe c,read0		   ; Anything left?
	call rdsup1
	movem c,argcnt		   ; Update the new argument count
	jrst read0

RBFIL:
RBARG:	move count,6cnt		   ; In case we rub back into the command
	skipg argcnt		   ; Nothing left?
	  transition CMD	   ;   underflow
	sos argcnt		   ; uncount this char
	jrst read0

RHARG:	move tt,comand
	call ttkget
	  error /TTKGET didn't find command, but we're in RHARG??/
	push sp,comand
	call pldoc		   ; Give him the documentation
	pop sp,nul
	jrst redis		   ; Redisplay


RHFIL:	cain ch,"?		   ; Is it a ?
	  jrst read1		   ;   ? is legal in filenames
	type dspc,/AReading an ITS filename.  ITS filenames have
4 components, specified as follows:

dev: dir; fn1 fn2

the device name ('dev') is followed by a colon.  If omitted, the most recently
referenced device is used, or DSK: (the main disks) is assumed.  The directory
name is followed by a semicolon.  If omitted, the most recently referenced
directory is used, or your home directory is assumed.  The two filenames (fn1
and fn2) are separated by a space.  The character '>' has the special meaning
of 'greatest numerical name'.  This is generally used as a second filename.
It's behaviour is difficult to predict if no files with the specified first
name have numerical second filenames.  However, if there is only one file with
a given first filename, say FOO BAR, it will find that file.

All filenames are in 'sixbit', i.e. 1-6 characters long, using 0-9, A-Z,
and the following special characters:  '";:-_+=<>,.%^&$#@!*()[]
Many of those special characters must be quoted by proceeding them with a
control-Q character, however.
/
	jrst readh0

RHTXT:	cain ch,"?		   ; ? is ok character of text
	  jrst read1
	type dspc,/C/
	jrst rhsnd0

RHSND:	cain ch,"?		   ; ? is ok character of text
	  jrst read1
RHSNA:	  type dspc,/CType     ":SEND <username> <cr> <message> ^C".     Within
the message, these characters have the following meanings:

/
rhsnd0:	type dspc,/A
  rubout deletes backwards
  ^C	 Send message
  ^D	 Quit
  ^G	 Quit!!
  ^L	 Redisplay message
  ^R	 Redisplay line
  ^U	 Kill current line
  ^W	 Kill Word
  [HELP] Prints documentation.  This is Top-H on TV's and ^_H on non-TV's

All other characters are self-inserting.
/
	jrst readh0


pchar1:	aos count		   ;both ways
pchar:	idpb ch,bp		   ;save the character
	aos ct			   ;count it
	cail ct,msgbfl		   ; overflow?
	  jrst [type dspc,/AInput buffer overflow
/
		setz ch,	   ;   simulate a quit
		ret]
	echoch			   ;echo it so he can see what t'fuck he's doin
	jrst popj1		   ;successful!

uchar1:	sos count		   ;back up local count as well
uchar:	ldb ch,bp		   ;get the character we're rubbing out
	call 1wipe		   ;wipe it off the screen
	sos ct			   ;uncount it.
	decbp bp		   ;and back it up
	ret

credsj:	type dspc,/C/
redsj:	setzm lfflag
	jumpe ct,cpopj
	save [x,t]
	move t,linbeg
	move x,ct
redis0:	ildb ch,t
	cain ch,^M		   ; Is this maybe CRLF?
	  jrst redism
	echoch
redis1:	sojg x,redis0
	restore [t,x]
	ret

redism:	caig x,1		   ; Is there another chracter?
	  jrst redsm0		   ;   no, just a bare ^M
	move ch,t
	ildb ch,ch		   ; Is the next character ^J?
	caie ch,^J
	  jrst redsm0		   ;   No, just do ^M bit
	type tyoc,/
/				   ; Yes, output a newline
	ibp t			   ; Skip the ^J then
	soja x,redis1

redsm0:	call echosl		   ; Echo ^M, with ^ or 
	jrst redis1		   ; Loop

credis:	type dspc,/C/
	call credsj
	jrst read0

redis:	call redsj
	jrst read0

r6arg:	save [count,ch,a,ct,x]
	skipn ct,argcnt
	  jrst r6arg1
	setzb count,x
	setzm arg6
	move a,[440600,,arg6]
r6arg0:	ildb ch,argptr		   ; Take away one character of the argument
	sos argcnt
	call rd6		   ; Add it to our argument
	  jrst r6arg1		   ; Whitespace!
	sojg ct,r6arg0		   ; loop

r6arg1:	restore [x,ct,a,ch,count]
	ret

rcarg:	save [a,b,c,x,t,tt,bp,ct,ch]
	move tt,comand
	call ttkget		   ; in the table
	  error /RCARG got an unknown command./
	setzm crgbts		   ; No bits yet
rcarg1:	skipg c,argcnt		   ; count of chars
	  jrst rcarwn		   ;   If we didn't read anything, done
	move b,argptr		   ; Ptr to start of it, temporary
rcare0:	ildb ch,b		   ; Scan for leading whitespace
	caie ch,^I		   ; whitespace?
	  cain ch,40
	    caia
	      jrst rcare.	   ;    nope, flush it.
	movem b,argptr		   ; Whitespace, flush it
	sosg c,argcnt
	  jrst rcarex		   ;   If that's all, punt
	jrst rcare0		   ; look for more whitespace

rcare.:	move a,cm$opt(t)	   ; Get the options AOBJN
	setz ct,		   ; Count how long this option is
	move bp,argptr		   ; Ptr to start of it
	move b,argptr		   ; Ptr to start of it
rcare1:	jumpe c,rcarew
	ildb ch,b		   ; Search for the end of it
	sos c
	caie ch,^I		   ; (whitespace marks the end)
	  cain ch,40
	    caia
	      aoja ct,rcare1	   ;   Next character

rcarew:	movem c,argcnt		   ; Save our updated pointers
	movem b,argptr
rcarec:	call rcarck		   ; See if it matches this option
	  caia			   ;   No match
	    jrst rcare2		   ;     Match!
	aos a			   ; Skip the bit
	aobjn a,rcarec		   ; and loop

	type dspc,/AUnknown option '/
rcaree:	syscal SIOT,[argi tyoc ? bp ? ct]
	  loss
	type tyoc,/'
/
	jrst rcarex

rcare2:	setz c,			   ; C ==> -1 iff ambiguous
	move b,a		   ; Remember the winning entry
rcare3:	hlrz x,(a)		   ; Get the option length
	camn x,ct		   ; Is it an exact match?
	  jrst rcare9		   ;   Yes, win
	aos a			   ; Check the rest of the entries to see
rcare4:	aobjp a,rcare8		   ; if it's unambiguous.  If so, win
	call rcarck		   ; Does this one match too?
	  aoja a,rcare4		   ;   No match, next one
	setom c			   ; Note that it's ambiguous
	jrst rcare3		   ; Check the rest and this for exact match

rcare8:	jumpe c,rcare9		   ; If unambiguous, it's a win
	type dspc,/AAmbiguous option '/
	jrst rcaree		   ; Go tell which one

rcare9:	move x,1(b)		   ; Get the bit
	iorm x,crgbts		   ; Know that we have it
	skiple argcnt		   ; Any remaining arguments?
	  jrst rcarg1		   ;   No, gobble down some more

rcarwn: restore [ch,ct,bp,tt,t,x,c,b,a]	   ; The end, exit with success
	jrst popj1

rcarex:	restore [ch,ct,bp,tt,t,x,c,b,a]	   ; The end, exit with failure
	ret

; In CT -- Number of characters of supplied args
; In BP -- Byte pointer to supplied args
; In A	-- AOBJN ptr to an [len,,address ? bit] for an option

rcarck:	save [bp,t,ct,x,c,ch]
	move t,(a)		   ; Get an option
	hlrz x,t		   ; Get it's length
	hrli t,440700		   ; Create a byte pointer
rcarc1:	sojl ct,rcarcw		   ; End of supplied, matches!
	sojl x,rcarcx		   ; We're longer, no match
	ildb ch,t		   ; A character from the option
	ildb c,bp		   ; A character from the supplied arg
	cail ch,"a		   ; Uppercasify
	  caile ch,"z
	    caia
	      subi ch,40
	cail c,"a		   ; Uppercasify
	  caile c,"z
	    caia
	      subi c,40
	camn c,ch		   ; Are the characters the same?
	  jrst rcarc1
rcarcx:	restore [ch,c,x,ct,t,bp]
	ret

rcarcw:	restore [ch,c,x,ct,t,bp]
	jrst popj1

ukwarn:	ife $$pand,[
	type dspc,/AThat command is not known to this program.
Maybe you should log in?  Type :HELP for info.
/
] ;; end IFE $$PAND
.else [
	type dspc,/AThat command is not known.
Type :HELP for info.
/
] ;; end IFN $$PAND
	ret

prcmln==0
define prcmd name,loc
       sixbit /name/ ? loc
prcmln==prcmln+1
termin

prcmtb:	prcmd PRRMAI,uprrmail
	prcmd UPRMAI,uprmail
ife $$PAND,	prcmd ULOGIN,ulogin
	prcmd ULOGOU,ulogout
	prcmd LISTJ,ulistj
	prcmd ULISTF,ulistf
	prcmd UPRINT,uprint

kdspch:	move tt,comand
	move t,[-prcmln,,prcmtb]
kdspcl:	camn tt,(t)		   ; Is this a prefix command?
	  jrst kdspc0		   ;   Yes, hack it
	aos t
	aobjn t,kdspcl		   ; Loop

	call ttkget		   ;get a pointer to the command
	  pjrst ukwarn		   ;  tell him he lost, and return

	move tt,cm$flg(t)	   ;get it's flags
	tlne tt,%COTOP		   ;is it a topic, rather than a command?
	  jrst [terpri
		type tyoc,/That's a topic for HELP, not a command!
/
		ret]		   ;and return that we were not successful
	call @cm$rtn(t)		   ;it's OK, go to it!
	jrst popj1		   ;and return our success in running it
	jrst popj1

kdspc0:	call @1(t)		   ; Invoke the function
	jrst popj1
	jrst popj1

;; TTKGET takes a sixbit command in TT, and returns in T the index into CMDTAB
;; Skip returns unless the command is unknown (ie bad).

ttkget:	hrlzi t,-eqvlen		   ;T <- AOBJN ptr for equivilance tables
kget0:	camn tt,eqvtab(t)	   ;is there an equivalence?
	  jrst [move tt,eqvtab+1(t)  ;get the equiuvalent command
	        jrst kget2]	   ;  and look it up
	add t,[1,,1]		   ;skip the equivalence
	aobjn t,kget0		   ;try next one

kget2:	move t,[-cmdcnt,,cmdtab]   ;t <- AOBJN ptr for command tables
kget3:	camn tt,cm$nam(t)	   ;is it this entry?
	  jrst bdcmd		   ;  we found it, skip if it is OK!
	addi t,cm$len-1		   ;Ignore the next entry.
	aobjn t,kget3		   ;Try the next one!
	ret			   ;Not known, don't skip

;; BDCMD takes in TT a sixbit command name, and skip-returns if it is OK.

bdcmd:	save [t]
IFE $$PAND,[			   ;No commands are bad in PANDA!
	call pwdmap		   ;Be sure we have the database mapped
	save [a]		   ;Dont smash A.
	movei a,nocmnd		   ;Let's check the table of bad commands
	call pwsget		   ;Get the bad-commands table into TMPBUF.
	move t,a		   ;T gets the count of bad commands.
	restore [a]		   ;Done with A.
bdcmd1:	camn tt,tmpbuf(t)	   ;If this is a bad command
	 jrst popjt		   ;  Just return.
	sojge t,bdcmd1		   ;Loop for all bad commands.
];End of PWORD-only code.
popj1t:	aos -1(p)		   ;Skip return.
popjt:	restore [t]
	ret



;;; WIPECH takes one character in CH and wipes it off the screen.

wipech:	save [d]
	movei d,1		   ; Assume 1 character position
	caie ch,177		   ; is it a rubout
	  caige ch,40		   ;   or a control?
	    aos d		   ;     then it takes two

	cain ch,33		   ; is it an altmode?
	  sos d			   ;   then it's an exception

	call wipe		   ; so let wipe do it's stuff
wipecx:	restore [d]
	ret

;;; wipe away one character
1wipe:  push sp,d
	movei d,1		   ;one position
	pjrst wipe0		   ;wipe it away!

;;; WIPE takes an argument in D, which is the number of character positions to
;;; delete from the screen.

wipe:	push sp,d
wipe0:	save [t,tt,b]
	syscal rcpos,[argi tyoc	   ;get the cursor position
		val a]
	  loss
	hrrz t,a
	movem t,hpos
	hlrz tt,a
	movem tt,vpos
wipe1:	move b,ttyopt
	tlne b,%toovr		   ;can't over-strike?  Can erase that way!
	tlne b,%TOERS		   ;skip if can't erase
	  jrst [move t,hpos	   ;  get the current horizontal position
	        subi t,(d)	   ;  get our desired horizontal position
		skipge t	   ;  paranoid.
		  setz t,	   ;    substitute 0 for negatives
		movei t,10(t)	   ;  allow for ^P code strangeness
		tyo dspc,[^P]	   ;  move to the calculated position
		tyo dspc,["H]
		tyo dspc,t
		tyo dspc,[^P]	   ;  and clear the rest of the line
		tyo dspc,["L]
		jrst enmass]
	tlnn b,%tomvb		   ;if this TTY can't backspace directly
	  jrst [push sp,bp
	        ldb b,bp	   ;  we can't erase, so, we
		decbp bp	   ;  decrement our temporary bp
		tyo tyoc,b	   ;  echo deleted char (crude, but effective)
		pop sp,bp
		jrst gobk]	   ;and return
	caig d,			   ;if it's non-positive
	  jrst enmass		   ;  don't hack any more!
	move b,d		   ;copy the counter
	tyo tyoc,[^H]		   ;backspace
	sojg b,.-1		   ;Do it that many times
	move b,d		   ;copy the counter
	tyo tyoc,["/]		   ;wipe it out
	sojg b,.-1		   ;do it that many times
	move b,d		   ;copy the counter
	tyo tyoc,[^H]		   ;and back over it
	sojg b,.-1		   ;do it that many times
	setom lfflag		   ;and note to LF when we get real char.
	caia			   ;done with this loop
gobk:	sojg d,wipe1		   ;loop for each character.
enmass:	setzm jlflag		   ;we didn't just LF
	restore [b,tt,t]
	pop sp,d
	ret			   ;return to caller



;; This copies our JCL to the JCL buffer, so that it is word-aligned etc.

jclcop:	move t,[440700,,jclbuf]
	move bp,argptr		   ;get BP to start
	move ct,argcnt		   ;Get # of characters of JCL
	movem ct,jclct		   ; Remember how much JCL we got
jclco1:	ildb ch,bp		   ;get character
	idpb ch,t		   ;put the character
	sojg ct,jclco1		   ;try again, maybe
	movei ch,^M		   ; End with CRLF
	idpb ch,t
	movei ch,^J
	idpb ch,^M
	setz ch,		   ;padd with nulls
	movei ct,10		   ;bunches of spaces
jclco2:	idpb ch,t		   ;putting it in !
	sojg ct,jclco2		   ;and do another
	ret

;;;; Here goes the error recovery system.

loserr:	movem x,ac.x
	move x,[440700,,[asciz /Miscellaneous error/]]
	movem x,errmsg
	jrst errput		   ;and do the rest of the error stuff

errmng:	movem x,erracs		   ;save X for analysys
	hrrz x,suuo		   ;grab the error message
	hrli x,440700		   ;make a byte pointer to it for .MAIL
	movem x,errmsg		   ;save the error message!
errput:	move tt,ac.tt		   ;recover the already saved AC
	move x,[1,,erracs+1]	   ;and use it to BLT the rest of the AC's to
	blt x,erracs+17		   ; saftey
errmn1:	move x,calerr		   ;collect the system error code
	movem x,baderr		   ;and save it for posterity
	move t,suuoh		   ;get address of error
	movem t,erradr		   ;save address of error

	move x,errdat		   ;collect various data
	.suset x
	syscal status,[ebchn	   ;get the I/O status for bad channel
		val ebsts]
	  jfcl			   ;  Fie!

	syscal open,[cnti .uio	   ;image output dump file
		argi dsko
		[sixbit /DSK/]
ife $$PAND,	[sixbit /PWORD/]
.else		[sixbit /PANDA/]
		[sixbit />/]
		dbgdir]		   ;in case we don't want it to go there
	  quit
	move t,[444400,,0]	   ;pointer to impure
	movei tt,<<<impend+1777>/2000>*2000>  ;write full pages!
	syscal siot,[argi dsko ? t ? tt]  ;write it out!
	  jfcl			   ;  eh?
	.close dsko,		   ;close it off

	type dspc,/AInternal Error:  /
	output tyoc,@errmsg
	type dspc,/APlease do :BUG PWORD <description of the problem> ^C
/

	skipn debug
	  .mail bugmal		   ;mail the info

pdlfix:	syscal delewo,[argi dsko]  ;flush the output file
	  jfcl			   ;  ignore any errors, probably closed
quit=jrst pdlfix
	.close dsko,
	move sp,[-pdllen,,pdl]	   ;flush the stack out
	syscal unlock,[argi %jself]  ;unlock our locks!
	  .lose %lssys
	setzm infp		   ;note we aren't in inferior anymore
	.status usrc,t		   ;is there an inferior?
	skipe t			   ;is it there?
	  .uclose usrc,		   ;  kill it
	setzm lfflag		   ;clear rubout-controling flags
	setzm jlflag
	setzm ttyflg
	setzm siotct		   ;we aren't in the middle of output
	setzm newflg		   ;clear out flag for PWDCHG
	setom ttyprp		   ;default PRINTF to TTY output
	setzm morflg		   ;turn of --MORE-- flag
	setzm mdlflg		   ;we aren't hacking MUDDLE !!
	setzm tyiflg		   ;normal mode of TYI
	setzm dsprmp		   ;Don't do anything special for prompting
ifn $$PAND,	setzm nodate
	.iopdl			   ;reset the I/O PDL
	move t,errclr		   ;clear various things
	.suset t
	skipn deathp
	jrst rdloop		   ;and back to hacking!
	.logout 1,

.upure

ifn $$PAND,[
rdxarg:	0			   ; Arg for cleanup handler
rdxbp:	0			   ; BP to use for cleanup handler
rdxct:	0			   ; Item to be XCT'd to clean up
]; end of IFN $$PAND,

errmsg:	0			   ;saved error message
errbuf:	block 40
.pure
;;; Error Clear table
errclr:	-errcln,,errctb		   ;AOBJN ptr to stuf to reset on error
errctb:	.spirqc,,[0]		   ;no interrupts
	.sifpir,,[0]
	.sdf1,,[0]		   ;un-defer things
	.sdf2,,[0]
	.smsk2,,[<1_tyic>\<1_tyoc>\<1_dspc>\<1_tlnc>]  ;turn interrupts back on
errcln==.-errctb		   ;ERRCLN is lenght of ERRCTB

errdat:	-sstlng,,ssttab		   ;AOBJN ptr to lots of info
ssttab:	.rbchn,,ebchn		   ;collect the bad channel
	.rmpva,,empva		   ;when we get around to catching MPV's
	.ruind,,euind		   ;get user index, for identification if we
				   ;get it before it is killed!
	.runame,,euname		   ;get worthless data, usually
	.rjname,,ejname
	.rtty,,etty
	.rpirqc,,epirqc		   ;interrupts?
	.rifpir,,eifpir		   ;How do you expect me to get any work done
				   ;with all these interruptions?
	.rcnsl,,ecnsl		   ;what TTY ....
	.rsv40,,esv40
	.samsk2,,[<1_tyic>\<1_tyoc>\<1_dspc>\<1_tlnc>]	;turn off random ints.
sstlng==.-ssttab

	
dskerr:	movem x,erracs		   ;save X for analysys
	move x,[1,,erracs+1]	   ;and use it to BLT the rest of the AC's to
	blt x,erracs+17		   ;safty
	move x,calerr		   ;gotta salvage the error now!  PRINTF will
	movem x,baderr		   ;clober it if we don't
	syscal open,[cnti .uai	   ;open the ERR device
		argi dski
		[sixbit /ERR/]
		argi 4		   ;2nd file name is the error code
		baderr]
	  .lose %lsfil
	call printf		   ;print the error message

	move a,baderr		   ;get the error #
	movem a,calerr		   ;move it back to CALERR so main error
				   ;handler can find it
	movei tt,1		   ;set up to shift one bit into position
	setz t,			   ;T get's shifted into
	lshc tt,(a)		   ;shift it
	tdnn t,dskbd0		   ;Is this safely ignorable?
	  tdne tt,dskbd1
	    quit		   ;  ignore it, back to work.
	errdmp 4,[asciz /Couldn't open file./]	;AC's have been saved

;;; OPEN errors to simply quit on, #'s 0-43
; %EFLDR -- Directory full
; %EFLDV -- Device full

dskbd0:	irp x,,[%EFLDR,%EFLDV]
<1_x>\termin

;;; OPEN errors to simply quit on, #'s 44-107

dskbd1:	irp x,,[0]
<1_<x-44>>\termin 
	0



;;; failure in an open, not bug.

opfail:	push sp,calerr		   ;save the error code
				   ;we have the block containing the error
				   ;file
	terpri
	move d,[440700,,DSKBUF]	   ;use DSKBUF, since we don't need it yet
	hrr b,suuo		   ;get the fileblock
	call rfn"pfn		   ;Make it printable
	output tyoc,dskbuf
	type dspc,/ -- /

	syscal open,[cnti .uai	   ;open the ERR device
		argi dski
		[sixbit /ERR/]
		argi 4		   ;FN2 is error return from .CALL
		(sp)]		   ;(standard call error)
	  loss

	call printf		   ;print the error message
	quit			   ;and quit


SUBTTL	System Utility Routines

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                         ;;;
;;;                 Here go the system utility routines			    ;;;
;;;									    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; find the entry, and get the group

grplsr:	movei a,lsrc		   ;tell LSRTNS what channel it can hack
	move b,uname		   ;ask about this UNAME
	call lsrtns"lsrunm	   ;is it there?
	  ret			   ;  nope, fail
	movem b,lsrptr		   ;save pointer to this entry
	movei a,lsrtns"i$grp	   ;find his group
	call lsrtns"lsritm
	  jrst [movei ch,40	   ;  nothing there, a space will do
	        jrst popj1]	   ;  and consider it successful

	ildb ch,a		   ;check it out
	cain ch,0		   ;is it null?
	  jrst [movei ch,40	   ;  yes, use space instead
	        jrst popj1]	   ;  and consider that a success

	upper ch		   ;uppercasify
	jrst popj1

;;; map in the INQUIR database
maplsr:	save [a,b]
	movei a,lsrc		   ;A <- channel for LSRTNS
	move b,[-lsrpgc,,lsrpag]   ;AOBJN ptr to pages for LSRTNS
	call lsrtns"lsrmap	   ;map in the INQUIR database
	  error /Failure to map in INQUIRE database!/
	restore [b,a]
	ret

unmapl:	move b,[-lsrpgc,,lsrpag]   ; AOBJN ptr to pages LSRTNS uses
	syscal CORBLK,[ argi 0	   ; DELETE!
			argi %jself  ; our own pages
			b]	   ; all that LSRTNS used
	  loss			   ;   huh?  Won't let me give away pages??????
	.close lsrc,		   ; don't need it any more
	ret

;;; A routine to read a person's human name from INQUIR and ask if it's him
;;; clobbers A, B, and others.  Takes a Byte Pointer to a working area in BP

asknam:	movei a,lsrtns"i$name	   ;find his name
	call lsrtns"lsritm
	  jrst [type dspc,/AThere is a problem with that name's INQUIR entry.
/
		ret]
	move b,bp		   ;Byte Pointer to our storage area
	call lsrtns"lsrnam	   ;get his name in human-readable form
	  jfcl			   ;  eh?

asknm2:	setom gotinq
	type dspc,/AAre you /	   ;ask him
	outstr tyoc,bp
	decbp b			   ;it advances it a character
	move bp,b		   ;and get pointer to the end
	type tyoc,/?  (Y or N) /   ;ask
	.reset tyic,		   ;throw away type ahead.
	tyi
	  ret			   ;  he quit, take it as NO
	  jrst asknm2		   ;  ask him again
	  jfcl
	caie ch,"Y		   ;is it Y
	  cain ch,"y		   ;  or y ?
	    caia		   ;    yes, don't
	      jrst [type tyoc,/No.
That login name is already in use!  Please choose another name and try again!
/
		    ret]	   ;	   just give up
	type tyoc,/Yes./
	movei ch,^M		   ;CRLF
	idpb ch,b
	movei ch,^J
	idpb ch,b
	move bp,b		   ;get our final byte pointer
	jrst popj1		   ;yep, that's the one!

;;; table of devices to use .IOT on
iottab:	irp dev,,[NUL,MT0]
	sixbit /dev/
	termin
iotlen==.-iottab

prtopn:	save [TT,T]
	move t,1(b)

	move tt,2(b)
	camn t,[sixbit /..NEW./]
	  came tt,[sixbit /(udir)/]
	    caia		   ;    Not trying to create directory
	      jrst [type dspc,/AIllegal file name
/
		    ret]

	movsi tt,-iotlen	   ;AOBJN ptr to table of bad devices
	movei x,.bai		   ;assume we must use .BAI
	move t,(b)		   ;get the DEV of the file
prtdv1:	camn t,iottab(tt)	   ;is it one of those damned losers?
	  jrst prtdv2		   ;  continue
	aobjn tt,prtdv1		   ;try next one
	movei x,.uai		   ;WIN, we can SIOT
prtdv2:	restore [T,TT]
	syscal open,[argi dski ? cnt x	;open in whichever mode
	       (b)
	       1(b)
	       2(b)
	       3(b)]
	  ret
	jrst popj1

;;; routine to open .uao output file on DSKO.  It takes the directory in B
;;; it returns the file-block pointer in B

opnout:	movem b,fo.snm		   ;fill in the blanks for directory
	movei b,outnam		   ;point to file block
	syscal open,[cnti .uao	   ;open it
	       argi dsko
	       (b)
	       1(b)
	       2(b)
	       3(b)]
	  filoss (b)		   ;  lost!
	ret

;;; fill in the FN2 and open a file.  Skips if successful.
;;; takes fileblock pointer in B.  Takes FN2 as argument in T

fn2opn: movem t,2(b)
	.call uaiopn
	  ret
	jrst popj1

;;; similar, but for filling in the FN1
fn1opn: movem t,1(b)
	.call uaiopn
	  ret
	jrst popj1

;;; rename file open on DSKO according to filename block pointed to by B
;;; then close the file
rnmfn2:	movem t,2(b)
rnmcls:	syscal renmwo,[argi dsko
	       1(b)
	       2(b)]
	  filoss (b)
	.close dsko,
	ret


;;; Routine to print, given an input file is already open in either .UII or 
;;; .UAI on the DSKI channel (now .BAI too)  COPYF entry is for copying to DSKO
;;; instead.


copyf:	setzm ttyprp		   ;note output not to TTY
printf:	syscal rfname,[argi dski ? val x ? val x ? val x ? val x  ;ignore names
	       val prmode]	   ;but get that mode
	  error /RFNAME failed in PRINTF/
	move t,prmode
	move tt,[440700,,dskbuf]   ;byte pointer to handle .UAI files
	movei x,buflen*5	   ;bytes buffer will hold for .UAI files
	movei a,1		   ;conversion factor for .UAI to .UAO
	cain t,.bai		   ;is it .BAI?
	  jrst prtbai		   ;  yes, use what we have
	cain t,.uii		   ;is it .UII?
	  do [move tt,[444400,,dskbuf]  ;word at a time instead!
	      movei x,buflen	   ;	  buffer capacity in words instead
	      movei a,5		   ;	  to convert .UII to .UAO
][
	      caie t,.uai	   ;      else, is it .UAI ?
		error /PRINTF called with illegal mode/
]
prtbai:	hrr tt,iobuf
	movem tt,dskbp		   ;this is our byte pointer
	movem x,pbufl		   ;this is the length of our buffer
	movem a,pbtsiz		   ;this is the # of chars per input byte

morcop:	skipe ttyflg		   ;if we have turnned of the TTY,
	  jrst [ .close dski,	   ;   then we don't need the channel
		 ret]		   ;   cause we're all done printing
	move t,dskbp		   ;get our byte pointer
	move tt,pbufl		   ;and our buffer size
	call dvsiot		   ;reaad from any device
	  jrst [syscal close,[argi dski]
		  jfcl
		setom ttyprp
		ret]
	movem t,foobp		   ;foo byte pointer
	move t,pbufl		   ;lets figure out how many were moved
	sub t,tt		   ;look MA, no random +1 or -1 's!  (ITS WINS)
	imul t,pbtsiz		   ;and be sure we have it in characters,~words
	movem t,siotct		   ;move these out to storage so we can win on
	movem t,remain		   ;save for later testing
	caige t,buflen*5	   ;if not the whole thing
	  call c.cadj		   ;  adjust for TECO cretinism

	move t,[440700,,dskbuf]	   ;get another copy of our byte pointer
	hrr t,iobuf
	skipe ttyprp		   ;are we writing to the TTY?
	  do [syscal siot,[argi tyoc  ;type it
		     t
		     siotct]
		loss		   ;    Eh?
][				   ;ELSE
	      move x,remain	   ;get the count from remain, since SIOTCT is
	      syscal siot,[argi dsko  ;subject to reseting at ^S int level
		     t ? x]
		loss]

	move t,remain
	cain t,buflen*5		   ;zero?  Are we really done?
	  jrst morcop		   ; nope, copy some more
	.close dski,		   ;make sure it get's closed
	  skip			   ;ignore
	setom ttyprp		   ;note that we're writing to TTY: usually
	ret

;;; read from any device on DSKI, with BP in T and count in TT
dvsiot:	move x,prmode		   ;look at our mode.
	caie x,.bai		   ;can we SIOT?
	  jrst [syscal siot,[argi dski  ;yes, thank the lord
		       t
		       tt]
		  ret		   ;lost, don't skip return
		jrst popj1]	   ;won, skip return
dvsio3: movsi x,-buflen
	hrr x,iobuf		   ;cons up an AOBJN PTR to use
	.iot dski,x		   ;read it in
	hrr t,x			   ;fix up the byte pointer
	hlre tt,x		   ;and figure up how many characters that was
	imul tt,[-5]		   ;words -> ascii
	jrst popj1

;;; Routine for goddamn fucking TECO that doesn't set FILLEN for end of file
;;; like it ought to.  This means it writes out cretinouse ^C's at the end
;;; to pad the word!  Also, the ERR device ends off with a ^L, so we flush
;;; those too!

c.cadj:	move t,foobp		   ;get the possibly cretinouse byte pointer
	tlne t,004000		   ;is it a full-word pointer?
	  hrli t,010700		   ;  yes, make it a ascii pointer
	movei tt,5		   ;at most 5 of the losers
	setz x,			   ;count the beggars
	norm7 t			   ;back up to last one
c.caj0:	ldb ch,t		   ;get the possibly offensive character
	caie ch,^L		   ;is it a trailing ^L ?
	  cain ch,^C		   ;is it offensive?
	    caia
	      jrst [exch x,siotct  ;  nope, but maybe predecessors were
	            subm x,siotct
		    ret]	   ;  record and return
	decbp t			   ;back up!
	aos x			   ;boy is it offensive
	sojg tt,c.caj0		   ;find another?
	exch x,siotct
	subm x,siotct
	ret			   ;nope that's all

.upure	
gotinq:	0			   ; Set -1 if person applying for account has
				   ; an INQUIR entry already.
foobp:	0			   ;byte pointer to the end of the buffer
remain:	0			   ;# of bytes unused in buffer
fleng:	0			   ;length of the file
ttyflg:	0			   ;set to -1 whenever we wish to flush typeout
siotct:	0			   ;count of chars left to be typed out in this
				   ;SIOT

allflg:	0			   ;ALL option has been specified.  Used only
				   ;in among consenting adults.
nodate:	0			   ; -1 means suppress create/modify date
brfflg:	0			   ;similarly, BRFFLG is for -brief option

reread:	-1			   ;if non-negative, is character to re-read

dskbp:	0			   ;the byte pointer to use for input
prmode:	0			   ;contain's the mode this channel is open in.
ttyprp:	-1			   ;-1 means output is to TYOC, not DSKO
pbtsiz:	0			   ;the # of chars per byte.  This is used to
				   ;convert input bytes to output chars
pbufl:	0			   ;size of the buffer in current bytes

iobuf:	dskbuf			   ;buffer to use for PRINTF

dskbuf:	block buflen
	block buflen		   ;buffer for use by :SEND's

.pure

ife $$pand,[
goddt4:	movem b,linkno		   ; remember we were lunk to
	call logit		   ; unusual login, log it
goddt5:	move x,[jfcl]		   ;make it not add anything to the start adr
	movem x,lodoff
	jrst goddt1		   ;don't type anything!

goddt:	type dspc,/A[OK]
/				   ;[OK]

goddt0:	syscal ttyget,[argi tyic ? val t ? val tt ? val a]
	  loss
	tlz a,%TSSII		   ;clear out the super-image bit!
	syscal ttyset,[argi tyic ? t ? tt ? a]
	  loss
goddt1:	.suset [.smask,,[0]]	   ;turn off all interrupts, let DDT do it when
	.suset [.smsk2,,[0]]	   ;it is ready!
	move a,[400000,,[0]]	   ;turn off realtime interrupts
	.realt a,
	 jfcl
	syscal open,[cnti .uii	   ;open the file to load in DDT from
		argi lodc
		[sixbit /SYS/]
		[sixbit /ATSIGN/]
		[sixbit /DDT/]]
	  error /Can't access SYS:ATSIGN DDT, can't log you in, sorry!/
				   ;We've got it open, time to load up our AC's

; close up our channels so DDT doesn't get confused  (only the TTY channels
; should be open at this point, but just in case, close them all)

irp x,,[dspc,tyic,tyoc,lsrc,pwdc,dski,dsko,usrc]
	.close x,
termin

	setz t,			   ;clear T for offset start address
	skipe lbrief		   ;did he specify -bf ?
	  movei t,1		   ;  yes, start at even offset instead
	skipe altusw		   ;did he $U instead of :LOGIN ?
	  addi t,2		   ;yes, account for that
	addm t,lodoff		   ;so start up at our offset
	hrlzi 17,lodblk		   ;for BLT from LODBLK to AC 0
	blt 17,17		   ;move code to AC's
	jrst 1			   ;and execute it.

.upure				   ;can't be pure, since we modify LODOFF
lodblk:	jfcl
	.suset <lsuset-lodblk>	   ;flush our memory
	.CALL <lcalbk-lodblk>	   ;the SETZ of the call lives in AC 6
	.logout			   ;probably no core.  Can't do anything.
	.iot 1,1		   ;read start address
lodoff:	addi 1,1		   ;start at our special address instead
	jrst (1)		   ;and away we go!
lcalbk:	setz
	sixbit /LOAD/		   ;load
	argi %jself		   ;into self
	401000,,1		   ;from channel 1
lsuset:	.smemt,,<lmemt-lodblk>
lmemt:	4000
	0
	0
	0

.pure
]  ; END IFE $$PAND

ifn $$PAND,[

grpmal:	440700,,[asciz /ACCOUNTS-HELD-REFUSED/]
	tp$6bt runame
	0
	440700,,[asciz /New GROUP settings/]
	-1,,[440700,,usrbfr]

rmsmal:	440700,,[asciz /ACCOUNTS-HELD-REFUSED/]
	tp$6bt runame
	0
	0
	-7,,airtyp

notmal:	440700,,[asciz /ACCOUNTS-NOTIFICATION/]
	tp$6bt runame
	0
	0
	-7,,airtyp
.upure
airtyp:	0			   ; Type (SET/DELETE)
	440700,,[asciz /Was:	/]
	440700,,usrbfr		   ; State before
	440700,,[asciz /
Is:	/]
	440700,,usraft		   ; State after
	440700,,[asciz /
/]
	440700,,usrrsn		   ; Reason, if any
.pure
maldel:	move t,[440700,,[asciz /[DELETED]/]]
	move bp,[440700,,usraft]
	copy t,bp
	skipa t,[440700,,[asciz /I deleted the following account:
/]]
malset:	  move t,[440700,,[asciz /I set the following account:
/]]
	movem t,airtyp

	ldb x,[pi$sta pdinfo]	   ; Is this something RMS want to see?
	caie x,ps%hld
	  cain x,ps%rfs
	    jrst rmshak
	cain x,ps%off
	  jrst rmshak

	.mail notmal		   ;send mail on it
	ret

; filter out deletions and refuse-holds for RMS
rmshak:	.mail rmsmal
	ret

] ; END IFN $$PAND,

ml.to==0			   ;Byte pointer to TO: field
ml.frm==1			   ;Byte pointer to FROM: field
				   ;or address of 6bit word
ml.snt==2			   ;Byte pointer to SENT-BY field
				   ;or address of 6bit word
ml.sbj==3			   ;Byte pointer to SUBJECT: field
ml.txt==4			   ;AOBJN pointer to Byte pointer's to
				   ;strings to be placed in the TEXT field
;;;; MAIL forms

sndmal:	440700,,tmpbuf
	tp$6bt runame
	tp$6bt runame
	0
	-1,,[ tp$ind argptr ]

lflmal:	tp$6bt PXUNAM		   ;XUNAME, not UNAME
	440700,,[asciz /PASSWORD-SYSTEM/]
	0
	440700,,[asciz /Failed login/]
	-3,,[440700,,[asciz /Your password was given incorrectly from /]
	     440700,,hstnam	   ;site name or LOCAL or DIALUP
	     440700,,[asciz /
/]]				   ;TERPRI

bugmal:
ife $$PAND,[
	tp$ind bugnam
	440700,,[asciz /BUGGY-PWORD/]
	0			   ;no SENT-BY field
	440700,,[asciz /PWORD crash file/]
]; END IFE $$PAND
ifn $$PAND,[
	tp$ind bugnam
	440700,,[asciz /BUGGY-PWORD/]
	0			   ;no SENT-BY field
	440700,,[asciz /PANDA crash file/]
]; END IFN $$PAND
       -4,,[ 440700,,[asciz /There is a crash file to examine.
Error message:
/]
	    tp$ind errmsg   ;type the error message
	    440700,,[asciz /
Error code:  /]
	    tp$oct calerr]
ife $$PAND,[

aplmal:	440700,,[asciz /USER-ACCOUNTS-ARCHIVE/]
	440700,,[asciz /PASSWORD-SYSTEM/]
	0
	0
	-6,,[ 440700,,[asciz /Uname:  /]
	      tp$6bt uname
	      440700,,[asciz /
/]
	      440700,,msgbuf
	      440700,,[asciz /
/]
	      tp$ind uinfo]

telmal:	440700,,[asciz /ACCOUNTS-NOTIFICATION/]
	tp$6bt uname
	tp$ind namloc		   ;who it's from is put here
	-2,,[440700,,[asciz /Application from TTY /] ? tp$oct consol]
	-3,,[ 440700,,msgbuf ? 440700,,[asciz /
/]
 	      tp$ind uinfo]
] ; END IFE $$PAND,

mailit:	push sp,uuoh		   ;save where we came from!
	push sp,b		   ;need this AC
	move b,fm.snm		   ;open an output file on the mail directory
	call opnout
	move t,uuo		   ;get the address to find these frobs in!
;	skipe dm.flg		   ;is this on DM?
;				   ; DM runs a winning mailer now.
;	  jrst comsys		   ;  write for losing mailer

;;; how to mail on winning system

comsat:	type dsko,/FROM-JOB:/
ifn $$PAND,[type dsko,/PANDA
TO:(/]
.else [type dsko,/PWORD
TO:(/]
	typout dsko,ml.to(t)

ife $$pand,[
	hrrzs t			   ; flush the op-code part
	cain t,telmal		   ; Is this notification mail?
	  jrst [ 
	       type dsko,/ MIT-/
	       6type dsko,machin   ; tell where to send it
	       type dsko,/ (R-HEADER-FORCE NULL)/  ; force into RFC733 format
	       jrst .+1]
]; END IFE $$PAND,

	type dsko,/)
SENT-BY:/
	typout dsko,ml.frm(t)
	skipn ml.snt(t)		   ;sent-by field?
	  jrst comst1		   ;  null, don't write it, COMSAT loses
	type dsko,/
CLAIMED-FROM:/
	skipn ml.snt(t)		   ;nothing there?
	  typout dsko,ml.frm(t)	   ;  substitute the FROM field
	skipe ml.snt(t)
	  typout dsko,ml.snt(t)	   ;  something there, use it!

comst1:	skipn ml.sbj(t)		   ;subject field?
	  jrst comst2		   ;  null, don't write it
	type dsko,/
SUBJECT:/

comst2:	typout dsko,ml.sbj(t)
	type dsko,/
TEXT;-1
/

ife $$pand,	cain t,telmal	   ; Is this TELMAL?
ife $$pand,	  call fakhed	   ;   yes, fake a header

	typout dsko,ml.txt(t)	   ;type out all the text frobs
	movei b,mlmnam		   ;rename to the mail filenames
	call rnmcls
	pop sp,b		   ;restore AC
	pop sp,uuoh
	jrst uuoret		   ;and return!

fakhed:	type dsko,/Date: /
	call datime"timget	   ; get the time
	push sp,d
	move d,[440700,,dskbuf]	   ; get a place to copy the time
	call datime"timexp	   ; get the time as "7 AUG 1976 0831-EST"
	output dsko,dskbuf	   ; send it out
	outstr dsko,d		   ; send out the -EST too!  (DATIME bug?)
	pop sp,d
	type dsko,/
From: /				   ; now for the FROM: field
	move tt,ml.snt(t)
	call malqck		   ; check for need of " quoting
	  jrst [ tyo dsko,[""]	   ;   quote the insides
		 setom mdlflg
		 typout dsko,ml.snt(t)	; should muddle-quote with right char 
		 setzm mdlflg
		 tyo dsko,[""]
		 jrst .+2]
	  typout dsko,ml.snt(t)	   ;   no quoting needed, just send it
	type dsko,/ </		   ; end of name
	setom mdlflg
	typout dsko,[tp$6bt uname]  ; tell the UNAME involved
	setzm mdlflg
	type dsko,/ at MIT-/
	6type dsko,machin	   ; tell where
	type dsko,/>
To: USER-ACCOUNTS at MIT-/
	6type dsko,machin 	   ; tell where
	type dsko,/
/
	ret

malqck:	push sp,ch
malqk0:	hlrz ch,tt		   ; get the LH
	andi ch,777740		   ; eliminate the indirection and indexing
	cain ch,tp$ind		   ; is it an indirect frob?
	  jrst [ move tt,@tt	   ;   get what it points to
		 jrst malqk0]	   ; and start from scratch
	cail ch,450000		   ; is it a byte pointer?
	  jrst [ pop sp,ch ? ret]  ;   no, assume it's OK (punt!)
malqk1:	ildb ch,tt
	caie ch,",
	  cain ch,""
	    jrst [ pop sp,ch ? ret]
	caie ch,"<
	  cain ch,">
	    jrst [ pop sp,ch ? ret]
	cain ch,"\
	  jrst [ pop sp,ch ? ret]
	caie ch,^C		   ; end of the string?
	  cain ch,0
	    jrst [ pop sp,ch ? jrst popj1]  ; we made it, no quotes needed
	jrst malqk1

comsys:	setzm mdlflg		   ;hack muddle strings
	type dsko,/"TO" ("/
	setom mdlflg		   ;hack muddle strings
	typout dsko,ml.to(t)
	setzm mdlflg		   ;don't hack muddle strings
	type dsko,/")
/
	skipn ml.snt(t)		   ;is there a claimed-from?
	  jrst comsnd		   ;  no, just hack the sender field
	type dsko,/"SENDER" "/
	setom mdlflg		   ;hack muddle strings
	typout dsko,ml.snt(t)
	setzm mdlflg		   ;don't hack muddle strings
	type dsko,/"
/
comsnd:	type dsko,/"FROM" "/
	setom mdlflg		   ;hack muddle strings
	typout dsko,ml.frm(t)
	setzm mdlflg		   ;don't hack muddle strings
	type dsko,/"
"SCHEDULE" ("SENDING")
/
	skipn ml.sbj(t)		   ;is there a subject field?
	  jrst csytxt		   ;  No, just go hack the text!
	type dsko,/"SUBJECT" "/
	setom mdlflg		   ;hack muddle strings
	typout dsko,ml.sbj(t)
	setzm mdlflg
	type dsko,/"
/
csytxt:	setzm mdlflg		   ;don't hack muddle strings
	type dsko,/"TEXT" "/
	setom mdlflg		   ;hack muddle strings
	typout dsko,ml.txt(t)
	setzm mdlflg		   ;don't hack muddle strings
	type dsko,/"/
	movei b,mlmnam		   ;rename to the mail filenames
	call rnmcls
	restore [b,uuoh]	   ;restore the world so we can go back
	jrst uuoret		   ;and return

crlf:	skipe ttyflg		   ;is TTY off?
	  ret			   ;  yes, don't do it!
	tyo dspc,[^P]		   ;type a ^PA ala DDT
	tyo dspc,["A]
	ret

terpri=call crlf

;;;; GINIT does basic initialization, opening the TTY, etc.
;;;; GINIT1 is the subset of GINIT that initializes interrupts and essential
;;;; variables that are needed before the TTY is opened even.
;;;; GINIT2 opens the TTY and initializes TTYSTS and TTYST1 and TTYST2
;;;; and the password database

ginit:	skipe startd		   ;has it been started already?
	  ret			   ;  yes, don't bother
	call ginit1
	  loss			   ;it lost somehow
	call ginit3
	ret

ginit1:	.suset [.soption,,[<%opopc\%opint\%oplok\%oplkf>,,0]]  ;set up winnage.
	.suset [.s40addr,,[suuo]]  ;where we handle system UUO's and ints
	.suset [.smask,,[	   ;enable interrupts
%pidwn\%pidbg\%pimpv\%pipdl\%pirlt\%piioc\%piltp\%picli\%piwro\%pioob\%piilo\%pidis]]
	.suset [.smsk2,,[<1_tyic>\<1_tyoc>\<1_dspc>\<1_tlnc>]]
	.suset [.rcnsl,,consol]	   ;get the console number
	move b,consol
	syscal cnsget,[argi %jsnum(b)  ;collect info on our TTY
		       val vsize
		       val hsize
		       val nul
		       val ttycom
		       val ttyopt
		       val TTYTYP]
	  ret			   ;  lost, don't skip

	setzm sailp		   ; Clear these flags, in case they were
	setzm hfdupf		   ; set by PURIFY$G
	move x,ttyopt		   ;check this TTY out
	tlne x,%tosai		   ; does this TTY know about sail characters?
	  setom sailp		   ;   yes, so echo contols right
	tlne x,%tohdx		   ;is this TTY a loser?
	  setom hfdupf		   ;  yep, note the fact!
	tlne x,%tomvb		   ;can it backspace directly?
	  setom bsflag		   ;  note the fact for losers (see ECHO)
	call bltspc		   ;Set up appropriate file specs.
	jrst popj1		   ;Win away...

;;; BLTSPC - blt in the correct file specs for this machine.
;;; Returns if won.

bltspc:	syscal sstatu,[val x ? val x ? val x ? val x ? val x
	       val machin]	   ;get the machine name
	  loss
	move x,machin		   ;get it in an AC
	came x,[sixbit /MX/]
	camn x,[sixbit /MC/]	   ;is it MC?
	  jrst [move x,[mcspec,,tsspec]	 ;yes, so use MC's specs
	        blt x,spcend-1
		ret ]
	camn x,[sixbit /ML/]	   ;is it ML?
	  jrst [move x,[mlspec,,tsspec]	 ;yes, so use ML's specs
	        blt x,spcend-1	   ;  all of them, to the end
		ret ]
	camn x,[sixbit /AI/]	   ;is it AI?
	  jrst [move x,[aispec,,tsspec]	 ;yes, so use AI's specs
	        blt x,spcend-1	   ;  all of them, to the end
		ret ]
	camn x,[sixbit /MD/]	   ;is it MD?
	  jrst [move x,[mdspec,,tsspec]	 ;yes, so use MD's specs
	        blt x,spcend-1	   ;  all of them, to the end
		ret ]
	camn x,[sixbit /DM/]	   ;DM-P?
	  jrst [move x,[dmspec,,tsspec]	 ;yes, use DM's specs
	       blt x,spcend-1	   ;  all of them to the bitter end
	       setom dm.flg
	       ret ]
	.lose		           ; Unknown machine!


.upure
ginitd:	0			   ; -1 means we've done GINIT2 before
.pure

ginit2:	skipe ginitd		   ; Have we already initialized ourself?
	  ret			   ;   Yes, go no further
	call ginit3

	movei a,hstpag
	movei b,hstc
	call netwrk"hstmap
IFN $$PAND,[	  error /Can't map host table!/
]
.ELSE	jfcl
IFE $$PAND,[
	move a,[netwrk"nw%arp]
	call netwrk"ownhst
	  jfcl
	movem a,lclsit
]; End of IFE $$PAND,
	call pwdmap		   ; Map in the password database
	setom ginitd		   ; note we're initialized
	ret

ginit3:	syscal open,[cnti .uai
		argi tyic
		[sixbit /TTY/]]
	  loss

	.suset [.runame,,RUNAME]   ;get our UNAME

	syscal ttyget,[argi tyic ? val x ? val x ? val t]
	  loss
	skipe sailp		   ; if terminal can handle it
	  tlo t,%tssai		   ; we want SAIL mode available

	.suset [.rsuppro,,tt]
;	caig tt,0		   ;are we top level?
;				   ;don't use super-image just now, MRC gripes.
;	  tlo t,%tssii		   ;  turn on super-image input
	syscal ttyset,[argi tyic
			[020202,,020202]
			[030202,,020202]
			t]
	  loss


				   ;display channel
	syscal open,[cnti .uao\%TJDIS
		argi dspc
		[sixbit /TTY/]]
	  loss
				   ;ordinary TTY output channel
	syscal open,[cnti .uao
		argi tyoc
		[sixbit /TTY/]]
	  loss

	setom startd		   ;note that we've run the initialization

	syscal open,[cnti .uii	   ;does the .TEMP.; directory exist?
	       argi dski
	       [sixbit /DSK/]
	       [sixbit /.FILE./]
	       [sixbit /(DIR)/]
	       [sixbit /.TEMP./]]
	  do [move x,[sixbit /COMMON/]  ;  no .TEMP. directory
	        movem x,cladir]	   ;	     so must be COMMON instead
	.close dski,
	ret

.even=<.+1>/2*2
loc .even

iuname:	0			   ;UNAME of person purifying
ifn $$pand,[
spword:	707644,,721261		   ;6/7/85 for new KS10 ITS machines.
]				   ;MX => 225747,,366135 (prev 320744,,541326)

constants


purify:	move sp,[-pdllen,,pdl]
	call ginit		   ;init
	setzm startd		   ;we haven't started, really
	syscal corblk,[cnti %cbndw\%cbndr  ;get a new page
	       argi 0		   ;no superfluous XORING, please!
	       argi %jself
	       argi tmpag1	   ;moby page
	       argi %jsnew]
	  .lose 1400
	move t,[<<iuname/2000>*2000>,,tmpag1*2000]
	blt t,<tmpag1*2000>+1777	   ;copy the page
	syscal corblk,[cnti %cbndw\%cbndr  ;move it into old location
		       argi 0	   ;no superfluous XORING, please!
		       argi %jself
		       argi iuname/2000	;home, sweet home
		       argi %jself
		       argi tmpag1]
	  .lose 1400
	syscal corblk,[cnti 0	   ;delete!
		       argi 0
		       argi %jself
		       argi tmpag1]
	  .lose 1400
	.suset [.runame,,iuname]   ;remember this
	move x,iuname		   ;remember in the impure for crash dumps
	movem x,puname
ifn $$pand,[
	type dspc,/AThis is PANDA, not PWORD.
Do not install as SYS:ATSIGN HACTRN!!
/
]
	move t,[-<<<corend+1777>/2000>-.purpg>,,.purpg]
	syscal corblk,[cnti %cbndr
		argi 0
		argi %jself
		t]
	  .lose 1400
	type dspc,/APurified.
/
puree:	.break 16,100000	   ;return
	jrst puree


;;; DBGHAK - Routine to read in a crash file and anylize a bit.


dbghak:	skipn startd		   ;has this been started before?
	  move sp,[-pdllen,,pdl]   ;use the main pdl for now
	skipe goodf		   ;if we have already allocated good and bad
	  jrst [call goodsw	   ;  get good context back again
	        jrst dbghk1]	   ;  don't do it again!

	move t,[-4,,goodpg]	   ;move our own low impure for safekeeping
	setz tt,		   ;starts in page 0
	setom goodf		   ;note that this set is our "GOOD" set
	syscal corblk,[cnti %cbndw\%cbndr
		       argi 0
		       argi %jself
		       t
		       argi %jself
		       tt]
	  .lose %lssys
	move t,[-4,,badpag]
	syscal corblk,[cnti %cbndw\%cbndr  ;get pages for bad data
		      argi 0
		      argi %jself
		      t
		      argi %jsnew]
	  .lose %lssys

dbghk1:	syscal corblk,[cnti %cbndw\%cbndr  ;RW page for PDL
		      argi 0
		      argi %jself
		      argi dpdlpg
		      argi %jsnew]
	  .lose 1400
	move sp,[-400,,dpdl]	   ;get debug pdl ptr
	call ginit		   ;initialize the universe

	syscal open,[cnti .uii	   ;access the file
		     argi dski
		     [sixbit /DSK/]
		     dbgfn1
		     dbgfn2
		     dbgdir]
	  .lose %lsfil

	move t,[444400,,badloc]	   ;load file into our new BAD pages!
	movei tt,10000 		   ;4 blocks of cruft
	syscal siot,[argi dski ? t ? tt]  ;move it in
	  .lose 1400		   ;  old CALERR is saved in BADERR
	.close dski,		   ;close up
	move t,badloc+vrsadr	   ;get the source filenames to compare
	move tt,badloc+vrsadr+1	   ;so we can see if we have the same one
	camn t,[.fnam1]		   ;same first name?
	  came tt,[.fnam2]	   ;  and second name?
	    jrst [type dspc,/AWrong version:
Bug file -->  /  ;  nope!
		  6type tyoc,t	   ;type FN1 of loser
		  .iot tyoc,[40]   ;space
		  6type tyoc,tt	   ;type FN2 of loser
		  type tyoc,/
Current version --> /
		  6type tyoc,[.fnam1]
		  .iot tyoc,[40]   ;space
		  6type tyoc,[.fnam2]
		  call badsw	   ;revert to bad context
		  .lose]
	type dspc,/AUNAME = /
	6type tyoc,badloc+runame
	skipe badloc+baderr	   ;if there was an .CALL error returned
	  do [	type dspc,/AError code = /
	        8type tyoc,badloc+baderr]

	type dspc,/ALast error message was:
/
	output tyoc,@badloc+errmsg

	call badsw		   ;revert to bad context
	.break 16,100000	   ;and return to superior

;;; routine to switch context to good (our own) pages

goodsw:	push sp,t		   ;save AC's, we need all the flexibility we
	push sp,tt		   ;can get when hacking low impure
	move t,[-4,,0]		   ;AOBJN ptr to low impure data
	movei tt,goodpg		   ;page goodpg is our good (own) data pages
	syscal corblk,[cnti %cbndw\%cbndr
		       argi 0
		       argi %jself
		       t	   ;AOBJN ptr to low impure
		       argi %jself
		       tt]	   ;source of good data
	  .lose %lssys
	pop sp,tt
	pop sp,t
	ret

;;; routine to switch context to bad (from crash file) pages

badsw:	push sp,t		   ;save AC's, we need all the flexibility we
	push sp,tt		   ;can get when hacking low impure
	move t,[-4,,0]		   ;AOBJN ptr to low impure data
	movei tt,badpag		   ;page badpag is our good (own) data pages
	syscal corblk,[cnti %cbndw\%cbndr
		       argi 0
		       argi %jself
		       t	   ;AOBJN ptr to low impure
		       argi %jself
		       tt]	   ;source of bad data
	  .lose %lssys
	pop sp,tt
	pop sp,t
	ret

;;; routine to print as half-words.  Expects one arg on the stack.
printh: move x,-1(sp)		   ;get argument
	hlrz x,x		   ;isolate left half
	8type tyoc,x		   ;type it
	type tyoc,/,,/		   ;separate it
	move x,-1(sp)		   ;get argument
	hrrz x,x		   ;isolate right half
	8type tyoc,x		   ;type it
	ret


ifn $$pand,[

;;; CLOBBR - Initialize a new database.
;;;
;;; This can be hand-called from DDT to make a new database.
;;; Note: The file is written into your current SNAME

pwflen==15.			   ;Length in pages of PWORD file.

clobbr:	move sp,[-pdllen,,pdl]	   ;Initialize pdl.
	;; First, make empty password database pages exist.
	move a,[-pwflen,,pwpage]
	syscal CORBLK,[	argi %cbndr+%cbndw ? argi %jself ? a ? argi %jsnew ]
	 .lose %lsfil
	setzm pwfile
	move x,[pwfile,,pwfile+1]
	blt x,pwfile+<2000*pwflen>-1
	;; Then fill in default values for the database.
	setzm pwcnt		   ;Init user count.
	setom atoapl		   ;Init allow applications.
	setom pwordt		   ;Init no date override.
	setom pwordt+1
	setom pwordt+2
	setom pwinit		   ;Init database locks
	setom pwdone
	setzm pwrbfp		   ;Init Bp.
	setom pwgrdm		   ;Init group restrictions.
	move x,[pwgrdm,,pwgrdm+1]
	blt x,pwgors-1
	;; Now create default groups.
..foo==0
irp gr,,[USER,DAY,DIAL,TURIST,GRP.04,GRP.05,GRP.06,GRP.07,GRP.08,GRP.09,GRP.10,GRP.11,GRP.12,GRP.13,GRP.14,GRP.15] 
	move x,[sixbit /GR/]
	movem x,pwgnam+..foo
  ..foo==..foo+1
TERMIN
	.suset [.runame,,pwuhak]   ;Note database user.
	.suset [.rjname,,pwjhak]
	;; Now we're gonna write the database out to disk.
	call bltspc		   ;Now set up appropriate file specs.
	syscal OPEN,[cnti .uio ? argi pwdc ? pw.dev ? pw.fn1 ? pw.fn2 ]
	 .lose %lsfil
	move t,[444400,,pwfile]
	movei tt,<2000*pwflen>
	syscal SIOT,[ argi pwdc ? t ? tt]
	  .lose %lsfil
	.close pwdc,
clobr9:	.logout	1,		   ;All done.

];$$pand



;;; Per machine specifications end up here
.upure
tsspec::			   ;table specifiying way this machine likes em
spec:
pwfnam::
pw.dev:	0
pw.fn1:	0
pw.fn2:	0
pw.snm:	0

;;; filename block for mail files
mlmnam::
fm.dev:	0
fm.fn1:	0
fm.fn2:	0
fm.snm: 0

bugnam:	0

spcend::
.pure

;;;; MC and MX's specifications go here

mcspec:	offset tsspec-.		   ;Specs are offset and BLT'ed
pwfnam::
pw.dev:: sixbit /DSK/
pw.fn1:
ife $$DBUG,sixbit /   BIG/
ifn $$DBUG,sixbit /   FOO/
pw.fn2:	sixbit /  0DAT/
pw.snm:
ife $$DBUG,sixbit /SYSBIN/
ifn $$DBUG,sixbit /CSTACY/

;;; filename block for mail files
mlmnam::
fm.dev:	sixbit /DSK/
fm.fn1:	sixbit /MAIL/
fm.fn2:	sixbit />/
fm.snm: 
ife $$DBUG,sixbit /.MAIL./
ifn $$DBUG,sixbit /CSTACY/

bugnam:
ife $$PAND,440700,,[asciz /BUG PWORD/]
ifn $$PAND,440700,,[asciz /BUG PANDA/]

spcend::
	offset 0
mcspce::			   ;end of MC's specs

;;;; ML's specifications go here

mlspec:	offset tsspec-.
pwfnam: sixbit /DSK/
ife $$DBUG,sixbit /   BIG/
ifn $$DBUG,sixbit /   FOO/
	sixbit /  0DAT/
ife $$DBUG,sixbit /SYSBIN/
ifn $$DBUG,sixbit /CSTACY/

;;; filename block for mail files
mlmnam::
fm.dev:	sixbit /DSK/
fm.fn1:	sixbit /MAIL/
fm.fn2:	sixbit />/
fm.snm: 
ife $$DBUG,sixbit /.MAIL./
ifn $$DBUG,sixbit /CSTACY/

bugnam:
ife $$PAND,440700,,[asciz /BUG PWORD/]
ifn $$PAND,440700,,[asciz /BUG PANDA/]

spcend:
	offset 0
mlspce:

;;;; AI's specifications go here
aispec:	offset tsspec-.
pwfnam::
pw.dev:: sixbit /DSK/
pw.fn1:	sixbit /   BIG/
pw.fn2:	sixbit /  0DAT/
pw.snm:
ife $$DBUG,sixbit /SYSBIN/
ifn $$DBUG,sixbit /CSTACY/

;;; filename block for mail files
mlmnam::
fm.dev:	sixbit /DSK/
fm.fn1:	sixbit /MAIL/
fm.fn2:	sixbit />/
fm.snm: 
ife $$DBUG,sixbit /.MAIL./
ifn $$DBUG,sixbit /CSTACY/

bugnam:
ife $$PAND,440700,,[asciz /BUG PWORD/]
ifn $$PAND,440700,,[asciz /BUG PANDA/]

spcend::
offset 0
aispce::			   ;end of AI's specs

;;;; MD's specifications go here
mdspec:	offset tsspec-.
pwfnam::
pw.dev:: sixbit /DSK/
pw.fn1:	sixbit /   BIG/
pw.fn2:	sixbit /  0DAT/
pw.snm:
ife $$DBUG,sixbit /SYSBIN/
ifn $$DBUG,sixbit /CSTACY/

;;; filename block for mail files
mlmnam::
fm.dev:	sixbit /DSK/
fm.fn1:	sixbit /MAIL/
fm.fn2:	sixbit />/
fm.snm: 
ife $$DBUG,sixbit /.MAIL./
ifn $$DBUG,sixbit /CSTACY/

bugnam:
ife $$PAND,440700,,[asciz /BUG PWORD/]
ifn $$PAND,440700,,[asciz /BUG PANDA/]

spcend::
offset 0
mdspce::			   ;end of MD's specs

;;; DM's specs

dmspec:	offset tsspec-.		   ;DM's table of specs are offset and bLT'ed
pwfnam:: sixbit /DSK/
	sixbit / 0PWRD/
	sixbit />/
ife $$DBUG,sixbit /SYSENG/
ifn $$DBUG,sixbit /CSTACY/

;;; filename block for mail files
mlmnam::
fm.dev:	sixbit /DSK/
fm.fn1:	sixbit /MAIL/
fm.fn2:	sixbit />/
fm.snm: 
ife $$DBUG,sixbit /.MAIL./
ifn $$DBUG,sixbit /CSTACY/

bugnam:
ife $$PAND,440700,,[asciz /(BUG PWORD)/]
ifn $$PAND,440700,,[asciz /(BUG PANDA)/]

spcend::
	offset 0
dmspce::

;; type our prompt

prompt:	setzm ttyflg		   ;turn the TTY! 

	tyo dspc,[^P]		   ;new line if we need one
	tyo dspc,["A]		   ;just like DDT.
	skipe dsprmp		   ;do we have an alternate prompt?
	  pjrst [xct dsprmp	   ;  yes, do it
		 ret]		   ;  instead
ife $$pand,tyo tyoc,[52]	   ;followed by "*"
ifn $$pand,tyo tyoc,[76]	   ;followed by ">"
	ret

echo:	skipe lfflag		   ; are we on fresh line?
	  call [tyo tyoc,[^J]	   ; get one
		setzm lfflag	   ; and notice we did it
		ret]		   ;   and continue
	skipe hfdupf		   ; is it full duplex?
	  ret			   ;   yes, don't echo
	cain ch,^M		   ; CR?
	  jrst [ tyo tyoc,ch	   ;   type it
		 tyo tyoc,[^J]	   ;   and a LF too!
		 ret]
	caie ch,33		   ; not altmode?
	  cail ch,40		   ;   abnormal character?
	    cain ch,177		   ;     or rubout?
	      cain ch,^G	   ;	   ^G is echod as self
	        jrst [ tyo tyoc,ch ;	     OK, echo it normally
		       ret]
	call echosl		   ; Echo it maybe in sail mode
	ret			   ; and return

echoch=call echo		   ;simple memonic

	
echosl:	save [ch]		   ; recover the real char
	skipn sailp		   ; do we have sail characters?
	  tyo tyoc,["^]		   ;   no, circumflex will do
	skipe sailp
	  tyo tyoc,[^K]		   ;   yes, uparrow is the thing!
	tro ch,100		   ; make this into a non-control-char
	tyo tyoc,ch		   ; and echo that
	restore [ch]		   ; save the real character
	ret

;; routine to read from TTY following conventions WRT ?, _H, etc.
;; no-skip means ^D typed.
;; 1-skip means ? or ^_H typed.
;; 2-skips means rubout
;; 3-skips means other character

tyiget:	setzm ttyflg		   ;reading turns the TTY back on!

tyi=call tyiget			   ;operation to get a character
	skipge ch,reread	   ;is there anything to re-read?
tyiiot:	  .iot tyic,ch		   ;  no, read the character
	setom reread		   ;nothing to re-read any more, for sure!

	caie ch,4110		   ;is it the [HELP] key?
	  cain ch,77		   ;  or ? "?"
	    jrst popj1		   ;     skip-1 return

	caile ch,36		   ;is it garbage?
	  jrst popj23		   ;  non-garbage, use it!

	cain ch,0		   ;is it ^@ ?
	  jrst tyiget		   ;  yes, ignore it

	cain ch,^D
	  ret			   ;blow nose and return

	cain ch,^S		   ;  is it a ^S ?
	  ret			   ;    yes, return.

	cain ch,^M		   ;Allow a ^M to make it through!
	  jrst popj23		   ;  as a real live character

	save [x]		   ;borrow X from the world
	move x,tyiflg		   ;get the flag word

	trnn x,ty.edt		   ;Are we hacking editing characters?
	  jrst nedit		   ;  no, don't check for them!
	caie ch,^W		   ;kill word?
	  cain ch,^U		   ;  Kill line?
	    jrst popj3x		   ;    yes, let them through!
	cain ch,^R		   ;Retype line?
	  jrst popj3x		   ;  yes, retype it

nedit:	cain ch,^C		   ;is it a ^C?  Let it through!
	  jrst popj3x
	restore [x]		   ; anything else IS garbage, so ignore it.
	echoch			   ; echo the loser
	tyo tyoc,[^G]		   ; beep
	jrst tyiget		   ; and try again

popj3x:	restore [x]
popj23:	caie ch,177		   ;is it a rubout?
	  aos (sp)		   ;  no, skip-3 return, ordinary garbage.

	aos (sp)		   ;otherwise skip-2, for rubout.
	aos (sp)
	ret
.upure
tyiflg:	0			   ;flag word for what special chars to let thu
ty.==525252,,525252
ty.edt==4			   ;flag for allowing editing commands
.pure
;;;; Predicates for the RFN package, to skip if must be proceeded by ^Q

rsixtp:
psixtp:	cain a,54		   ;comma?
	  jrst popj1		   ;  skip!
	ret			   ;otherwise, just ordinary

constants
versio:	.fnam1
	.fnam2

.upure
variables
impend:				   ;end of impure!
.pure
corend::			   ;end of core
ifg corend-lsrpag*2000, .ERR Code overlaps with INQUIR database, you will lose!
.perch				   ;check our allocations

;;; Local Modes :::
;;; Comment Begin:;  :::
;;; Comment Column:35 :::
;;; End: :::

end go