;<PUP>PSVLEF.MAC.39, 24-Nov-82 09:49:11, Edit by SCHOEN
; Deposit correct AC into leader page at end of GETSIZ
;<PUP>PSVLEF.MAC.38,  3-Nov-82 17:34:06, Edit by SCHOEN
; Use CLZFF at CLNF2 to kill JFNs of server fork
;<PUP>PSVLEF.MAC.37, 18-Oct-82 08:54:54, Edit by SCHOEN
; remove LFINIT table
;<SCHOEN.LEAF>PSVLEF.MAC.4, 31-Jul-82 12:00:24, Edit by SCHOEN
; Present more debugging information when server fork crashes
; Don't log errorLeafs unless debugging
;<PUP>PSVLEF.MAC.33, 15-Jun-82 12:40:40, Edit by SCHOEN
; Make sure $closf clears out JFNTAB and WILDFT if it closes and releases
; the JFN, else just clear out RH of these table entries
;<PUP>PSVLEF.MAC.25,  7-Jun-82 14:47:02, Edit by SCHOEN
; $CLOSF senses unopened files, and does RLJFN instead.
; CHKHDL returns +2 for legal, unopened JFN, +3 for legal, opened JFN
; Add PROPL3 routines to GTJFN file (but not open it) for prop list functions
; CHKVER with b0 of p3 on doesn't open file
; Add Size (byte count) to list of known properties
;<PUP>PSVLEF.MAC.24,  4-Jun-82 18:51:20, Edit by SCHOEN
; Begin adding Property List functions
;<PUP>PSVLEF.MAC.23,  3-May-82 16:14:54, Edit by SCHOEN
; GETPTR was computing bytepointers incorrectly
;<PUP>PSVLEF.MAC.16, 27-Apr-82 22:59:38, Edit by SCHOEN
; Make the server wakeup mechanism more efficent (and complicated)
;<PUP>PSVLEF.MAC.15, 23-Apr-82 11:56:18, Edit by SCHOEN
; Make sure proper byte count gets set when EOF bit on in LeafWrite
;<PUP>PSVLEF.MAC.14, 22-Apr-82 11:05:13, Edit by SCHOEN
; Add log dump to background loop
;<PUP>PSVLEF.MAC.13, 11-Apr-82 22:25:05, Edit by SCHOEN
; Add LFINIT table to signal server fork ready to run
;<PUP>PSVLEF.MAC.12, 11-Apr-82 21:59:53, Edit by SCHOEN
; Check for Sequin received queue being empty before dismissing LEAFSV
; interrupt; repeat service code if queue non-empty.
;<PUP>PSVLEF.MAC.11, 10-Apr-82 20:52:20, Edit by SCHOEN
; PSQVAR, PSQPVR -> TOPVAR, TOPPVR so PUPUUO.MAC loads correctly
;<PUP>PSVLEF.MAC.10,  9-Apr-82 14:02:19, Edit by SCHOEN
; LOGBFS was supposed to be in units of words, not pages!
;<PUP>PSVLEF.MAC.8,  1-Apr-82 12:38:38, Edit by SCHOEN
; Don't search SYSDEF; PUPDEF was compiled with SYSDEF
;<PUP>PSVLEF.MAC.7, 31-Mar-82 17:14:09, Edit by SCHOEN
; Use BYTCNT(JFN) in READLF to determine whether read is past EOF 
;<PUP>PSVLEF.MAC.5, 31-Mar-82 16:05:18, Edit by SCHOEN
; Replace SHRVAR mechanism with proper use of USEVAR
;<PUP>PSVLEF.MAC.4, 31-Mar-82 15:15:17, Edit by SCHOEN
; Keep track of file byte count during write operations, since paged
; I/O in Tenex/Tops-20 does not update EOF pointer.
;<PUP>PSVLEF.MAC.3, 18-Mar-82 13:37:26, Edit by SCHOEN
; HRRZ 1,FILVER -> HRR 1,FILVER at GETJFN+5. Don't wipe out GTJFN flags
;<SCHOEN>PSVLEF.MAC.79, 28-Feb-82 15:29:53, Edit by SCHOEN
; replace ! in list of version leadin.  "OPENFILE(FOO.BAR;T)"
; on dolphin causes it to look for FOO.BAR!T.
;<SCHOEN>PSVLEF.MAC.78, 28-Feb-82 15:11:22, Edit by SCHOEN
; Make PRSFIL understand attributes in file names
; Remove ! from list of version leadins
;<SCHOEN>PSVLEF.MAC.77, 25-Feb-82 11:09:33, Edit by SCHOEN
; [Tops20] Make CHKACC return proper error codes in A
;<SCHOEN>PSVLEF.MAC.76, 20-Feb-82 17:38:26, Edit by SCHOEN
; Make MAPDAT extern, wait for system to have date/time before
; starting.
;<SCHOEN>PSVLEF.MAC.75, 17-Feb-82 15:26:22, Edit by SCHOEN
; Fix RIFSST to handle odd length strings correctly (dumb!)
;<SCHOEN>PSVLEF.MAC.73,  3-Feb-82 14:53:42, Edit by SCHOEN
; Mapdat at very start of program
;<SCHOEN>PSVLEF.MAC.72, 27-Jan-82 12:20:15, Edit by SCHOEN
; Use JFNTAB to scan through locked files
;<SCHOEN>PSVLEF.MAC.71, 27-Jan-82 00:33:35, Edit by SCHOEN
; Protect AOBJN pointer during jfn scanning in UNLOCK 
;<SCHOEN>PSVLEF.MAC.69,  3-Jan-82 13:32:58, Edit by SCHOEN
; Close the correct connection on reset of a Resethosts op
; Clear interrupt system on server fork crash
;<SCHOEN>PSVLEF.MAC.64, 14-Dec-81 19:14:08, Edit by SCHOEN
; Log server fork crashes, check for BNTLCK unlocked if last locked by
; dismissing fork, unlock BNTLCK if server fork crashes with it locked
;<SCHOEN>PSVLEF.MAC.63, 14-Dec-81 15:18:19, Edit by SCHOEN
; Load the byte size of a file out of the proper ac
; Clean up stack in RestLf when login fails
;<SCHOEN>PSVLEF.MAC.61, 13-Dec-81 23:18:14, Edit by SCHOEN
; More work on the leader page bookkeeping
;<SCHOEN>PSVLEF.MAC.57, 11-Dec-81 14:44:54, Edit by SCHOEN
; Illegal instruction trap causes the server fork to restart itself
;<SCHOEN>PSVLEF.MAC.45, 10-Dec-81 10:20:33, Edit by SCHOEN
; Make a fake leader page out of Twenex FDB, redirect RSIN/RSOUT
; to work on the leader page if a negative byte address is given
;<SCHOEN>PSVLEF.MAC.41,  4-Dec-81 23:02:54, Edit by SCHOEN
; Strip out CR->CRLF conversion...messes up Lisp's byte count
; for random access I/O.  Also return to default 8-bit binary files.
;<SCHOEN>PSVLEF.MAC.40, 23-Nov-81 11:53:39, Edit by SCHOEN
; Convert CR to CRLF in text mode files
; Default file type (i.e. byte size) to text (7-bit)
;<SCHOEN>PSVLEF.MAC.38, 19-Nov-81 23:31:32, Edit by SCHOEN
; Don't recheck passwords if login/connect name doesn't change
;<SCHOEN>PSVLEF.MAC.36, 18-Nov-81 15:12:55, Edit by SCHOEN
; trap IFS leader page munging of file type to set byte size
; make bytsiz a per JFN quantity, make JFN tables shared.
; Clean up some error messages and JSYS error <-> IFS error pairs
; Don't replace extension terminator by "!" anymore
;<SCHOEN>PSVLEF.MAC.31,  9-Nov-81 11:26:04, Edit by SCHOEN
; Made PUPFNH extern
;<SCHOEN>PSVLEF.MAC.30,  6-Nov-81 16:18:27, Edit by SCHOEN
; Don't log rec'd LeafReads unless debugging
;<SCHOEN>PSVLEF.MAC.28,  6-Nov-81 11:03:34, Edit by SCHOEN
; remember that $closf skip returns 
;<SCHOEN>PSVLEF.MAC.26,  2-Nov-81 14:27:39, Edit by SCHOEN
; Finish implementing ResetHosts mechanism in LeafReset
;<SCHOEN>PSVLEF.MAC.22, 21-Oct-81 20:13:57, Edit by SCHOEN
; Make sure GNJFN mode of OpenLf closes previous file before
; opening the next one.
;<SCHOEN>PSVLEF.MAC.20,  9-Oct-81 12:44:01, Edit by SCHOEN
; Add wildcard feature to OpenLf:
;	First call to OpenLf can have a file with
;	wildcards in it.  The file of the group
;	is returned.
;
;	Succeeding calls to OpenLf can have LSB
;	of Open mode word set, meaning "do a GNJFN."
;	In this case, user/connect name/password and
;	filename strings are not checked.

	title	psvlef
	subttl	Tenex/Tops-20 Leaf Server
	search	pupdef,psqdef,plfdef 
	usevar	topvar,toppvr,pshvar,pshpvr

tenex,<	search stenex >
tops20,<search monsym>


;	Eric Schoen
;	SUMEX Computer Project
;	Stanford University Medical Center
;	Stanford, CA.
;	November, 1981

;	Work on Leaf and Sequin implementations in Tenex
;	and Tops-20 was funded by NIH Biotechnology Resouces 
;	Program under grant RR-00785


stksiz==100
lflpdl==100		; leaf pdl
njfn==150		; size of jfn table
loglat==^D<5*60>	; max logging latency, seconds
logbfs==2000		; size of logging buffer (words)

ps%dev=1b35	; seen a device
ps%dir=1b34	; seen a directory
ps%nam=1b33	; seen a name
ps%ext=1b32	; seen an extension
ps%ver=1b31	; seen a version
ps%drs=1b30	; seen the start of a directory
ps%atr=1b29	; seen at least one attribute

	extern	connum,usrnum,contab,.okint,.noint,pbhead,connfk
	extern	ppupsn,ppupsh,ppupss,ppupdn,ppupdh,ppupd0,ppupd1
	extern	pupfnh,bntlck,bntlkr

lsp pmadr,1		; page for PMAP I/O
pmpag==pmadr/1000

	subttl	startup

srvstt::
start:	reset
	gtad
	camn a,[-1,,-1]
	 jrst [movei a,^D5000
	       disms
	       jrst .-2]
	jsp fx,mapdat##		; map high core to a thawed file
	seto fx,		; top fork
	move p,[iowd stksiz,stack]
	setz f,
	tlo f,(debugf)		; assume debugging
tenex,<
	gjinf		; detached?
	skipge d
	 jrst  [move a,[sixbit/LOGDES/]
		sysgt
		movei a,(b)
		hrli a,1
		getab
		hrls a
		move b,a
		movei a,400000
		spjfn
		tlz f,(debugf)		; not debugging
		jrst .+1]
>
tops20,<
	seto a,
	hrroi b,d
	movei c,.jicpj
	getji		; get controlling job number
	 ercal screwup
	aose d		; are we controlled?
	 tlz f,(debugf) ; yes, don't debug
>	
	 
	pushj p,inilog	; init logger
	log <LEAFSV: Leaf server restarting...>
	seto a,		; make a server
	pushj p,seqini##; init sequin
	log <LEAFSV: Leaf server running>

; Background loop here
leafsl:	setob cx,fx	; so we can tell when this routine calls BNTSRV
	movei a,^d5000	; go to sleep for a time
	disms
	pushj p,bntsrv##; run the Sequin background process
	time
	caml a,logtim	; time to dump log?
	 pushj p,dmplog	; yes, dump it	 
	jrst leafsl


	subttl	IFS String Utilities

; routine to convert an ASCIZ string to an IFS String
; Call: pushj p,wifsst
;	a/ 16 bit bytepointer to Leaf packet being written
;	b/ Tenex string pointer to an ASCIZ string
; Returns: +1 always, a,b updated
wifsst::push p,c		; save c and d
	push p,d			
	tlc b,-1
	tlcn b,-1
	 hrli b,(point 7)
	ibp a			; point to string length
	push p,a		; save pointer to length
	tlc a,(30b11)		; convert to 8 bit
	setz d,			; zero count
wifss1:	ildb c,b		; get a character
	jumpe c,wifss2		; leave if done
	idpb c,a		; deposit into IFS string
	aoja d,wifss1

wifss2:	exch a,(p)		; interchange current pointer w/original
	dpb d,a			; save string length
	pop p,a			; retrieve string pointer
	trne d,1		; odd number of bytes?
	 idpb c,a		; yes, deposit a garbage byte
	tlc a,(30b11)		; make back into 16 bit bytes again
	pop p,d			; retrieve acs
	pop p,c
	popj p,			; return

; routine to convert an ASCIZ string to a BCPL String
; Call: pushj p,wbcpst
;	a/ 16 bit bytepointer to Leaf packet being written
;	b/ Tenex string pointer to an ASCIZ string
; Returns: +1 always, a,b updated
wbcpst::push p,c		; save c and d
	push p,d			
	tlc b,-1
	tlcn b,-1
	 hrli b,(point 7)
	tlc a,(30b11)		; convert to 8 bit
	ibp a			; point to string length
	push p,a		; save pointer to length
	setz d,			; zero count
wbcps1:	ildb c,b		; get a character
	jumpe c,wbcps2		; leave if done
	idpb c,a		; deposit into IFS string
	aoja d,wbcps1

wbcps2:	exch a,(p)		; interchange current pointer w/original
	dpb d,a			; save string length
	pop p,a			; retrieve string pointer
	trnn d,1		; even number of bytes?
	 idpb c,a		; yes, deposit a garbage byte
	tlc a,(30b11)		; make back into 16 bit bytes again
	pop p,d			; retrieve acs
	pop p,c
	popj p,			; return


; Routine to convert an IFS String to an ASCIZ string
; Call: pushj p,riffst
;	a/ Tenex string pointer
;	b/ 16-bit byte pointer to an IFS string (such that
;	   one IBP would point to the character bytes)
; Returns: +1, always
;	a,b updated
rifsst::push p,c		; save c and d
	push p,d
	tlc a,-1		; Convert tenex pointer to hardware pointer
	tlcn a,-1
	 hrli a,(point 7,)
	ildb d,b		; Get count
	tlc b,(30b11)		; convert to 8 bit bytes
	push p,d		; save original length
	jumpe d,rifss2		; if done, go to leave
rifss1:	ildb c,b		; else get byte
	idpb c,a		; save in string
	sojn d,rifss1

rifss2:	idpb d,a		; null off terminating byte
	pop p,d			; get original length of string
	trne d,1		; was it odd?
	 ibp b			; yes, increment BP past garbage byte
	pop p,d			; retrieve d
	pop p,c			; retrieve c
	tlc b,(30b11)		; make pointer 16 bits again
	popj p,			; return

; Routine to compute the number of 16-bit bytes between two 16-bit 
; bytepointers
; Call: pushj p,cmplen
;	a/ 1st bytepointer 
;	b/ 2nd bytepointer
; Returns: +1 always, with the magnitude of the difference in a
;	   b/ lesser bytepointer
; WARNING! DOES NOT WORK WITH INDEXED OR INDIRECT BYTEPOINTERS!!!
cmplen:	push p,c		; save c and d
	push p,d	
	push p,5		; save 5 also
	hrrz 5,a
	caige 5,(b)
	 exch a,b		; make sure a.ge.b
	hrrz 5,a
	subi 5,(b)
	lsh 5,1			; compute # of 16 bit bytes from PDP10 words
	move c,[point 3,b,2]	; look at position
	ldb d,c
	lsh d,-1
	xct [jfcl
	     aoj 5,
	     addi 5,2](d)	; adjust for position within word
	move c,[point 3,a,2]	; look at greater byte now
	ldb d,c
	lsh d,-1
	xct [jfcl
	     soj 5,
	     subi 5,2](d)	; adjust for position in word
	movm a,5
	pop p,5
	pop p,d
	pop p,c
	popj p,

; routine to compare ASCIZ strings
; call: pushj p,strcmp
;	a/ pointer to string 1
;	b/ pointer to string 2
; returns: +1, strings are different
;	   +2, strings match
strcmp:	push p,c
	push p,d
	tlc a,-1
	tlcn a,-1
	 hrli a,(point 7)
	tlc b,-1
	tlcn b,-1
	 hrli b,(point 7)
strcm1:	ildb c,a
	caige c,"a"
	 caia
	caile c,"z"
	 caia
	trz c,40
	ildb d,b
	caige d,"a"
	 caia
	caile d,"z"
 	 caia
	trz d,40
	caie c,(d)
	 jrst [pop p,d
	       pop p,c
	       popj p,]
	jumpn c,strcm1
	pop p,d
	pop p,c
	aos (p)
	popj p,

	subttl	Leaf server fork, one per connection

; call: SFORK at LEAF, with at least SQ, CX set up
leaf::	move p,[iowd lflpdl,lfpdl]
	move fx,connfk(cx)	; get fork index
	move a,[3,,lfint]
	movem a,chntab##	; make channel 0 be the channel to wake on
	move a,[1,,srvcrs]	; set up illegal instruction trap
	movem a,chntab##+^d15
	movei a,400000
	move b,[levtab##,,chntab##]
	sir
	eir
	move b,[sigchn+1b15]
	aic
	

; Server fork wakeup mechanism:
; Much efficiency is gained by reducing context swap overhead.
; This code attempts to reduce the amount of work the top fork
; must do to start the server fork running.  
;
; If the server fork has been active within the last IDLE1 minutes,
; the fork dismisses for SHRTD milliseconds if its input queue is
; empty.
;
; If the fork has been idle for between IDLE1 and IDLE2 minutes,
; the fork dismisses for LONGD ms on an empty input queue.
;
; After IDLE2 minutes, the server fork goes to sleep (via WAIT).
;
; If the fork is asleep or waiting for LONGD ms, it sets a flag
; telling the superior fork that it is OK for the superior to
; interrupt it when it has data in the queue.

; here to wait for Leaf packets
leaflp:	hrrzs leaffk(sq)	; make this fork uninterruptable
	time			; compute time to go to delayed wakeup
	add a,[idle1*^d60*^d1000]
	move c,a
	movei d,shrtd		; start with short disms
leafl1:	move a,sqrxcu(sq)	; scan queue
	skipe qucnt(a)		; anything in the queue?
	 jrst leafgo		; yes, go
	movei a,(d)
lfwai1:	disms
	time
	camge a,c		; go to delayed wakeup?
	 jrst leafl1
	caie d,shrtd
	 jrst lfslep		; timed out on long dismiss; go to sleep
	movei d,longd		; go to delayed wakeup
	hrros leaffk(sq)	; say it's OK to interrupt
	add a,[idle2*^d60*^d1000] ; compute time to go to sleep at
	move c,a
	jrst leafl1

; Here when no activity for SHRTD+LONGD ms
lfslep:	
lfwait:	wait

; Here when interrupted by superior fork
lfint:	hrrz a,lev3pc##		; get PC of interrupt
	soj a,
	cain a,lfwai1		; at the DISMS?
	 movei a,lfwait		; yes, make believe we were WAITing
	caie a,lfwait		; were we waiting?
	 debrk			; no, just debrk, then
	movei a,leafgo		; yes, start the server fork
	movem a,lev3pc##	
	debrk

leafgo:	pushj p,leafsv
	jrst leaflp

; here when the fork crashes
srvcrs: push p,a
	move a,lev1pc##		; get crash address
	soj a,			; adjust
	pop p,a
	elog <Server fork %16O crashed: Illegal instruction at %1O>
	skipl bntlck		; BNTLCK locked?
	 jrst [came fx,bntlkr	; By us?
		jrst .+1	; No
	       setom bntlck	; Yes, unlock it
	       jrst .+1]
	cis			; Clear interrupts and restart process
	log <ACS: F:%0O  A:%1O  B:%2O  C:%3O  D:%4O>
	log <    SQ:%5O CX:%6O PB:%7O  P:%17O>
	log <Stack follows:>
srvcr1:	camn p,[iowd lflpdl,lfpdl]
	 jrst leaf
	pop p,a
	log <  %1O>
	jrst srvcr1

; here when Sequin connection receives a packet destined for me
; call: Signal interrupt on channel 0
; 	sq,cx/  set up
; returns: +1, always
leafsv::move a,sqrxcu(sq)	; see if anything waiting
	skipn 2(a)
	 jrst [movei a,(cx)
	       log <Connection %1O awakened with empty input queue>
	       popj p,]
	tlne f,(debugf)
	 movem cx,leafcx	; save connection if debugging
	push p,p1		; save p1
	push p,p2		; and p2
	push p,p4
leafs0:	movei a,LeafPk
	pushj p,inpSeq##
	 jrst leafsx
	move p1,a		; save number of bytes in this packet
	move p2,[point 16,Leafpk]; point to received packet

Leafs1:	move p5,p2		; save pointer to start of packet
	ildb a,p2		; get leafOpCode
	move p4,a		; save opcode for errors
	ldb c,[point 10,a,35]	; get length
	subi p1,(c)		; adjust byte count for this packet
	ldb c,[point 5,a,24]	; get opcode from packet
	caile c,maxOp		; less than the maximum defined opcode?
	 jrst LfOpEr		; no, send a BuddingLeaf
	pushj p,@LfOpTb(c)	; dispatch
	tlnn f,(debugf)
	 jrst Leafs2
	came cx,leafcx		; if debugging, make sure cx still the same
	 jrst [push p,a
	       push p,b
	       movei b,(cx)
	       hrrz a,leafcx
	       elog <CX clobbered! Should be %1O, but is %2O>
	       pushj p,screwup##]
Leafs2:	jumpg p1,Leafs1	

Leafsx:	move a,sqrxcu(sq)	; anything in the queue?
	skipe 2(a)		; check queue count
	 jrst leafs0	 	; yes, go again
	pop p,p4
	pop p,p2
	pop p,p1
	skipl bntlck		; Trace unreleased BNTLCKs
	 jrst [came fx,bntlkr	; Locked by us?
		jrst .+1	; No
	       setom bntlck	; Yes, release it then
	       movei a,(cx)
	       log <BNTLCK left locked by connection %1O, releasing...>
	       jrst .+1]
	popj p,

define lfdisp(subr),<
ifdef subr,<subr>
ifndef subr,<LFOpEr>
>
LfOpTb:	LfOpEr			; Servers don't like seeing LeafError
	lfdisp <OpenLf>		; LeafOpen
	lfdisp <ClosLf>		; LeafClose
	lfdisp <DeleLf>		; LeafDelete
	lfdisp <LfOpEr>		; LeafLength
	lfdisp <TrunLf>		; LeafTruncate
	lfdisp <ReadLf>		; LeafRead
	lfdisp <WritLf>		; LeafWrite
	lfdisp <RestLf>		; LeafReset
	lfdisp <NopLf>		; LeafNop
	lfdisp <LfOpEr>		; no opcode
	lfdisp <ParmLf>		; LeafParams
	lfdisp <PropLf>		; Get Leaf Prop list
maxOp=.-LfOpTb-1

; routine top clean up a leaf connection being closed
; call: pushj p,cleanf
;	cx/ set up for this connection
; returns: +1, always
cleanf::movsi c,-njfn
clnf1:	skipe jfntab(c)		; is there a jfn here?
	 pushj p,clnf2		; yes, close if ours
	aobjn c,clnf1		; loop through jfn table
	setzm connum(cx)	; done with jfns, undo login
	setzm usrnum(cx)
tops20,<
	hrrz a,connfk(cx)	; get fork index for this fork
	clzff			; close all files belonging to process
>
	popj p,

tops20,<
clnf2:	hlrz b,jfntab(c)	; get owning connection
	cain b,(cx)		; this one?
	 setzm jfntab(c)	; yes, forget about file
	popj p,
>
tenex,<
clnf2:	hlrz b,jfntab(c)	; get owning connection
	caie b,(cx)		; this connection?
	 popj p,
	movei a,(c)
	push p,a
	tlo a,(1b0)
	pushj p,$closf		; yes, close it
	 jrst [caie a,CLSX1	; file not open?
		type <CLEANF: CLOSF error: %1J>
	       jrst .+1]
	pop p,a
	rljfn
	 type <CLEANF: RLJFN error: %1J>
	popj p,
>
	subttl	Leaf Errors

; routine to return a BuddingLeaf error when an undefined LeafOp received
; call: pushj p,LfOpEr
;	c/ OpCode
; returns: +1, always
; clobbers a,b,c,d
LfOpEr:	movei a,erBdLf		; budding leaf error
	move b,c
	setz c,
	pushj p,ErrLf		; send a leaf error
	popj p,

; routine to send a leaf Error
; call: pushj p, ErrLf
;	a/ error subcode
;	b/ optional string pointer to human readable text
;	c/ error filehandle
;	p4/ error opcode
; returns: +1, always
; clobbers a,b,c,d
; note: if a is greater than 600000, then it is assumed to be a JSYS
; error number.  In this case, it is mapped into a standard IFS error
; number.
ErrLf:	move d,[point 16,LfAnPk,31]
	cail a,600000		; what type of error?
	 pushj p,jstifs		; convert JSYS error to IFS code
	dpb a,d
	idpb p4,d
	idpb c,d
	movei c,(a)
	move a,d
	cain b,0
	 pushj p,IFSdf		; try to find a string for this error
	caie b,0
	 pushj p,wifsst		; write string into packet
	movei b,(cx)
	tlne f,(debugf)
	 log <ERRLF: Sending Leaf error %3D for connection %2O>
	move b,[point 16,LfAnPk]
	setz c,
	pushj p,LeafOp
	popj p,

; routine to convert Tenex/Tops-20 JSYS error number of IFS number
; call: a/ JSYS error
; returns: +1, always, a/ IFS error code if found, else 0
jstifs:	push p,c
	hrroi b,temp
	write b,<%1J>		; do ERSTR on JSYS error code
	movsi b,-njsifs		; loop through table
jstif1:	hrrz c,jsifst(b)	; get a jsys error
	cain c,(a)		; is it ours?
	 jrst [hlrz a,jsifst(b)	; yes, get IFS code
	       jrst jstif2]
	aobjn b,jstif1		; no, loop
	setz a,
jstif2:	pop p,c			; found it or didn't find it
	hrroi b,temp
	popj p,

; table of JSYS error <-> IFS error correspondance
jsifst:	^d202,,GJFX4		; illegal char
	^d205,,GJFX5		; input field too large
	^d201,,GJFX6		; too many device fields
	^d201,,GJFX7		; too many directory fields
	^d201,,GJFX8		; no closing direcory broket
	^d201,,GJFX9		; too many name fields
	^d201,,GJFX10		; non-numeric version
	^d201,,GJFX11		; two version fields
	^d201,,GJFX12		; two account fields
	^d207,,GJFX16		; no such device
	^d210,,GJFX17		; no such direcory
	^d207,,GJFX18		; no such file name
	^d207,,GJFX19		; no such extension
	^d207,,GJFX20		; no such version
	^d207,,GJFX24		; old file required
	^d214,,GJFX27		; old file not allowed
	^d203,,GJFX31		; illegal *
	^d203,,GJFX32		; empty directory and * given
	^d202,,GJFX34		; unquoted ? in name
	^d208,,GJFX35		; read access not allowed
	^d209,,OPNX1		; file already open
	^d207,,OPNX2		; file doesn't exist
	^d208,,OPNX3		; read access not allowed
	^d208,,OPNX4		; write access not allowed
	^d209,,OPNX9		; file busy
	^d211,,OPNX10		; no room
njsifs==.-jsifst

; Routine to find supply a human-readable string to correspond
; with an IFS error number
; call: pushj p,IFSdf
;	c/ IFS error number
; returns: +1, always, error number in c, string pointer to string in b
; 	       or 0 if not found
IFSdf:	push p,a
	push p,b
	movsi a,-nIFSdf		; prepare to loop through table
IFSdf0:	hlrz b,IFSdft(a)	; get IFS error
	cain c,(b)		; found it?
	 jrst IFSdf1		; yes
	aobjn a,IFSdf0		; no loop
	setzm (p)		; not found, return 0 in b
	pop p,b
	pop p,a
	popj p,

; here when IFS error found
IFSdf1:	hrro b,IFSdft(a)	; pick up string pointer
	pop p,(p)
	pop p,a			; clean stack
	popj p,

; table of IFS error <-> Human readable string correspondance
IFSdft:	^d116,,[asciz/Illegal combination of lookup bits./]
	^d201,,[asciz/Malformed filename./]
	^d202,,[asciz/Illegal character in filename./]
	^d203,,[asciz/Illegal use of "*"./]
	^d204,,[asciz/Illegal version number./]
	^d205,,[asciz/Filename too long./]
	^d206,,[asciz/Not allowed to access Directory Information File./]
	^d207,,[asciz/File not found./]
	^d208,,[asciz/File is protected - access denied./]
	^d209,,[asciz/File open in conflicting way - file busy./]
	^d210,,[asciz/No such directory./]
	^d211,,[asciz/Page allocation exceeded./]
	^d212,,[asciz/The disk is full!/]
	^d213,,[asciz/CreateDiskStream failed - disk error?/]
	^d214,,[asciz/Rename "to" file already exists./]
	^d215,,[asciz/File is not deletable./]
	^d216,,[asciz/Illegal user-name./]
	^d217,,[asciz/Incorrect user-password./]
	^d218,,[asciz/Can't login as files-only directory./]
	^d219,,[asciz/Illegal connect-name./]
	^d220,,[asciz/Incorrect connect-password./]
	^d1001,,[asciz/Timeout has occurred -- connection broken./]
	^d1010,,[asciz/Operation not implemented./]
	^d1011,,[asciz/Illegal leaf handle./]
	^d1012,,[asciz/File too long./]
	^d1013,,[asciz/Illegal leaf truncate./]
	^d1015,,[asciz/Illegal leaf read./]
	^d1016,,[asciz/Illegal leaf write./]
nIFSdf==.-IFSdft

; routine to advance pointer to start of next LeafOp
; call: p2/opcode of current packet
;	p5/pointer to start of current packet
; returns: +1, always, p2 updated
flseop:	push p,a
	push p,b
	ldb a,[point 10,p2,35]	; get length in bytes
	lsh a,-1		; convert to words
	idivi a,2		; see how many PDP10 words it spans
	move p2,p5		; get pointer to start of current packet
	addi p2,(a)		; adjust EA
	caie b,0		; b is either 0 or 1
	ibp p2			; odd number of words, increment pointer
	pop p,b
	pop p,a
	popj p,
	subttl	Send Leaf Answer
; Routine to finish up LeafOpAnswer and send it
; Call: pushj p,leafOp
; a/ current 16 bit bytepointer to packet
; b/ 16 bit pointer to start of packet, must be 442000,,x form
; c/ LeafOp to use
; Returns: +1, always
; Clobbers a,c

leafOp:	push p,b		; save packet org
	pushj p,cmplen
	lsh a,1			; convert to 8-bit bytes
	lsh c,^d11
	tro c,1b25		; make this an Answer
	iori a,(c)
	idpb a,b
	andcmi a,(c)
	lsh a,-1		; convert to 16 bit bytes	
	movsi a,(a)		; put length into left half
	hrr a,(p)
	setz b,			; Send a Sequin data
	pushj p,senSeq##	; send it off
	pop p,b			; recover packet org
	popj p,
	subttl	Login

; routine to do login
; call: pushj p,.login
;	p2/ 16-bit pointer to packet, pointing at user name
;	a/ B0: don't try connect
; returns: +1, failure, LeafError in a
;	   +2, success, usrnum(cx), connum(cx) filled in
.login:	movem p,loginp		; save p incase of error
	push p,a		; save a
	hrroi a,temp
	move b,p2
	pushj p,rifsst		; convert string to asciz
	move p2,b		; save updated pointer
ifn ft10x,<
	movei a,1		; try to parse name
	hrroi b,temp
	stdir
	 jfcl
	 jrst [movei a,erUsrN	; failure in user name
	       jrst .logf]
	tlne a,(1b0)		; files only?
	 jrst [movei a,erFils	; yes, fail
	       jrst .logf]
	movei a,(a)		; save dir number
	push p,a		; save directory number
	hrroi a,temp		; read password from packet
	move b,p2
	pushj p,rifsst
	move p2,b		; save updated pointer
	move a,(p)		; recover directory number
	camn a,usrnum(cx)	; same as before?
	 jrst [pop p,a
	       jrst .logs]	; skip proxy login
	hrroi b,temp		; try to do a proxy login
	hrli a,(1b1)
	cndir
	 jrst [movei a,erUsrP	; user password incorrect?
	       jrst .logf]
	pop p,a			; recover directory number
	movem a,usrnum(cx)	; save user number
> ; end ifn ft10x

ifn ft20,<
	movsi a,(rc%emo)	; match name exactly
	hrroi b,temp
	rcusr			; convert to user number
	 erjmp jerr##
	tlne a,(rc%nom!rc%amb)	; no match or ambiguous?
	 jrst [movei a,erUsrN	; fail
	       jrst .logf]
	camn c,usrnum(cx)	; same as before?
	 jrst [hrroi a,temp	; yes, read password to advance pointer
	       move b,p2
	       pushj p,rifsst
	       move p2,b
	       jrst .logs]
	push p,c		; else save user number
	move a,c		; and prepare for GTDIR
	tlo a,(1b3)		; convert to PS: 
	movei b,temp		; get directory password
	hrroi c,temp+20
	gtdir
	hrroi a,temp		; read password from packet
	move b,p2
	pushj p,rifsst
	move p2,b		; save updated pointer
	hrroi a,temp
	hrroi b,temp+20
	pushj p,strcmp		; compare strings
	 jrst [movei a,erUsrP	; password failed
	       jrst .logf]
	pop p,a
	movem a,usrnum(cx)	; save directory as login and connected
	tlo a,(1b3)		; make into a PS: directory number
> ; end ifn ft20
	movem a,connum(cx)
	pop p,a
	jumpl a,.logx		; if no connect check, leave now
	
; now attempt to connect, if possible and necessary
; also end up here if no change in login directory
.logs:	push p,p2		; save pointer
	ildb a,p2		; read length of connect string
	jumpe a,[ibp p2		; no connect name, incr past password block
		 pop p,(p)	; clean stack
		 jrst .logx]	; leave
	pop p,p2		; recover connect name pointer
	move b,p2
	hrroi a,temp
	pushj p,rifsst		; read connect name
	move p2,b		; save updated pointer
ifn ft10x,<			; see if directory exists
	pushj p,fixcon		; fix if necessary
	move b,a		; prepare to STDIR
	movei a,1
	stdir
	 jfcl
	 jrst [movei a,erConN	; connect name failure
	       jrst .logf]
	camn a,connum(cx)	; same as before?
	 jrst .logcx		; yes
	push p,a		; save directory number
>; ifn ft10x
ifn ft20,<
	pushj p,fixcon		; fix string if necessary
	move b,a
	movsi a,(rc%emo)
	rcdir			; translate
	 ercal jerr##
	tlne a,(rc%nom!rc%amb)
	 jrst [movei a,erConN
	       jrst .logf]	; fail on error
	camn c,connum(cx)	; same as before?
	 jrst .logcx		; yes
	push p,c		; save number
>; ifn ft20
	hrroi a,temp
	move b,p2
	pushj p,rifsst		; read connect password
	move p2,b
	pop p,a			; recover connect directory number

	pushj p,chkcon		; try to connect
	 jrst [movei a,erConP	; no, failed
	       jrst .logf]
	movem a,connum(cx)	; save connected directory number
	jrst .logx		; and leave

; here on error
.logf:	move p,loginp		; recover p
	setzb c,b		; no human string
	pushj p,errLf		; send error answer
	popj p,

; here when connect name hasn't changed
; advance pointer past password string
.logcx:	hrroi a,temp
	move b,p2
	pushj p,rifsst		; swallow password string
	move p2,b
; fall through...

; here to exit successfully
.logx:	move p,loginp		; recover p
	aos (p)			; succeed 
ifn ft10x,<
	hrrz a,usrnum(cx)
	hrrz b,connum(cx)
	movei c,(cx)
;	log <.LOGIN: Login user %1U%74I%2U%76I on connection %3O>
>
ifn ft20,<
	move a,usrnum(cx)
	move b,connum(cx)
	movei c,(cx)
;	log <.LOGIN: Login user %1U, %2U on connection %3O>
>
	popj p,			; leave

ls loginp,1			; storage for P on entering .login

; routine to fix a connect directory for brokets
; call: pushj p,fixcon
; 	string in temp
; returns: +1, always, pointer to fixed string in A
; clobbers b
ifn ft20,<
fixcon:	move a,[point 7,temp]	; look for a left broket
fixc0:	ildb b,a
	cain b,74		; found one?
	 jrst [hrroi a,temp	; yes, leave
	       popj p,]
	jumpn b,fixc0		; loop until end of string
; here if ran out of string
	hrroi a,temp+20		; copy string with brokets
	hrroi b,temp
	write <%74I%2S%76I>	; will add brokets around string
	hrroi a,temp+20
	popj p,
> ;end ifn ft20
ifn ft10x,<
fixcon:	move a,[point 7,temp]
	ildb b,a
	caie b,74		; left broket?
	 jrst [hrroi a,temp	 
	       popj p,]		; no, leave
fixc1:	ildb b,a		; loop until end or right broket
	cain b,76
	 jrst [setz b,
	       dpb b,a		; null of right broket
	       move a,[point 7,temp,6]
	       popj p,]
	jumpn b,fixc1
	move a,[point 7,temp,6]
	popj p,
> ;end ifn ft10x
; routine to try to connect
; call: pushj p,chkcon
; 	a/ target directory number in a
; returns: +1, failure
;	   +2, success
ifn ft10x,<
chkcon:	movei a,(a)		; clear STDIR flags
	push p,a
	tlo a,(1b1)		; do proxy GFACC
	hrrz 3,usrnum(cx)	; get user number
	gfacc
	trne a,1b32		; need a password?
	 jrst [pop p,a		; no, recover dir
	       setz b,
	       cndir		; do the connect
		caia		; failed
	       aos (p)
	       popj p,]
	pop p,a
	hrroi b,temp
	cndir			; connect if possible
	 caia			; failed, assume password invalid
	aos (p)
	popj p,
>
ifn ft20,<
chkcon:	push p,a			; save dir number
	tlo c,(1b0)
	hrroi b,temp			; point to password
	pushj p,.cnchk##		; from PUPSUP
	 skipa
	aos -1(p)
	pop p,a
	popj p,
>	
	subttl	LeafOpen

; routine to open a file
; call: p2/ 16-bit pointer to received request (ILDB gets first word after
;	    opcode)
; returns: +1, always, p2 updated
OpenLf:	movei a,(cx)
;	log <OPENLF: LeafOpen received for connection %1O>
	ildb b,p2		; get file handle incase this is GNJFN
	push p,p3
	ildb p3,p2		; get open mode
	trne p3,1		; is this a GNJFN-like operation?
	 jrst [movei c,(b)	; check valildity of JFN presented
	       pushj p,chkhdl
		jrst [pop p,p3  ; not good, bail out
		      jrst flseop]
		jfcl		; file not open, that's OK
	       movei b,(c)	; recover JFN
	       movei a,(b)
	       tlo a,(1b0)	; don't release JFN
	       pushj p,$closf	; close the file
		jfcl
	       move a,wildft(b); get jfn and flags
	       gnjfn
		jrst errLf	; error
	       movei a,(a)	; clear LH flags
	       pushj p,chkven	; open the file
	       pushj p,flseop	; flush extra words if necessary
	       jrst openL1]	; rejoin rest of LeafOpen code

	jumpn b,[movei c,(b)	; try to open a file if non-0 handle supplied
		 pushj p,chkhdl
		  jrst [pop p,p3  ; not good, bail out
		        jrst flseop]
		 skipa		; not open, good
		  jrst  [movei a,erFlBz  ; file busy
			 hrroi b,[asciz/Attempt to open file already open!/]
			 pushj p,errLf
		         pop p,p3
			 jrst flseop]
		 movei a,(c)
	         pushj p,chkven	; open the file
	         pushj p,flseop	; flush extra words if necessary
	         jrst openL1]	; rejoin rest of LeafOpen code

; none of the above, a new file supplied.  Do login and parse filename
	pushj p,.login		; try to log in
	 jrst [pop p,p3
	       jrst flseop]
 	hrroi a,temp		; logged in; read file name
	move b,p2
	pushj p,rifsst
	move p2,b
	pushj p,prsfil		; parse the file name
	 jrst [movei a,erNmMl	; error, malformed name
	       hrroi b,[asciz/Malformed name/]
	       setz c,
	       pushj p,errLf	; send error
	       pop p,p3		; recover p3
	       popj p,]
	pushj p,chkver		; Check mode bits, open file
	 jrst [setzb b,c
	       pushj p,errLf	; send of error
	       pop p,p3
	       popj p,]
OpenL1:	movem b,jfntab(a)	; save openf bits
	hrlm cx,jfntab(a)	; tag whose connection it belongs to
	movei b,(a)
	move a,[point 16,LfAnPk]; build reply packet
	ibp a			; increment past opcode field
	idpb b,a		; put jfn in reply
	push p,a		; get byte count
	movei a,(b)
	move b,bytcnt(a)	; get EOF
	exch a,(p)		; recover packet pointer
	rot b,-^d16		; deposit high bits
	idpb b,a
	rot b,^d16
	idpb b,a		; deposit low bytes
	setz b,
	idpb b,a		; this word is ignored
	move b,[point 16,LfAnPk]
	movei c,LfOpen		; respond
	pushj p,Leafop		; do it
	pop p,a			; get JFN
	pushj p,makldr		; make a leader page
	pop p,p3
	popj p,			; return
	subttl	LeafOpen Utilities

; routine to parse filename (in TEMP)
; call: pushj p,prsfil
; returns: +1, bad file name detected
; 	   +2, file name parsed, FILDEV, FILDIR, FILNAM, FILEXT, FILVER
;	       filled in
;	       Flags (see above) in RH of F set accordingly
prsfil:	setzm fildev		; clear strings
	setzm fildir
	setzm filnam
	setzm filext
	setzm filver
	setzm filflg		; flag word
	setzm filprt		; protection
	trz f,ps%dev!ps%dir!ps%nam!ps%ext!ps%ver!ps%drs!ps%atr
	move a,[point 7,temp]	; start reading
prsfi0:	move b,[point 7,temp+40]; temp storage
	setz d,			; field length counter

prsfi1:	ildb c,a		; get a character
	cain c,":"		; device terminator?
	 jrst prsdev		; yes, save device
	cain c,74		; start of directory?
	 jrst prsdrs		; yes, check some flags
	cain c,76		; end of directory?
	 jrst prsdir
	cain c,"."		; name or extension terminator?
	 jrst prsdot
	cain c,";"		; Tenex extension terminator
	 jrst prssmi
	cain c,"!"		; IFS version leadin?
	 jrst prssmi		; removed 2/28/82.  Dolphin supposed to know
	idpb c,b
	jumpe c,prsfi2		; at end of string, see what we've got
	aoja d,prsfi1

; here when device terminator seen
prsdev:	jumpe d,cpopj		; fail if a bare ":" seen
	trne f,ps%dev!ps%dir!ps%nam ;already seen a device, dir, or name?
cpopj:	 popj p,		; fail
	setz c,			; else terminate string
	idpb c,b
	hrroi c,fildev
	move b,[point 7,temp+40]; copy into device
	write c,<%2S>
	tro f,ps%dev		; say we've seen a device
	jrst prsfi0		; continue

; here when start of directory seen	 
prsdrs:	trne f,ps%drs!ps%dir!ps%nam ; already seen dir start, dir, or name?
	 popj p,		; fail
	tro f,ps%drs		; say seen start
	jrst prsfi0		; continue

; here when end of directory seen
prsdir:	jumpe d,cpopj		; fail if nothing in directory
	trnn f,ps%drs		; seen the start of the directory?
 	 popj p,		; no, die
	setz c,			; null off dir string
	idpb c,b
	hrroi c,fildir
	move b,[point 7,temp+40]
	write c,<%2S>
	trc f,ps%drs!ps%dir	; say seen directory
	jrst prsfi0		; continue

; here when a "." seen
prsdot:	trne f,ps%drs		; in the middle of a directory?
	 jrst [idpb c,b		; dot is ok, then
	       aoja d,prsfi1]	; continue through loop
	trnn f,ps%nam		; seen a name field, yet?
	 jrst [setz c,		; no, then this is name. terminate
	       idpb c,b		
	       hrroi c,filnam	; and copy
	       move b,[point 7,temp+40]
	       write c,<%2S>
	       tro f,ps%nam	; say seen name
	       jrst prsfi0]	; go for extension
	trnn f,ps%ext		; seen extension yet?
	 jrst [setz c,		; no, then this is ext. terminate
	       idpb c,b		
	       hrroi c,filext	; and copy
	       move b,[point 7,temp+40]
	       write c,<%2S>
	       tro f,ps%ext	; say seen extension
	       jrst prsfi0]	; go for version
	popj p,			; no dots after seeing name and extension

; here when a semicolon encountered
prssmi:	trnn f,ps%nam		; seen a name yet?
	 jrst [setz c,		; no, then this is name. terminate
	       idpb c,b		
	       hrroi c,filnam	; and copy
	       move b,[point 7,temp+40]
	       write c,<%2S>
	       tro f,ps%nam	; say seen name
	       tro f,ps%ext	; and also extension (foo;1 => foo.;1)
	       jrst prsfi0]	; go for version
	trnn f,ps%ext		; seen an extension?
	 jrst [setz c,		; no, then this is ext. terminate
	       idpb c,b		
	       hrroi c,filext	; and copy
	       move b,[point 7,temp+40]
	       write c,<%2S>
	       tro f,ps%ext	; say seen extension
	       jrst prsfi0]	; go for version

; must be a version or an attribute
	move a,[point 7,temp+40]
	ildb b,a		; get first character of version

	caige b,"a"		; uppercase it, incase it's a character
	 caia
	caile b,"z"
	 caia
	trz b,40

	cain b,"*"		; wildcard version?
	 jrst [hrrei b,-3	; store numeric equivalent
	       movem b,filver
	       trne f,ps%atr	; seen any attributes, yet?
	        popj p,		; yes, version is illegal
	       tro f,ps%ver	; say seen version
	       jrst prsfi0]
	cain b,"-"		; numeric special (-1, -2, -3)?
	 jrst [movei c,^d10	; try to read a number
	       nin
		popj p,		; not a number, die
	       caig b,3		; something other than 1, 2, or 3?
		popj p,		; incorrect, die
	       movns b
	       trne f,ps%atr	; seen any attributes, yet?
	        popj p,		; yes, version is illegal
	       movem b,filver	; save version
	       tro f,ps%ver	; say we have a version
	       jrst prsfi0]
	caige b,"0"
	 jrst prsatr
	caile b,"9"
	 jrst prsatr

	trne f,ps%atr		; seen any attributes
	 popj p,		; yes, die
	move a,[point 7,temp+40]
	movei c,^d10		; else explicit version?
	nin
	 popj p,		; bad number
	movem b,filver		; save version
	tro f,ps%ver		; say we have a version
	jrst prsfi0

prsatr:	pushj p,doattr		; parse attributes
	 popj p,		; unknown attribute
	jrst prsfi0		; parse agai

; routine to parse file name attributes.
; currently understands ;S, ;T, ;P
; call: pushj p, doattr
;	b/ attribute character
; returns: +1, unknown attribute
;	   +2, attribute known
doattr:	cain b,"T"		; temp?
	 jrst [movsi b,(1b5)
	       iorm b,filflg
	       tro f,ps%atr
	       aos (p)
	       popj p,]
	cain b,"S"		; scratch?
	 jrst [movsi b,(1b14)
	       iorm b,filflg
	       tro f,ps%atr
	       aos (p)
	       popj p,]
	cain b,"P"		; protection
	 jrst [movei c,^d8	; try to read a number
	       nin
		popj p,		; not a number, die
	       movem b,filprt	; save version
	       tro f,ps%atr
	       aos (p)
	       popj p,]
	popj p,			; semicolon in version is illegal (for now)

; here when string ends
prsfi2:	trne f,ps%drs		; was a started dir ever ended?
	 popj p,		; no, die
	trnn f,ps%nam		; name seen?
	 jrst [setz c,		; no, then this is name. terminate
	       idpb c,b		
	       hrroi c,filnam	; and copy
	       move b,[point 7,temp+40]
	       write c,<%2S>
	       tro f,ps%nam	; say seen name
	       tro f,ps%ext	; and also extension (foo;1 = foo.;1)
	       jrst prsfi4]	; 
	trnn f,ps%ext		; seen an extension?
	 jrst [setz c,		; no, then this is ext. terminate
	       idpb c,b		
	       hrroi c,filext	; and copy
	       move b,[point 7,temp+40]
	       write c,<%2S>
	       tro f,ps%ext	; say seen extension
	       jrst prsfi4]	; go for version
; if here, string must have ended with version or attribute
	move a,[point 7,temp+40]
	ildb b,a		; get first character of version

	caige b,"a"		; uppercase it, incase it's a character
	 caia
	caile b,"z"
	 caia
	trz b,40

	caige b,"0"
	 caia
	caile b,"9"
	 jrst [pushj p,doattr
	       popj p,
	      jrst prsfi4]
	trne f,ps%ver!ps%atr	; seen a version or attribute?
	 popj p,		; can't have two versions or ;attr;version
	cain b,"*"		; wildcard version?
	 jrst [hrrei b,-3	; store numeric equivalent
	       movem b,filver
	       tro f,ps%ver	; say seen version
	       jrst prsfi4]
	cain b,"-"		; numeric special (-1, -2, -3)?
	 jrst [movei c,^d10	; try to read a number
	       nin
		popj p,		; not a number, die
	       caig b,3		; something other than 1, 2, or 3?
		popj p,		; incorrect, die
	       movns b
	       movem b,filver	; save version
	       tro f,ps%ver	; say we have a version
	       jrst prsfi4]
	move a,[point 7,temp+40]
	movei c,^d10		; else explicit version?
	nin
	 popj p,		; bad number
	movem b,filver		; save version
	tro f,ps%ver		; say we have a version
	
prsfi4:	trnn f,ps%dir		; seen a directory?
	 jrst [hrroi a,fildir	; no, fill in connected directory
	       move b,connum(cx); from tables
	       tlz b,77777	; make into user number
	       write <%2U>
	       tro f,ps%dir	; say there's a directory
	       jrst .+1]
	aos (p)
	popj p,

; routine to check version supplied with file name against open mode bits
; call: pushj p,chkver
;	FILDEV, FILNAM, ... , FILVER set up
;	f/ ps%dev, ... , ps%ver flags set accordingly
;	p3/open mode bits (b0 on means don't actually open file)
; returns: +1, illegal lookup control (error in A, possibly JSYS error)
;	   +2, success, file opened, JFN in A, OPENF mode bits in B
chkver:	ldb a,[point 2,p3,26]	; get explicit version control bits
	pushj p,@chkevd(a)	; dispatch
	 jrst chkvf1		; failed, die
	ldb a,[point 2,p3,28]	; get default handling
	trne f,ps%ver		; version supplied
	 jrst chkve1		; yes, skip this
	pushj p,@chkdvd(a)	; will set GTJFN mode bits on success
	 jrst chkvf1		; fail
chkve1:	trne p3,lfo.cr		; should file be created?
	 tlo a,(1b1)		; say new file only
	pushj p,getjfn
	 jrst chkvf1		; GTFJN failed
; fall through ...

; Routine to OPENF a file whose JFN is in A
; this can be called from OPENLF when a GNJFN operation
; is being performed
chkven:	movsi b,(^d8b5)		; open 8 bit
	trne p3,lfo.rd		; open read?
	 tro b,1b19		; arg for OPENF
	trne p3,lfo.wr!lfo.ex!lfo.cr	; open for write, extend, or create?
	 tro b,1b19!1b20	; arg for OPENF (write implies read because of IFS code)
	movei c,(a)		; hold onto JFN
tops20,<
	pushj p,chkacc		; see if access for this user is allowed
	 pushj p,chkvrf
>
	jumpl p3,[aos (p)
		  popj p,]	; don't open, just return
	openf			; try to OPENF it
	 pushj p,chkvrf
	push p,b		; save OPENF bits
	sizef			; get current byte count
	 jrst [elog <CHKVER: Unexpected JSYS error %1J>
	       popj p,]
	movem b,bytcnt(a)	; save current byte count
	pop p,b
	aos (p)			; success, return JFN in A
	pushj p,getsiz		; get byte size for file
;	tlnn f,(debugf)		; debugging?
;	 popj p,		; no, return here
	hrroi d,temp
	write d,<CHKVER: Open of file >
	jrst chkvrx

; PUSHJ here when OPENF or CHKACC [Tops-20] above fails
; If a contains OPNX9 (file busy), CHKVRF will attempt to unlock
; If unlock is possible, CHKVRF returns +1 with JFN in A
; If not file busy, or unlock not possible, CHKVRF returns to CHKVER's
;   caller with A/ error code from CHKACC or OPNX9
chkvrf:	cain a,OPNX9		; file busy?
	 jrst [movei a,(c)	; get jfn
	       pushj p,unlock	; try to unlock
		jrst [movei a,OPNX9 ; restore error code
		      jrst .+1] ; give fail return
	       popj p,]		; unlocked, succeed
	pop p,(p)		; undo return
	push p,a		; don't clobber error
	movei a,(c)		; release JFN on file
	rljfn
	 log <CHKVRF: Failed to release JFN: %1J>
	pop p,a
chkvf1:	hrroi d,temp
	write d,<CHKVRF: Failed to open file >
; fall through

chkvrx:	push p,a
	push p,b
	hrroi a,fildir
	hrroi b,filnam
	hrroi c,filext
	write d,<%74I%1S%76I%2S.%3S;>
	move a,filver
	write d,<%1D >
	movei a,(cx)
	write d,<for connection %1O%/>
	hrroi a,temp
;	log <%1S>
	pop p,b
	pop p,a
	popj p,

; dispatch for handling explicit version number field
chkevd:	chkev0
	chkev1
	chkev2
	chkev3

; explicit version control says no versions allowed
chkev0:	trne f,ps%ver		; don't allow versions; was there one?
	 jrst [movei a,erIlVr
	       popj p,]; yes, die
skpret:	aos (p)
	popj p,

; explicit version control says file must exist
chkev1:	movsi a,(1b2)		; try a GTJFN on an existing file
	pushj p,getjfn
	 popj p,		; fail
	rljfn
	 jfcl
	jrst skpret

; explicit version control says next or old
chkev2:	pushj p,chkev1		; try old
	 jrst [caie a,GJFX20	; no old version lying around?
		popj p,		; not the problem
	       jrst chkv2a]
	rljfn
	 jfcl
	jrst skpret

; here when old version doesn't exist
chkv2a:	push p,filver		; try highest version
	setzm filver
	movsi a,(1b2)
	pushj p,getjfn
	 popj p,		; shouldn't die here
	move b,[1,,7]
	movei c,c
	gtfdb			; get version number
	hlrz c,c
	aoj c,			; increment version
	pop p,filver		; recover filver
	came c,filver		; equal?
	 jrst [movei a,erIlVr	; no
	       popj p,]
	rljfn
	 jfcl
	aos (p)
	popj p,

; explicit version control says "any"
chkev3:	jrst skpret

; dispatch table for default version handling
chkdvd:	chkdv0
	chkdv1
	chkdv2
	chkdv3
; here when there should be a version number
chkdv0:	popj p,			; fail (here only if no version supplied)

; here to default to lowest version
chkdv1:	movei a,-2
	movem a,filver
	movsi a,(1b2)
	jrst skpret

; here to default to highest version or use next highest
chkdv3:	movsi a,(1b0)
	caia
chkdv2:	movsi a,(1b2)
	setzm filver
	jrst skpret

	
ls gtjblk,16			; storage for long gtjfn
ls fildev,10			; store for device string
ls fildir,10			; storage for directory name
ls filnam,10			; store for file name
ls filext,10			; storage for filename extension
ls filact,10			; storage for default account
ls filprt,1			; file protection
ls filflg,1			; GTJFN flag word
ls filver,1			; store for file version

	subttl	LeafOpen Utilities Utilities

; routine to do GTJFN from stored strings
; call: pushj p,getjfn
;	a/ gtjfn bits in left half
;	FILDEV, ... , FILVER filled in
; returns: +1, failure, GTJFN error code in A
;	   +2, success, JFN in A
getjfn:	move b,[gtjblk,,gtjblk+1]
	setzm gtjblk
	blt b,gtjblk+15

	ior a,[1b11]		; Allow wildcards
	ior a,filflg
	hrr a,filver		; 3/18/82 ejs This should be a HRR, not HRRZ!
	movem a,gtjblk		; save gtjfn flags

	move a,[377777,,377777]	; null I/O
	movem a,gtjblk+1

	move a,[gtjblk+2,,gtjblk+3] ; clear remaining entries
	setzm gtjblk+2
	blt a,gtjblk+10

	hrroi a,fildev		; default device
	skipe fildev
	 movem a,gtjblk+2

	hrroi a,fildir		; default directory
	skipe fildir
	 movem a,gtjblk+3

	hrroi a,temp
	hrroi b,filnam
	hrroi c,filext
	write <%2S.%3S>

	move a,filprt
	movem a,gtjblk+6	; protection

	movei a,filact		; get default account
	move b,usrnum(cx)
	gdacc
;	pushj p,.gdacc##	; see PSVSUP, SMXACC
	 jrst getjf1
	hrroi a,filact
	movem a,gtjblk+7

getjf1:	movei a,gtjblk			; try for JFN
	hrroi b,temp
	gtjfn
	 popj p,			; failed
	setzm wildft(a)			; clear wildcard flag storage
	tlne a,(77b5)			; Any wildcards supplied?
	 movem a,wildft(a)		; save wildcard flags
	movei a,(a)			; clear flags from JFN
	aos (p)
	popj p,				; success, jfn in A

ifn ft20,<
; routine to check access for a file
; call: pushj p,chkacc
;	a/jfn of file
;	b/openf bits
;	cx/connection table index
; returns: +1, access prohibited, error number in A
;	   +2, success
chkacc:	push p,a
	push p,b
	movem a,chkblk+.ckaud		; store JFN in arg block
	move a,usrnum(cx)
	movem a,chkblk+.ckald		; store user number
	move a,connum(cx)
	movem a,chkblk+.ckacd		; store connected directory
	movsi a,(sc%ctc!sc%gtb!sc%log)	; reasonable capabilities
	movem a,chkblk+.ckaec		; store 'em
	move a,b			; get openf bits

	movei b,.ckard			; try read access if necessary
	movem b,chkblk+.ckaac
	trne a,of%rd			; want read?
	 jrst [pushj p,.chkac
		skipa a,[OPNX3]
	         jrst .+1
	       movem a,-1(p)
	       jrst chkacf]
	movei b,.ckawr			; want write?
	movem b,chkblk+.ckaac
	move a,0(p)
	trne a,of%wr
	 jrst [pushj p,.chkac
		skipa a,[OPNX4]
	         jrst .+1
	       movem a,-1(p)
	       jrst chkacf]
	aos -2(p)
chkacf:	pop p,b
	pop p,a
	popj p,

.chkac:	move a,[ck%jfn!5]
	movei b,chkblk
	chkac				; look for capabilities
	 ercal jerr##
	skipe a
	 aos (p)
	popj p,

ls chkblk,6
> ; end ifn ft20

; routine to set up byte size for further I/O
; call: a/ JFN
; returns: +1, always, bytsiz(jfn) set up
getsiz:	push p,a
	push p,b
	push p,c
	pushj p,makldr			; get a leader page, if necessary
	movei a,ldrtyp			; get the file type
	pushj p,getptr	
	ildb c,a			; get size
	cain c,0			; if no bytesize,
	 movei c,2			; assume to be written as binary
	move a,-2(p)			; get JFN
	movei b,^d8			; assume 8 bit bytes
	caie c,2
	 movei b,7			; nope, type text, 7-bit bytes
	movem b,bytsiz(a)		; save it
	movei a,ldrbyt
	pushj p,getptr
	idpb b,a			; store in leader page
	pop p,c
	pop p,b
	pop p,a
	popj p,

; routine to set byte size
; call:	a/JFN
;	b/byte size
; returns: +1, failure (byte size already set)
;	   +2, success, bytsiz(JFN) + file's FDB set up
setsiz:	push p,a
	push p,b
	push p,c
	pushj p,makldr			; make the leader
	movei a,ldrtyp
	pushj p,getptr
	ildb c,a
	caie c,0
	 jrst setsz1			; byte size already exists
	skipn c,-1(p)			; get type
	 movei c,2			; default to vinary
	dpb c,a				; place in leader page
	movei b,^d8			; assume 8-bit bytes
	caie c,2			; binary?
	 movei b,7			; nope, type text, 7-bit bytes
	movei a,ldrbyt			; deposit in leader page
	pushj p,getptr
	idpb b,a
	move a,-2(p)
	movem b,bytsiz(a)		; store in byte size table
	aos -3(p)			; set skip return
setsz1:	pop p,c				; recovers acs and leave
	pop p,b
	pop p,a
	popj p,

	subttl	Filelock mechanisms

; routine to "unlock" a file if it is held by a timed-out sequin
; call: pushj p,unlock
;	a/ jfn of locked file
;	b/ openf bits
; returns: +1, file cannot be unlocked
;	   +2, file unlocked, owning sequin broken
unlock:	push p,a		; save jfn
	push p,b		; save openf bits
	push p,c
	move b,[1,,3]		; get index block address
	movei c,d
	gtfdb
	and d,[000017,,777777]	; just want address
	movsi c,-njfn		; loop through jfn table
unlck0:	push p,c		; save AOBJN pointer
	skipn a,jfntab(c)
	 jrst unlck1		; no jfn
	movei a,(c)		; get JFN
	move b,[1,,3]		; get this file's index block
	movei c,c		
	gtfdb
	and c,[000017,,777777]
	came c,d		; compare them
	 jrst unlck1		; not the same
	hlrz a,(c)		; file same, get owning connection
	move b,seqsta(a)	; get state of sequin for that connection
	cain b,TIMD		; timed out?
 	 jrst unlck2		; yes, give the requestor the connection

unlck3: pop p,(p)		; clean stack of AOBJN pointer
unlck4:	pop p,c			; recover JFN
	pop p,b			; recover bits
	pop p,a			; recover JFN
	popj p,			; return bad

unlck1: pop p,c			; recover AOBJN pointer
	aobjn c,unlck0		; loop until filename found
	jrst unlck4		; not found, open by non-sequin user

; here when file owned by timed out connection
; c/ jfntab index
unlck2:	movei a,400000		; say file lock broken
	pop p,c			; recover AOBJN pointer
	iorm a,jfntab(c)
	movei a,(c)		; close broken sequin's ownership
	tlo a,(1b0)		; don't release JFN
	pushj p,$closf
	 jrst [log <UNLCK2: CLOSF error %1J>
	       jrst unlck3]
	pop p,c			; recover jfn
	pop p,b			; recover openf bits
	pop p,a			; recover jfn
	openf
	 jrst [log <UNLCK2: OPENF error %1J>
	       popj p,]
	aos (p)			; success
	popj p,

	subttl	LeafClose

; routine to close a file
; call: p2/ 16-bit pointer to received request (ILDB gets first word after
;	    opcode)
; returns: +1, always, p2 updated
ClosLf: tlnn f,(debugf)
	 jrst Closl2
	movei a,(cx)
	log <LEAFSV: LeafClose received for connection %1O>
Closl2:	ildb c,p2		; get filehandle
	pushj p,chkhdl		; check validity of filehandle
	 popj p,		; failed, invalid handle
	 jfcl			; file not open, just release JFN
	movei a,(c)		; close file
	pushj p,$closf		
	 log <LEAFSV: Failed to close JFN %3O: %1J>
	move a,[point 16,LfAnPk,31] ; send the answer
	move b,[point 16,LfAnPk]
	dpb c,a
	movei c,LfClos
	jrst LeafOp

; here to CLOSF file, unmapping any mapped pages first
; call: pushj p,$closf
;	a/JFN (b0 on means don't release JFN)
; returns: +1, always.
$closf:	push p,b
	hrrz b,jfntab(a)	; file open?
	 jumpe b,[jumpl a,[pop p,b ; unopened, but want JFN saved; do nothing
			   aos (p)
			   popj p,]
		  setzm wildft(a)
		  setzm jfntab(a)
		  rljfn
		   log <LEAFSV: Failed to release JFN %3O: %1J>
		  pop p,b
		  aos (p)
		  popj p,]
	hlrz b,curpag		; is a page of this file mapped?
	cain b,(a)
	 jrst [push p,a
	       seto a,		; yes, unmap it
	       move b,[400000,,pmpag]
	       pmap
	       setzm curpag
	       pop p,a
	       jrst .+1]
	aos -1(p)		; assume successful CLOSF
	move b,ldrfil
	cain b,(a)		; is this the file in the leader page?
	 pushj p,wrtldr		; update the FDB
	jumpg a,[setzm jfntab(a); if not releasing JFN, hold onto table entries
		 setzm wildft(a)
		 jrst .+3]
	hllzs jfntab(a)
	hllzs wildft(a)		; say not open, otherwise
	closf
	 sos -1(p)		; adjust stack for +1 return on CLOSF error
	pop p,b
	popj p,

	subttl	LeafRead

; routine to read a bytes
; call: pushj p,Readlf
;	p2/ pointer to request packet
; returns +1, always, LeafError sent if necessary
ReadLf: tlnn f,(debugf)
	 jrst ReadL2
	movei a,(cx)
	log <LEAFSV: LeafRead received for connection %1O>
ReadL2:	ildb c,p2		; get filehandle
	pushj p,chkhdl		; check the handle
	 jrst flseop		; failed, flush to end of packet
	 jrst  [movei a,erIlRd	; fail, Illegal Leaf Read
		hrroi b,[asciz/File not open/]
		jrst errLf]
	move b,jfntab(c)	; get openf bits
	trnn b,1b19		; open for read?
	 jrst [hrroi b,[asciz/File is not open for reading./]
	       jrst ReadEr]
	ildb b,p2		; construct leafaddress
	andi b,17777		; mask to 13 bits
	lsh b,^d16
	ildb a,p2
	iori b,(a)		; combine with low order address
	move a,c		; filehandle to A
	caml b,bytcnt(a)	; trying to read past eof?
	 jrst [tlne b,400	; write to leader page?
		jrst .+1
	       move b,bytcnt(a)	; make address EOF
	       setzb d,c	; length 0
	       ibp p2		; increment bytepointer over length
	       jrst ReadL1]	; yes, return no data, starting at EOF
	ildb c,p2		; get length of read
	move d,c		; save length
ReadL1:	caile c,1000		; need multiple read?
	 movei c,1000		; yes
	sub d,c			; adjust residual byte count
	push p,a
	push p,b
	push p,c
	push p,d		; fill in packet
	pushj p,rsin		; do random sin
	move d,[point 16,LfAnPk,31]
	dpb a,d			; deposit jfn
	exch b,-2(p)		; get leaf address
	rot b,-^d16
	idpb b,d
	rot b,^d16
	idpb b,d
	idpb c,d
	exch b,-2(p)		; get pointer to end of packet
	trne c,1		; odd number of bytes?
	 idpb c,b		; make a garbage byte
	move a,b
	move b,[point 16,LFAnPk]
	movei c,LfRead
	pushj p,LeafOp
	pop p,d
	pop p,c
	pop p,b
	pop p,a
	add b,c			; update address to read from
	move c,d
	jumpn d,ReadL1
	popj p,
	
; routine to convert tenex/tops20 time to alto time
; call: pushj p,timalt
;	a/ time in tenex/tops20
; returns: +1, always
;	b/ time in Alto format
timalt:	
ifn ft20,<
	PUSHJ P,TIMTNX		; If tops-20, make into tenex format
>
	HLRZ B,A		; Get days
	SUBI B,^D15385		; Adjust origin to Jan 1, 1901
	IMULI B,^D86400		; Convert days to seconds
	ADDI B,0(A)		; Add seconds increment
	POPJ P,

IFN FT20,<
; Convert Tops20 time format to Tenex format
TIMTNX:	PUSH P,A		; Save day,,fraction
	MOVEI A,(A)		; Isolate fraction
	IMULI A,^D86400		; lh _ number of seconds since midnight
	ADDI A,400000		; Round
	HLRM A,0(P)		; Make TENEX format on stack
	POP P,A			; Recover it
	POPJ P,
>

; here when illegal read encountered
readEr:	movei a,erIlRd
	pushj p,errLf
	jrst flseop
	
	subttl	LeafWrite

; routine to write bytes
; call: pushj p,Writlf
;	p2/ pointer to request packet
; returns +1, always, LeafError sent if necessary
WritLf: movei a,(cx)
	tlne f,(debugf)
	 log <LEAFSV: LeafWrite received for connection %1O>
	ildb c,p2		; get filehandle
	pushj p,chkhdl		; check the handle
	 jrst flseop		; failed, flush to end of packet
	 jrst  [movei a,erIlWr	; fail, Illegal Leaf Write
		hrroi b,[asciz/File not open/]
		jrst errLf]
	move b,jfntab(c)	; get openf bits
	trnn b,1b20!1b22	; open write or append?
	 jrst [hrroi b,[asciz/File is open READ only/]
	       jrst WritEr]
	ildb b,p2		; construct leafaddress
	ldb d,[point 3,b,22]	; get mode and EOF bit
	andi b,17777		; mask to 13 bits
	lsh b,^d16
	ildb a,p2
	iori b,(a)		; combine with low order address
	move a,c		; filehandle to A
	ildb c,p2		; get length of read
	trne d,1		; EOF bit set in address?
	 tro f,tempf1		; yes, remember to set byte count
	lsh d,-1
	pushj p,@[mdanyw	; anywhere
		 mdnoho		; no holes
		 mddntx		; don't extend
		 mdchkx](d)	; check extend
	 jrst WritEr
	caie c,0		; skip if no bytes to write
	 pushj p,rsout		; do the write operation
	tlne b,400		; leader page write?
	 jrst LeafW1		; yes, don't update EOF count
	push p,c		; save length
	add c,b			; compute ending byte
	trnn f,tempf1		; set EOF with this write?
	camle c,bytcnt(a)	; no, but is this a longer byte count?
	 movem c,bytcnt(a)	; yes, save
	pop p,c			; recover length
LeafW1:	trze f,tempf1		; set EOF?
	 jrst  [push p,b	; do the CHFDB
		push p,c
		move c,bytcnt(a)
		hrli a,12
		seto b,
		chfdb		; byte count
		hrli a,11
		movsi b,(77b11)
		move c,bytsiz(a)
		lsh c,^d24
		chfdb		; byte size
		movei a,(a)
		pop p,c
		pop p,b
		jrst .+1]
WrtLf1:	move d,[point 16,LfAnPk,31] ; create answer
	dpb a,d
	rot b,-^d16
	idpb b,d
	rot b,^d16
	idpb b,d
	idpb c,d
	move a,d
	move b,[point 16,LfAnPk]
	movei c,LfWrit
	jrst LeafOp		; send answer and leave


; here on illegal write (illegal extend, no holes error, etc)
; a/ file handle
; b/ pointer to human readable string
WritEr:	movei c,(a)
	movei a,erIlWr
	pushj p,errLf
	jrst flseop

; mode handling routines
; anywhere
mdanyw:	jrst skpret

; no holes
; a/ filehandle, b/ starting address, c/ length of write
mdnoho:	tlne b,400			; leader page write?
	 jrst skpret			; succeed
	push p,b
	push p,c
	sizef				; get size
	aoj b,				; hole if start addr > EOF+1
	camge b,-1(p)
	 jrst [hrroi b,[asciz/Write operation would create hole in file/]
	       movem b,-1(p)
	       jrst mdnohx]
	aos -2(p)
mdnohx:	pop p,c
	pop p,b
	popj p,

; check extend
mdchkx:	tlne b,400			; leader page?
	 jrst skpret			; yes, succeed
	tro f,tempf2			; say send error in case of extend
; don't extend
; a/ filehandle, b/ starting address, c/ length of write
mddntx:	tlne b,400			; leader page write?
	 jrst skpret			; succeed
	push p,c
	push p,b
	addi b,(c)			; compute new EOF
	move d,b
	move b,bytcnt(a)		; get old EOF
	camge b,d			; will this extend?
	 jrst mddnx1			; yes, modify length of write
	aos -2(p)
mddnxx:	pop p,b
	pop p,c
	popj p,

; here to modify length of write to keep EOF extend from happening
mddnx1:	trze f,tempf2
	 jrst [hrroi b,[asciz/Write operation would necessitate EOF extension/]
	       movem b,(p)
	       jrst mddnxx]
	sub b,(p)			; get starting address
	caige b,0			; also catch the no holes case
	 setz b,			; if start addr > old EOF, no write
	movem b,-1(p)			; save new write length
	aos -2(p)
	jrst mddnxx
	
	subttl	LeafDelete

; routine to delete a file
; call: pushj p,DeleLf
; returns: +1, always
Delelf:	movei a,(cx)
	tlne f,(debugf)
	 log <DELELF: LeafDelete received for connection %1O>
	ildb c,p2			; get filehandle
	pushj p,chkhdl
	 jrst flseop			; bad handle
	 jrst  [movei a,erNtDl		; can't delete unless open write?
		hrroi b,[asciz/File not open/]
		jrst errLf]
	move a,jfntab(c)		; get openf bits
	trnn a,1b20!1b22		; open write or append?
	 jrst Delel1			; no, fail
	movei a,(c)			; ok, delete it
	tlo a,(1b0)			; close the jfn
	pushj p,$closf
	 jfcl
	delf
	 jrst [movei a,(c)
	       setzm jfntab(a)
	       rljfn
		jfcl
	       setz b,				; failure
	       jrst errLf]
	setzm jfntab(a)
	rljfn
	 jfcl
	move a,[point 16,LfAnPk,31]
	dpb c,a
	move b,[point 16,LfAnPk]
	movei c,LfDel
	jrst leafOp

; here when delete not allowed (i.e. file not open write or append)
Delel1:	movei a,erNtDl			; file not deletable
	setz b,
	jrst errLf
	subttl	LeafParams

; routine to set Leaf Params
ParmLf:	movei a,(cx)
	tlne f,(debugf)
	 log <LEAFSV: LeafParams received for connection %1O>
	ildb a,p2		; get max pup length
	ildb a,p2		; discard pup length, get file timeout
	ildb b,p2		; get connection timeout
	imuli a,5		; convert to seconds
	imuli b,5
	cain a,0		; any file timeout supplied?
	 movei a,filet		; no, use default
	cain b,0
	 movei b,connt		; use default connection timeout if necessary
	hrl a,b
	pushj p,stlctm##	; set timeout
	move a,[point 16,LfAnPk,31]
	setz b,
 	dpb b,a
	move b,[point 16,LfAnPk]
	movei c,LfParm
	jrst LeafOp
	
	subttl	LeafReset
; routine to do reset
; currently, only checks login name and password
RestLf:	push p,p3
	ildb  p3,p2		; get ResetHosts field
	movsi a,(1b0)		; don't check connect params
	pushj p,.login		; try to log in
	 jrst  [pop p,p3
	 	jrst flseop]	; fail, point to next packet, if it exists
	pushj p,rstcon		; Do resets as directed by ResetHosts field
	pop p,p3		; recover p3
	move a,[point 16,LfAnPk,31] ; respond with ResetHost Answer
	setz b,
	dpb b,a
	move b,[point 16,LfAnPk]
	movei c,LfRest
	jrst LeafOp

; routine to implement ResetHosts
; call: cx/ connection table index for this connection
;	p3/ ResetHosts field
; returns: +1, always
rstcon:	jumpe p3,rsthst		; reset connections from this host
	cain p3,177777		; or is it from this user?
	 jrst rstusr		; yes
	movei a,OPEN
	movem a,seqSta(sq)	; make state = OPEN
	movei a,(cx)
	tlne f,(debugf)
	 log <LEAFSV: LeafReset received for connection %1O>
	popj p,			; else just return

; routine to break all connections logged in under this user
; call: pushj p,rstusr
;	cx/ connection table index
; returns: +1, always, all connections logged in under this user broken
;	       (except this one, of course)
rstusr:	movsi a,-nconn		; set up AOBJN loop
	push p,cx
	movei cx,(cx)		; clean off any left half stuff
rstus0:	move b,usrnum(cx)	; get this user
	came b,usrnum(a)	; get a user
	 jrst rstus1		; not this one
	cain cx,(a)		; make sure we don't kill ourselves
	 jrst rstus1		; this is us
	skipn b,contab(a)	; get sequin data block address
	 jrst rstus1		; no connection here
	movei c,DSTR		; make its state = DeSTRoYed
	movem c,seqSta(b)
rstus1:	aobjn a,rstus0		; loop until all connections scanned
	pop p,cx
	move a,usrnum(cx)
	movei b,(cx)
	tlne f,(debugf)
	 log <LEAFSV: Reset all %1U connections from connection %2O>
	popj p,

; routine to reset connections logged in from this host
; call: pushj p,rsthst
;	cx/ connection table index
; returns: +1 always
rsthst:	movsi a,-nconn		; set up AOBJN loop
	push p,cx
	movei cx,(cx)		; clean off any left half stuff
rsths0:	move b,pupfnh(cx)	; get this user
	came b,pupfnh(a)	; get a user
	 jrst rsths1		; not this one
	cain cx,(a)		; make sure we don't kill ourselves
	 jrst rsths1		; this is us
	skipn b,contab(a)	; get sequin data block address
	 jrst rsths1		; no connection here
	movei c,DSTR		; make its state = DeSTRoYed
	movem c,seqSta(b)
rsths1:	aobjn a,rsths0		; loop until all connections scanned
	pop p,cx
	hlrz a,pupfnh(cx)
	hrrz b,pupfnh(cx)
	movei c,(cx)
	tlne f,(debugf)
	 log <LEAFSV: All connections from %1O#%2O# reset by connection %3O>
	popj p,

	subttl	PropLists
; These routines are extensions to the Leaf protocol, as defined by
; Jeff Mogul in his paper on Leaf and Sequin.  They exist because the
; implementation status of Leaf at that time provided no machine
; independent mechanisms for determining information about a file.
; Leaf had not been used much within Xerox, and certainly not at all
; outside of Xerox; hence, there was no problem in using the machine
; dependent leader page of an IFS file to access file properties.
; Then, one day, along came the Dolphin Lisp machines, and all of a 
; sudden, there were these PDP10's and PDP20's and VAX's which had to
; communicate with the Dolphins.  And the Twenex Leaf implementor said,
; "Why is this Dolphin trying to read byte -4000???"  Anyway, PUPFTP-
; like property lists are supposed to be the solution.
;
;
	COMMENT 
The following documents the Leaf Op formats:

	GetLeafProp
	+--------------+---+-----------+
	|  OP	       | 0 |           |
	+--------------+---+-----------+
	|           Handle             |
	+------------------------------+
	|       Recognition Mode       |
	+------------------------------+
	|       Desired Property       |
	+------------------------------+
	|           Username	       |
	+------------------------------+
	|        User Password         |
	+------------------------------+
	|          Connect Name        |
	+------------------------------+
	|      Connect Password        |
	+------------------------------+
	|           File name          |
	+------------------------------+

If the supplied handle is 0, the file name specified in the OP is looked
up using the supplied user/connect name/password.  If the handle is non-
zero, it is assumed to be a handle valid for the Leaf connection, and the
name and password information is ignored.  In the Tenex/Tops-20 
implementation, if the file name has to looked up, the file will be GTJFN'd
but not OPENF'd.  The desired property is returned in a GetPropAnswer
OP.  If the desired property=PropList, the entire file property list is
returned.  The recognition mode is like the LeafOpenMode (same bits).
If the file has to be looked up, it is forgotten after responding to the
request.

Returns:

	+----------+---+---------------+
	|    OP    | 1 |               |
	+----------+---+---------------+
	|           Handle	       |
	+------------------------------+
	|    Property in IFS string    |
	+------------------------------+

; routine to return file properties
; call: pushj p,PropLf
;	p2/ pointer to request packet
; returns: +1,always
PropLf:	movei a,(cx)
	tlne f,(debugf)
	 log <LEAFSV: LeafGetFileProp received for connection %1O>
propl2:	ildb c,p2		; get handle
	jumpe c,propl3		; if no handle, read filename as in OpenLeaf
	pushj p,chkhdl		; check the handle
	 jrst flseop		; bad handle, error already sent
	 jfcl			; not open; that's OK
; handle still in c at this point!
	ibp p2			; increment past RecognitionMode word
	hrroi a,temp2		; read the desired property
	move b,p2
	pushj p,rifsst
	move p2,b
propl4:	move a,[point 7,temp2]
	move b,[point 7,temp2+10]
	pushj p,genfp		; generate the desired property list
	 jrst flseop		; bad prop, return
	move a,[point 16,LfAnPk,31]
	dpb c,a			; deposit handle	
	hrroi b,temp2+10
	pushj p,wifsst		; write the prop list in
	move b,[point 16,LfAnPk]; point to start of packet
	hrrz d,jfntab(c)	; Is the file open?
	jumpe d,[push p,a
		 movei a,(c)
		 pushj p,$closf
		  jfcl
		 pop p,a
		 jrst .+1]
	movei c,LfProp		; return a LeafProp answer
	jrst LeafOp		; send it and return

; here when file handle supplied is 0; do login and GTJFN as per strings
; in packet
propl3:	push p,p3
	ildb p3,p2		; get OpenMode word
	move b,p2		; read property string
	hrroi a,temp2
	pushj p,rifsst
	move p2,b		; p2 _ updated pointer
	pushj p,.login		; attempt login
	 jrst [pop p,p3
	       jrst flseop]
	hrroi a,temp		; read filename
	move b,p2		; point to IFS string
	pushj p,rifsst
	move p2,b		; save updated pointer in right place
	pushj p,prsfil
	 jrst  [movei a,erNmMl	; fail on malformed name
		hrroi b,[asciz/Malformed name/]
		setz c,
		pushj p,errLf	; send error
		pop p,p3	; recover p3
		popj p,]
	tlo p3,(1b0)		; Tell CHKVER not to open file
	pushj p,chkver
	 jrst  [setzb b,c
		pushj p,errLf
		pop p,p3
		popj p,] 	; return in error
	hrlzm cx,jfntab(a)	; assign the JFN to this cnxtn, but say closed
	pop p,p3		; recover old p3
	movei c,(a)		; get handle into c for prop list code
	jrst propl4		; rejoin proplist code

	subttl	FileHandle utilities

; routine to check validity of file handle
; call: c/ file handle
;	cx/ connection table index
; returns: +1, invalid handle for this connection, ErrorLeaf sent
;	   +2, valid handle
; clobbers b, on success, others in case of error
chkhdl:	skipn jfntab(c)
	 jrst chkhd1		; Bad Handle
	hlrz b,jfntab(c)	; make sure this connection owns the jfn
	caie b,(cx)		; compare with cx
	 jrst chkhd1		; wrong owner
	hrrz b,jfntab(c)	; make sure file lock unbroken
	trne b,400000
	 jrst chkhd2		; file lock broken
	caie b,0
	 aos (p)		; ret +3 if open
	aos (p)			; ret +2 if note
	popj p,

chkhd1:	movei a,erBdHn		; bad file handle
	hrroi b,[asciz/Bad file handle/]
	jrst errLf

chkhd2:	movei a,erBkLf		; file lock broken
	hrroi b,[asciz/File lock broken/]
	jrst errLf


	subttl Property Lists
; routine to generate a property list 
; call: pushj p,genfp
;	a/ pointer to string property desired
;	b/ pointer to place to build output property
;	c/ file handle (JFN)
; returns: +1, unrecognized property
;	   +2, property OK, written in string pointed to by B
; property lists look like Lisp S-expressions:
;    ((Author SCHOEN) (Read-Date 4-Jun-82 15:52) --- )
; Property lists with single entries should be of the same form:
;    ((Author SCHOEN))
genfp:	push p,b
	push p,c
	move b,[-nprops,,pldisp]	; lookup property
	pushj p,fndkey##		; routine from PUPPRP.MAC
	 jrst genfpe			; property in bad format
	 jrst genfpe			; unrecognized property
	move a,0(b)			; get pointer
	pop p,c
	pop p,b
	pushj p,gnpsta			; start the prop list
	movei a,(a)
	pushj p,0(a)			; generate property
	pushj p,gnpend			; end the prop list	
	setz a,
	idpb a,b			; null off string
	aos (p)				; return
	popj p,

genfpe:	movei a,^d609
	hrroi b,[asciz/Unknown Property/]
	pushj p,errLf
	pop p,c
	pop p,b
	popj p,

; known properties
pldisp:	[asciz/Author/],,fpauth
	[asciz/Byte-Size/],,fpbyte
	[asciz/Complete-Filename/],,fpcfil
	[asciz/Creation-Date/],,fpcdat
	[asciz/Property-List/],,fpprop
	[asciz/Read-Date/],,fprdat
	[asciz/Size/],,fpsize
	[asciz/Type/],,fptype
	[asciz/Write-Date/],,fpwdat
nprops==.-pldisp

; routine to start a prop list
; call: pushj p,gnpsta
; 	b/ pointer to start of list 
; returns: +1, always
gnpsta:	tlc b,-1
	tlcn b,-1
	 hrli b,(point 7)
	push p,a
	movei a,"("
	idpb a,b
	pop p,a
	popj p,

; routine to end a prop list
; call: pushj p,gnpend
; 	b/ pointer to end of list 
; returns: +1, always
gnpend:	tlc b,-1
	tlcn b,-1
	 hrli b,(point 7)
	push p,a
	movei a,")"
	idpb a,b
	pop p,a
	popj p,

; routine to copy property name into prop list
; call: pushj p,cpyprp
;	a/ pointer to prop name
;	b/ pointer to output string
; returns: +1, always
cpyprp:	push p,c		; save handle
	tlc a,-1
	tlcn a,-1
	 hrli a,(point 7)
	tlc b,-1
	tlcn b,-1
	 hrli b,(point 7)
cpypr0:	ildb c,a		; get byte
	jumpe c,cpypr1		; leave if null
	idpb c,b
	jrst cpypr0
cpypr1:	pop p,c			; restore handle
	popj p,			; leave

; routines to generate individual file properties
; routine to generate Author
fpauth:	pushj p,gnpsta			; start the item
	hrroi a,[asciz/Author /]	; identify the prop
	pushj p,cpyprp
ifn ft10x,<
	push p,c		; save handle
	push p,b		; save prop list pointer
	movei a,(c)		; handle to A
	move b,[1,,6]		; get author
	movei c,b		; put dir number in B
	gtfdb
	pop p,a			; recover string ptr to A
	dirst			; output string to ptr in A
	 jrst [movei c,^d8	; not in use, write the number instead
	       nout		; write the number
		jfcl
	       jrst .+1]
	move b,a		; string ptr back to B
	pop p,c			; recover handle
>
ifn ft20,<
	movei a,(c)		; get handle in A
	hrli a,1		; get string of last writer
	gfust			; write into string
>
	pushj p,gnpend		; end property
	popj p,			; return

; routine to write byte-size property
fpbyte:	pushj p,gnpsta
	hrroi a,[asciz/Byte-size /]	; name the property
	pushj p,cpyprp
	push p,c
	push p,b
	movei a,(c)
	move b,[1,,11]
	movei c,b
	gtfdb
	ldb b,[point 6,b,11]	; read bytesize out of word
	pop p,a			; recover prop list pointer
	movei c,^d10		; output decimal number
	nout
	 jfcl			; shouldn't fail
	move b,a		; proplist pointer to B
	pop p,c			; recover handle
	pushj p,gnpend		; end entry
	popj p,

; Routine to output file length (in decimal bytes)
fpsize:	pushj p,gnpsta
	hrroi a,[asciz/Size /]	; name the property
	pushj p,cpyprp
	push p,c
	push p,b
	movei a,(c)
	sizef			; ask the operating system
	 jfcl			; better not fail
	pop p,a			; recover prop list pointer
	movei c,^d10		; output decimal number
	nout
	 jfcl			; shouldn't fail
	move b,a		; proplist pointer to B
	pop p,c			; recover handle
	pushj p,gnpend		; end entry
	popj p,

; routine to output Complete-Filename prop
fpcfil:	pushj p,gnpsta
	hrroi a,[asciz/Complete-Filename /] ; copy prop name
	pushj p,cpyprp
	push p,c
	move a,b		; string pointer to A
	movei b,(c)		; jfn to B
ifn ft10x,<
	move c,[1b5+1b8+1b11+1b14+1b35]
>
ifn ft20,<
	move c,[1b2+1b5+1b8+1b11+1b14+1b35]
>
	jfns			; add complete filename
	move b,a		; string ptr to B
	pop p,c			; recover handle
	pushj p,gnpend
	popj p,

; date routines
; read date
fprdat:	pushj p,gnpsta
	hrroi a,[asciz/Read-Date /]	; copy prop name
	pushj p,cpyprp
	push p,c
	push p,b
	movei a,(c)
	move b,[1,,15]			; get read date
	movei c,b
	gtfdb
	jrst fpdate			; join common code

; write date
fpwdat:	pushj p,gnpsta
	hrroi a,[asciz/Write-Date /]	; copy prop name
	pushj p,cpyprp
	push p,c
	push p,b
	movei a,(c)
	move b,[1,,14]			; get read date
	movei c,b
	gtfdb
	jrst fpdate			; join common code

; creation date
fpcdat:	pushj p,gnpsta
	hrroi a,[asciz/Creation-Date /]	; copy prop name
	pushj p,cpyprp
	push p,c
	push p,b
	movei a,(c)
	move b,[1,,13]			; get read date
	movei c,b
	gtfdb
; fall through

; common code to put date in prop list and end item
; date in internal format in B, stack has string pointer in 0(p),
; file handle in -1(p)
fpdate:	pop p,a				; string ptr to A
	setz c,
	odtim
	move b,a			; string ptr to B
	pop p,c				; recover handle
	pushj p,gnpend			; end prop
	popj p,

; routine to output file type
fptype:	pushj p,gnpsta
	hrroi a,[asciz/Type /]
	pushj p,cpyprp
	push p,c
	push p,b
	movei a,(c)
	move b,[1,,11]
	movei c,a
	gtfdb
	ldb a,[point 6,a,11]	; read bytesize out of word
	cain a,^d7		; 7-bit bytes means text
	 jrst [hrroi a,[asciz/Text/]
	       jrst .+2]
	hrroi a,[asciz/Binary/]	; else assume binary
	pop p,b	
	pushj p,cpyprp
	pushj p,gnpend
	pop p,c
	popj p,

; routine to output an entire property list
fpprop:	move d,[-nprops,,pldisp] ; point to dispatch table
fpprp1:	hrrz a,0(d)		; point to next prop
	caie a,fpprop		; avoid recursion
	 pushj p,0(a)		; call the routine for this prop
	aobjn d,fpprp1		; loop while table still exists
	popj p,			; done,leave

	subttl	Paged Disk I/O

; routine to simulate a SIN from a specific point in the file
; call: pushj p,rsin
;	a/jfn
;	b/address in file (bytes)
;	c/length of read
; returns +1, always, data read into LfAnPk, for LeafReadAnswer
rsin:	jumpe c,[move b,[point 8,LfAnPk+2,15]
		 popj p,]
	push p,a
	push p,b
	push p,c
	movsi c,(1b2)		; map read only
	pushj p,getpag		; map a page
	move b,-1(p)		; recover byte address
	tlne b,-400		; negative byte address?
	 jrst [addi b,4000
	       hrrz a,b
	       pushj p,getptr
	       tlc a,(30b11)	; make into an 8-bit byte pointer
	       move c,a
	       move b,[point 8,LfAnPk+2,15]
	       move a,(p)
	       jrst rsin1]
	pushj p,getsiz		; get bytesize	
	move c,bytsiz(a)	; get byte size
	cain c,7
	 jrst [idivi b,5000
	       move b,[point 8,LfAnPk+2,15]
	       idivi c,5
	       add c,[point 7,pmadr,-1
		      point 7,pmadr,6
		      point 7,pmadr,13
		      point 7,pmadr,20
		      point 7,pmadr,27](d)
	       move a,(p)
	       jrst rsin1]
	idivi b,4000		; get index into page
	move b,[point 8,LfAnPk+2,15]
	idivi c,4
	add c,[point 8,pmadr,-1
	       point 8,pmadr,7
	       point 8,pmadr,15
	       point 8,pmadr,23](d); this creates the lh of the byte pointer
	move a,(p)		; get count

; loop here
rsin1:	ildb d,c		; get next byte
	idpb d,b		; put in packet
	soje a,rsin2		; if done, leave
	move d,-2(p)		; get JFN
	move d,bytsiz(d)	; get byte size
	cain d,7
	 jrst [camn c,[point 7,pmadr+777,34] ; run out of buffer page?
		jrst rsin3	; yes
	       jrst rsin1]	; no, loop
	came c,[point 8,pmadr+777,31] ; run out of buffer page?
	 jrst rsin1		; no, loop

rsin3:	move c,(p)		; retrieve count
	sub c,a			; get number of bytes read
	exch b,-1(p)		; get file address
	addi b,(c)		; update for bytes read
	exch a,-2(p)		; retrieve jfn
	movsi c,(1b2)		; map read only
	pushj p,getpag		; get the next page
	exch a,-2(p)		; recover count
	exch b,-1(p)		; recover dest bytepointer
	move c,-2(p)		; get jfn
	move c,bytsiz(c)	; get byte size
	cain c,7
	 jrst [move c,[point 7,pmadr,-1]
	       jrst rsin1]
	move c,[point 8,pmadr,-1] ; new source byte pointer
	jrst rsin1		; loop

; here when done
rsin2:	tlc b,(30b11)		; make packet end pointer 16 bits
	movem b,-1(p)		; save pointer to packet end
	pop p,c			; clean stack 
	pop p,b
	pop p,a
	popj p,


; routine to put file page in core buffer
; call: pushj p,getpag
;	a/jfn
;	b/address, in 8-bit bytes
;	c/pmap bits
; returns: +1 always
getpag:	push p,a
	tlne b,400		; negative byte address?
	 jrst getpg2		; yes, get leader page
	push p,c
	move c,bytsiz(a)	; get bytsize
	cain c,7		; text file?
	 jrst [idivi b,5	; yes, 5 bytes/word
	       jrst .+2]
	idivi b,4		; convert to word address
	lsh b,-^d9		; convert word address to page
	pop p,c
	hrl a,a
	hrri a,(b)		; set up for PMAP
	camn a,curpag		; is that page in core now?
	 jrst getpg1		; yes, don't pmap
	movem a,curpag		; no, save it
	seto a,
	move b,[400000,,pmpag]
	pmap			; unmap previous page in core
	move a,curpag
	pmap
	pop p,a
	popj p,

; here when page in core is that which is desired.  Adjust access
; c/ pmap bits
getpg1:	push p,b
	move a,[400000,,pmpag]
	move b,c
	spacs			; change access bits
	pop p,b
	pop p,a
	popj p,

; here when a leader page address is desired
getpg2:	pushj p,makldr		; make the leader page
	pop p,a
	popj p,

ls curpag,1			; contains jfn,,page # for page in buffer

; Routine to simulate a SOUT to a specific point in the file
; call: pushj p,rsout
;	a/jfn
;	b/address in file (bytes)
;	c/length of read
; returns +1, always, data read from LeafPk into file
rsout:	push p,a
	push p,b
	push p,c
	movsi c,(1b2!1b3)	; map read, write
	pushj p,getpag		; map a page
	move b,-1(p)		; recover byte address
	tlne b,400		; negative byte address
	 jrst [addi b,4000
	       hrrz a,b
	       pushj p,getptr
	       tlc a,(30b11)
	       move c,a
	       move b,[point 8,LeafPk+2,15]
	       move a,(p)
	       jrst rsout1]
	pushj p,getsiz		; get byte size
	move c,bytsiz(a)	; get bytesize
	cain c,7
	 jrst [idivi b,5000
	       move b,[point 8,LeafPk+2,15]
	       idivi c,5
	       add c,[point 7,pmadr,-1
		      point 7,pmadr,6
		      point 7,pmadr,13
		      point 7,pmadr,20
		      point 7,pmadr,27](d)
	       move a,(p)
	       jrst rsout1]
	idivi b,4000		; get index into page
	move b,[point 8,LeafPk+2,15]
	idivi c,4
	add c,[point 8,pmadr,-1
	       point 8,pmadr,7
	       point 8,pmadr,15
	       point 8,pmadr,23](d); this creates the lh of the byte pointer
	move a,(p)		; get count

; loop here
rsout1: ildb d,b		; get next byte
	idpb d,c		; put in packet
	soje a,rsout2		; if done, leave
	move d,-2(p)		; get JFN
	move d,bytsiz(d)	; get bytesize
	cain d,7
	 jrst [camn c,[point 7,pmadr+777,34] ; run out of buffer page?
		jrst rsout3	; yes
	       jrst rsout1]	; no, loop
	came c,[point 8,pmadr+777,31] ; run out of buffer page?
	 jrst rsout1		; no, loop

rsout3:	move c,(p)		; retrieve count
	sub c,a			; get number of bytes read
	exch b,-1(p)		; get file address
	addi b,(c)		; update for bytes read
	exch a,-2(p)		; retrieve jfn
	movsi c,(1b2!1b3)	; map read, write
	pushj p,getpag		; get the next page
	exch a,-2(p)		; recover count
	exch b,-1(p)		; recover dest bytepointer
	move c,-2(p)		; get JFN
	move c,bytsiz(c)	; get bytesize
	cain c,7
	 jrst [move c,[point 7,pmadr,-1]
	       jrst rsout1]
	move c,[point 8,pmadr,-1] ; new source byte pointer
	jrst rsout1			; loop

; here when done
rsout2:	tlc b,(30b11)		; make packet end pointer 16 bits
	pop p,c			; clean stack 
	pop p,b
	pop p,a
	popj p,


; ---------------------------------------------------------------------
;	UUO handler routines specific to PSVLEF (Stolen from PUPSRV)
; ---------------------------------------------------------------------


; Log given string with formatting actions
%ULOG::	TLZA F,(LGTTYF)		; Log only on file

; Log and type the given string with formatting actions
%UELOG::TLO F,(LGTTYF)		; Log on both file and TTY
	PUSHJ P,FORMAT##	; Call formatter
	 PUSHJ P,BEGLOG		; Setup -- begin log entry
	 PUSHJ P,ENDLOG		; Completion -- end log entry
	POPJ P,			; Return from UUO

; UUOs not used in the server
%LETC:: %URUNM:: %UNOIS:: %UPROM:: %UFTPM:: PUSHJ P,SCREWUP##


; Individual functions for escape sequences

; P - Selected address from Pup pointed to by PB
;	1P = Destination, 2P = Source
%LETP::	PUSH P,A		; Save string ptr
	CAIL C,1		; Make sure arg in range
	CAILE C,3
	 PUSHJ P,SCREWUP
	XCT [	PUSHJ P,GTDPRT	; 1 = Destination Port
		PUSHJ P,GTSPRT]-1(C) ; 2 = Source Port
	MOVE D,C		; Copy socket
	MOVSI C,(A)		; Make net,,host
	HRRI C,(B)
	POP P,A			; Recover string ptr
	MOVE B,[1B2+C]		; Full expansion, constants allowed
	PUPNM			; Convert address to string
	 PUSHJ P,SCREWUP
	POPJ P,

; Routines to return source and destination ports
; Get Destination Port from Pup
;	PB/ Packet buffer ptr
; Returns +1:
;	A/ Net, B/ Host, C/ Socket

GTDPRT::MOVE A,PBHEAD+2(PB)	; Get net/host and high socket
	MOVE C,PBHEAD+3(PB)	; Get low socket
	LSHC A,-^D28		; Right-justify net
	LSH B,-^D12		; Right-justify high socket
	LSHC B,-^D16		; Concatenate, right-justify host
	LSH C,-4		; Right-justify socket
	POPJ P,

; Get Source Port from Pup
;	PB/ Packet buffer ptr
; Returns +1:
;	A/ Net, B/ Host, C/ Socket

GTSPRT::LDB A,PPUPSN		; Get net
	LDB B,PPUPSH		; Get host
	LDB C,PPUPSS		; Get socket
	POPJ P,


; -----------------------------------------------------------------
;	Logging routines
; -----------------------------------------------------------------

; Begin a log entry
;	CX/ Connection index of connection being considered
;	SQ/ Sequin data block pointer
; Returns +1, A/ string ptr to logging buffer
; Clobbers B, C

BEGLOG:	PUSHJ P,LOKLOG		; shut off interrupts if on
	MOVE A,LOGBPT		; Get current byte ptr
	SETO B,			; Default time to now
	MOVSI C,(1B10+1B12)	; Suppress seconds and colon
	ODTIM			; Log the date and time
	MOVEI B," "		; A space
	IDPB B,A
	SKIPL B,FX
	 SUBI B,400000		; Convert to small number if not top fork
	MOVE C,[1B2+2B17+10B35]	; 2 digits, octal radix
	NOUT			; Record connection #
	 JRST [ MOVEI B,"?"	; If FX bad, just print ??
		IDPB B,A
		IDPB B,A
		JRST BEGLO1 ]
BEGLO1:	MOVEI B," "		; Another space
	IDPB B,A
	POPJ P,

; End a log entry
;	A/ Used string ptr (into logging buffer)
; Returns +1

ENDLOG:	HRROI B,[ASCIZ /
/]
	SETZ C,			; Append crlf and null
	SOUT
	MOVE C,LOGBPT		; Get start of string
	MOVEM A,LOGBPT		; Update pointer to end
	TLNE F,(DEBUGF)		; Debugging?
	 JRST [	MOVEI A,101	; Yes, always print on TTY
		DOBE		; Avoid intermixed messages
		JRST ENDLO2]	; Go type
	TLNN F,(LGTTYF)		; No, serious error?
	 JRST ENDLO3		; No, print nothing
	TIME			; Yes, get now
	SUBM A,LTTTIM		; Compute time since last we did this
	EXCH A,LTTTIM		; Save now, get interval
	CAIGE A,^D30000		; Too soon?
	 JRST ENDLO3		; Yes, don't hog the logging TTY
	MOVEI A,101		; Wait for logging TTY to be free
	DOBE
	HRROI A,[ASCIZ /**LEAFSV /]  ; Identify source of message
	PSOUT
ENDLO2:	MOVE A,C		; Recover message pointer
	PSOUT			; Print message
ENDLO3:	HRRZ A,LOGBPT		; Get rh of current pointer
	CAIGE A,LOGBUF+LOGBFS/2	; More than half full?
	 JRST ULKLOG		; No, unlock buffer and return
	JRST DMPLO1

LS LTTTIM		; Time we last printed on logging TTY

; Logging routines (cont'd)

; Initialize logging package
; Returns +1
; Clobbers A

INILOG:	MOVE A,[POINT 7,LOGBUF]	; Initialize byte ptr into buffer
	MOVEM A,LOGBPT
	TIME			; Get now
	ADD A,[LOGLAT*^D1000]	; Compute time to force dump
	MOVEM A,LOGTIM		; Store it
	SETOM LOGLOK		; Free the logging lock
	POPJ P,

; Routine to lock logger
LOKLOG:	AOSE LOGLOK
	 JRST [CAMN FX,LOGLKR	; Do we own the log lock?
		POPJ P,		; Yes, just return
	       JRST .-1]	; No, loop on getting it
	MOVEM FX,LOGLKR		; Save locker of log
	POPJ P,

; Routine to call on exiting logging code
ULKLOG:	SETOM LOGLOK
	POPJ P,

; Dump log buffer on file
; Returns +1
; Clobbers A-C

DMPLOG::SKIPGE LOGBPT		; Any text buffered?
	 JRST DMPLO5		; No, just reset clock
	PUSHJ P,LOKLOG
DMPLO1:	MOVSI C,(1B8+1B17)	; Ignore deleted, short form
DMPLO2:	MOVE A,C		; Get bits
	HRROI B,[ASCIZ /<SYSTEM>LEAFSV.LOG/]
	TLNE F,(DEBUGF)		; Debugging?
	 HRROI B,[ASCIZ /LEAFSV.LOG/]  ; Yes, make private log
	GTJFN			; Look for an existing log file
	 JRST [	TLON C,(1B0)	; Failed, maybe make a new version
		 JRST DMPLO2	; Try again
		MOVE C,A	; Save reason for failure
		JRST DMPLO3]	; Already did, give up
	MOVE C,A		; Ok, save JFN
	MOVE B,[7B5+1B22]	; Open for append
	OPENF
	 JRST [	EXCH A,C	; Failed, recover JFN
		RLJFN		; Release it
		 CAI
		HRRZ A,LOGBPT	; Look at buffer pointer again
		CAIGE A,LOGBUF+LOGBFS-^D<200/5>  ; Desperately full?
		 JRST DMPLO4	; No, leave it and try again later
		JRST DMPLO3]	; Yes, flush buffer
	HRROI B,LOGBUF		; Ok, make string ptr to log buffer
	SETZ C,			; Until null
	SOUT			; Append bufferful to log file
	CLOSF			; Close it
	 CAI			; Huh?
	MOVE A,[POINT 7,LOGBUF]	; Reinitialize buffer pointer
	MOVEM A,LOGBPT
DMPLO4:	PUSHJ P,ULKLOG
DMPLO5:	TIME			; Get now
	ADD A,[LOGLAT*^D1000]	; Compute time to force dump
	MOVEM A,LOGTIM
	POPJ P,			; Done

; Here if failed to open file. C has jsys error code
DMPLO3:	MOVE A,[POINT 7,LOGBUF]	; Reset buffer pointer
	MOVEM A,LOGBPT
	PUSHJ P,ULKLOG
	JRST DMPLO5

GS LOGTIM		; Time of last real append to log file
GS LOGBPT		; Byte ptr into LOGBUF
GS LOGBUF,LOGBFS	; Buffer region for logging entries
GS LOGLOK		; Lock word on Log
GS LOGLKR		; Owner of lock on log

	subttl	IFS Leader page simulations

; These routines manage a image of an IFS leader page created from
; information contained in a Twenex FDB.  These routines exist 
; because the Xerox 1100 Scientific Information Processor (Dolphin
; Lisp machine) uses various entries in the leader page to store/
; retrieve information about a file.  This is a hopelessy machine 
; dependent mechanism which will eventually be replaced by a file
; property list system.  Until then, we suffer.

; The following is a layout of the IFS file leader page:

;	WORD			ENTRY			LENGTH (WORDS)
;	----			-----			______________

;	  0		Creation time				2
;	  2		Write time				2
;	  4		Read time				2
;	  6		Name					24
;	 32		Leader properties			322
;	354		Spare					12
;	366		Property begin|length			1
;	367		Consec bit|changeSerial byte		1
;	370		dirFp					5
;	375		hintLastPageFA				3
;	400		Complete IFS pathname			62
;	462		Inherited properties			14
;	476		Author					24
;	522		Last backup time			2
;	524		File type				1
;	525		File bytesize				1
;	526		IFS flags				1

ldrcre==0_1		; Creation time
ldrwri==2_1		; Write time
ldrrea==4_1		; Read time
ldrnam==6_1		; Name
ldrprp==32_1		; Leader properties
ldrspr==354_1		; Spare
ldrpr1==366_1		; Property begin
ldrbit==367_1		; Consec bit|changeSerial byte
ldrdfp==370_1		; dirFp
ldrhnt==375_1		; hintLastPageFA 
ldrcnm==400_1		; Complete IFS pathname
ldrinh==462_1		; Inherited properties
ldraut==476_1		; Author
ldrbkp==522_1		; Last backup time
ldrtyp==524_1		; File type
ldrbyt==525_1		; File bytesize
ldrflg==526_1		; IFS flags

; routine to return a bytepointer to a property in leader page
; call: pushj p,getptr
;	a/byte offset into leader page
;	p1/address of leader page in core
; returns: +1, always, 16-bit bytepointer in a
getptr:	push p,b
	idivi a,4		; compute word offset
	subi b,4		; compute bytepointer offset quantity
	movns b			; b has 1, 2, 3, or 4
	lsh b,3			; b has 10, 20, 30, 40
	addi b,4		; b has 14, 24, 34, 44
	lsh b,6			; b has 1400, 2400, 3400, 4400
	addi b,20		; b has 1410, etc
	lsh b,^d24		; b has 142000,,0, etc
	ior a,b			; make the bytepointer
	addi a,ldrpag		; point into the leader
	pop p,b
	popj p,

	
; routine to store a time into the leader page
; call: pushj p,stotim
;	a/Internal time
;	b/bytepointer to leader page offset
;	p1/address of leader page
; returns: +1, always
; clobbers a (returns Alto time format right-justified)
stotim:	push p,a		; save time
	move a,b		; get byte offset into a
	pushj p,getptr		; make a bytepointer
	move b,a		; save bytepointer in b
	pop p,a			; restore time to a
	push p,b		; save b
	pushj p,timalt		; Convert to Alto time (ret'd in b)
	move a,b		; move to a
	pop p,b			; restore bytepointer
	rot a,-^d16		; get high byte
	idpb a,b		; deposit
	rot a,^D16		; get next lower byte
	idpb a,b		; deposit
	popj p,	

; routine to translate Twenex FDB to leader page
; call: pushj p,makldr
;	a/JFN of file
; returns: +1, always
makldr:	camn a,ldrfil		; this JFN already in leader page?
	 popj p,		; yes, return now
	push p,b
	push p,c
	skipe ldrfil		; anything in the leader page?
	 pushj p,wrtldr		; yes, write it out
	move b,[25,,0]		; read the entire FDB
	movei c,fdbblk
	gtfdb
	push p,a		; save JFN
	movem a,ldrfil		; save JFN of file in LDRPAG
	move a,fdbblk+13	; get create time
	movei b,ldrcre
	pushj p,stotim
	move a,fdbblk+14	; get write time
	movei b,ldrwri
	pushj p,stotim
	move a,fdbblk+15	; get read time
	movei b,ldrrea
	pushj p,stotim
ifn ft10x,<
	move a,fdbblk+21	; get last dump time (Tenex only)
	movei b,ldrbkp
	pushj p,stotim
>
	hrroi a,temp		; write name of file
	move b,(p)		; get JFN
	move c,[1b8+1b11+1b14+1b35] ; print name.ext;version
	jfns
	movei a,ldrnam		; get pointer
	pushj p,getptr
	hrroi b,temp
	pushj p,wbcpst		; write into leader page
	hrroi a,temp
ifn ft10x,<
	move c,[1b5+1b8+1b11+1b14+1b35]
>
ifn ft20,<
	move c,[1b2+1b5+1b8+1b11+1b14+1b35]
>
	move b,(p)		; now format the "complete IFS pathname"
	jfns
	movei a,ldrcnm
	pushj p,getptr
	hrroi b,temp
	pushj p,wbcpst		; and store in core
	move a,fdbblk+11	; get bytesize
	ldb b,[point 6,a,11]
	movei a,ldrbyt
	pushj p,getptr
	idpb b,a		; store bytesize
	movei c,2		; assume type is binary
	cain b,7		; 7-bit bytes?
	 movei c,1		; Yes, type is text
	movei a,ldrtyp
	pushj p,getptr
	idpb c,a		; store file type
ifn ft10x,<
	hlrz b,fdbblk+6		; get directory number of last writer
	hrroi a,temp		; make it into a string
	dirst
	 jrst [hrroi a,temp	; not in use, write a number, instead
	       movei c,^d8
	       nout		; write the number
		jfcl
	       jrst .+1]
	movei a,ldraut
	pushj p,getptr
	hrroi b,temp
	pushj p,wbcpst		; write the author string
>
ifn ft20,<
	move a,(p)		; get JFN
	hrli a,1		; get string of last writer
	hrroi b,temp
	gfust			; get it
	movei a,ldraut
	pushj p,getptr
	hrroi b,temp
	pushj p,wbcpst		; write the author string
>
	pop p,a			; retrieve the JFN
	pop p,c
	pop p,b
	popj p,			; leave

lsp ldrpag			; page on which to build IFS leader page
ls ldrfil			; has JFN of file in leader page, 0 if empty

; routine to write leader page back into Twenex FDB
; to be supplied
; call: pushj p,wrtldr
; returns: +1, always
; clobbers b,c
wrtldr:	push p,a
	movei a,ldrtyp
	pushj p,getptr
	ildb b,a		; get file type from leader
	move a,fdbblk+11	; get bytesize from FDB
	ldb a,[point 6,a,11]
	cain a,0		; don't change it FDB already has size
	 jrst [hrrz a,ldrfil	; change it
	       hrli a,11
	       movei c,^d8	; assume binary file
	       caie b,2		; binary?
		movei c,^d7	; nope, text, write 7-bit bytes
	       movei b,(c)
	       setz c,
	       dpb b,[point 6,c,11]
	       movsi b,007700
	       chfdb
	       jrst .+1]
	setzm ldrfil
	pop p,a
	popj p,


ls fdbblk,25
ls temp,100		; temp storage
ls temp2,140		; another temp storage area
ls LeafPk,200		; Leaf packet reception space
ls LfAnPk,200		; answer space

; Tables indexed by JFN
gs jfntab,njfn		; connection owner,,open mode
gs wildft,njfn		; GTJFN flags for JFN
gs bytsiz,njfn		; byte size file written in
gs bytcnt,njfn		; number of bytes in the file

; Tables indexed by CX
gs connum,nconn
gs usrnum,nconn

ls stack,stksiz			; sequin stack
ls lfpdl,lflpdl			; leaf stack

ls leafcx			; debugging info

	end start