Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 5-galaxy/lpd.mac
There are no other files named lpd.mac in the archive.
;[SRI-NIC]SRC:<5-GALAXY>LPD.MAC.102, 31-May-88 15:28:58, Edit by MKL
; add hack to PRINT routine to set last writer of spool file
; to be string "}filename" so spoolers can use it on header page
;[SRI-NIC]SRC:<5-GALAXY>LPD.MAC.94, 30-May-88 17:16:57, Edit by MKL
; if filename ends in ".ps" then set things for postscripting
;[SRI-NIC]XS:<5-GALAXY>LPD.MAC.88, 20-Nov-87 16:01:37, Edit by MKL
; fix user name on create job call to quasar
;[SRI-NIC]XS:<5-GALAXY>LPD.MAC.87, 28-Oct-87 16:14:53, Edit by MKL
; allow anyone to print on us for now
; need better checking once we have our own net
;XS:<5-GALAXY>LPD.MAC.86,  4-May-87 14:40:02, Edit by KNIGHT
; Some more close error logs
;XS:<5-GALAXY>LPD.MAC.85,  4-May-87 14:31:17, Edit by KNIGHT
; Log file close errors in DOPR
;XS:<5-GALAXY>LPD.MAC.84, 21-Jan-87 14:53:03, Edit by KNIGHT
; Remove send to quasar
;SRC:<5-GALAXY>LPD.MAC.83, 17-Jun-86 09:54:03, Edit by KNIGHT
;SRC:<5-GALAXY>LPD.MAC.82, 11-Jun-86 11:37:44, Edit by KNIGHT
; Rework host name parsing so that SRI- and .ARPA always get flushed
;SRC:<5-GALAXY>LPD.MAC.81, 11-Jun-86 11:23:04, Edit by KNIGHT
; make sure all users can use our printers.
;SRC:<5-GALAXY>LPD.MAC.80, 11-Jun-86 10:57:03, Edit by KNIGHT
;Flush pup
;SS:<5-1-GALAXY>LPD.MAC.78,  2-Dec-85 22:39:16, Edit by PIERRE
; Make access checking at CSLI the same as LOTS
;<5-1-GALAXY>LPD.MAC.77, 15-Nov-85 14:56:52, Edit by HEGARTY
; Blast edit number 76/53.  It doesn't work ...
;<5-1-GALAXY>LPD.MAC.77, 15-Nov-85 14:47:07, Edit by HEGARTY
; Make it look at SPOOL: at LOTS instead of PS:<SPOOL>
;<5-1-GALAXY>LPD.MAC.77, 15-Nov-85 14:46:49, Edit by HEGARTY
; Make access check at LOTS be whether or not the user has
; an account on the requesting machine too.
;SS:<5-1-GALAXY>LPD.MAC.76, 11-Nov-85 10:45:25, Edit by PIERRE
; Skip access checking at CSLI
;<5-1-GALAXY>LPD.MAC.75,  2-Aug-85 20:19:08, Edit by WHP4
; start work on more general filter mechanism
;<5-1-GALAXY>LPD.MAC.74, 27-Jun-85 13:53:30, Edit by WHP4
; finish up 57 after much tedium
;<5-1-GALAXY>LPD.MAC.63, 26-Jun-85 20:34:13, Edit by WHP4
; more of edit 57
;<5-1-GALAXY>LPD.MAC.59, 26-Jun-85 17:09:53, Edit by WHP4
; copy DDT's section (37) for ease in debugging
;<5-1-GALAXY>LPD.MAC.58, 26-Jun-85 16:12:59, Edit by WHP4
;<5-1-GALAXY>LPD.MAC.57, 26-Jun-85 15:27:05, Edit by WHP4
; add support for running pr(1) over files so requested when spooled
;<WHP4>LPD.MAC.65, 12-Jun-85 00:44:25, Edit by WHP4
; log flushing of command cards
;HYPER:<WHP4>LPD.MAC.55, 11-Jun-85 17:01:24, Edit by WHP4
; support more printjob cards - send mail to user when queued
;<5-1-GALAXY>LPD.MAC.53,  6-May-85 01:06:50, Edit by HEGARTY
; Skip access checking at LOTS
;<5-1-GALAXY>LPD.MAC.52, 26-Apr-85 16:42:33, Edit by LOUGHEED
;<5-1-GALAXY>LPD.MAC.51, 26-Apr-85 15:10:24, Edit by LOUGHEED
; QUOTE quotes dots so that dots in strings like dfA345SU-SIERRA.ARPA
;  aren't treated as filename punctuation by other routines
; Put some code in STANSW and PUPSW conditionals
;<5-1-GALAXY>LPD.MAC.50, 18-Apr-85 15:50:01, Edit by WHP4
; bump maxidl to 2
;<WHP4>NLPD.MAC.49, 28-Mar-85 19:25:23, Edit by WHP4
; strip off SU- prefixes, .ARPA suffixes
;<WHP4>NLPD.MAC.48, 26-Mar-85 17:50:05, Edit by WHP4
; fix slipped bit
;<WHP4>NLPD.MAC.47, 26-Mar-85 17:24:18, Edit by WHP4
; damn MACRO's angle-bracket parser!
;<WHP4>NLPD.MAC.46, 26-Mar-85 17:21:30, Edit by WHP4
;<WHP4>NLPD.MAC.45, 26-Mar-85 17:07:45, Edit by WHP4
; clean up pup dependencies, compartmentalize access checking a bit.
; flush previous edit history
TITLE LPD - Internet Line Printer Server
SUBTTL Bill Palmer / Stanford University / February 1985

COMMENT =

LPD is based on a program by the same name written by Chris Maio, 
of Columbia University (CHRIS@COLUMBIA-20).

LPD provides a one-way interface between 4.2BSD and TOPS-20 print
spoolers.  LPD listens for incoming print requests from the network
and queues them for the requested printer, using the utility routines
in LPDQSR.MAC.

=
SEARCH MONSYM, MACSYM, LPDMAC
.REQUIRE SYS:MACREL, LPDQSR, SNDMAI
EXTERN GETPID,CREATE,CANCEL,LISTQ,SNDQSR,RCVQSR,SNDMAI

IFNDEF STANSW,<STANSW==0>	;Stanford dependencies
IFNDEF LOTSW,<LOTSW==0>		;LOTS dependencies
IFNDEF CSLISW,<CSLISW==0>	;CSLI dependencies
IFE NICSW,<
IFN STANSW,<PUPSW==1>		;If Stanford, we have PUP protocol support
>;IFE NICSW
IFN NICSW,<
PUPSW==0
>;IFN NICSW
IFE STANSW,<PUPSW==0>		;Elsewhere we don't have PUP

;version information
VMAJOR==0			
VMINOR==2
VEDIT==63
VWHO==0				;0 = WHP4

STDAC.				;standard ac definitions
F=0				;flags
A=1				;temporary acs
B=2
C=3
D=4
FX=14				;fork index for FKnnn DEFSTRs
P=17				;stack pointer

PDLEN==1000			;length of stack
LINLEN==100			;length of line buffer
BUFLEN==200			;length of general purpose buffer

PURDAT==2000			;start of pure data psect (PURE)
SUPDAT==5000			;start of superior-only data psect (SDATA)
SUPCOD==10000			;start of superior-only code psect (SCODE)
INFDAT==400000			;start of per-fork data psect (IDATA)
INFCOD==420000			;start of per-fork code psect (ICODE)
PURLEN==SUPDAT-PURDAT		;length of pure data psect
INDLEN==INFCOD-INFDAT		;length of per-fork data psect
INFLEN==50000			;length of per-fork code psect

.PSECT PURE,PURDAT
.ENDPS

.PSECT SDATA,SUPDAT
.ENDPS

.PSECT SCODE,SUPCOD
.ENDPS 

.PSECT IDATA,INFDAT
.ENDPS

.PSECT ICODE,INFCOD
.ENDPS

IFNDEF FTLOG,<FTLOG==1>		;we want logging
IFNDEF DEBUG,<DEBUG==1>		;we want debugging
IFNDEF FTMAP,<FTMAP==1>		;copy ourself instead of gtjfn/get
IFNDEF MAXIDL,<MAXIDL==2>	;maximum idle forks allowed
IFNDEF NFKS,<NFKS==5>		;maximum simultaneous connections
IFNDEF MXPIDS,<MXPIDS==NFKS>	;maximum pid quota desired (1/subfork)
TMRCHN==0			;timeout channel
IFN DEBUG,STSCHN==1		;status interrupt channel (^A)

IFN DEBUG,PICHNS==1B<.ICIFT>!1B<TMRCHN>!1B<STSCHN> ;int channels
IFE DEBUG,PICHNS==1B<.ICIFT>!1B<TMRCHN>	;int channels

IFNDEF REQINT,<REQINT==^D<1*60*1000>> ;request timeout = 1 minute
IFNDEF JOBINT,<JOBINT==^D<5*60*1000>> ;print job timeout = 5 minutes
IFNDEF CLSINT,<CLSINT==^D<10*1000>>   ;closf% timeout = 10 seconds
IFNDEF RSTINT,<RSTINT==^D<5*60*1000>> ;error restart delay = 5 minutes

INIJFN==0			;offset of net JFN in AC block at startup
RANK==1				;offset of flag for inferior  "" "" ""
; fork variables
;
; the current fork index (not a TOPS-20 fork handle) is always kept in
; ac FX, so indexing into the fork table is done implicitly by the following
; defstrs.

DEFSTR FH,FKSTAT(FX),17,18	; TOPS-20 fork handle
DEFSTR FKRUN,FKSTAT(FX),18,1	; 1 if fork is currently running
DEFSTR FKJFN,FKSTAT(FX),35,9	; fork's network jfn
IFN DEBUG,<
DEFSTR FKCT,FKTIM1(FX),35,36	;fork's console time when started
DEFSTR FKRT,FKTIM2(FX),35,36	;fork's cpu time when started
>;IFN DEBUG
 
;PRINTF routines
;<CS-SOURCES>PRINTF.MAC.31, 25-May-84 21:48:47, Edit by CHRIS
; allow "*" in place of field width so user can specify the address
; of a format word for the following functions: o,d,r,c,t,f. %*e takes
; the address of either an error code or a fork handle; %*h means use dot
; notation.
;<CS-SOURCES>PRINTF.MAC.13, 23-Mar-84 04:39:36, Edit by CHRIS
; add %h - print a host name, for tcp/ip
;<CS-SOURCES>PRINTF.MAC.12, 19-Mar-84 05:10:46, Edit by CHRIS
; add %l (go to left margin), formerly done with negative arg to %n
;<CHRIS>PRINTF.MAC.2, 14-Mar-84 06:10:35, Edit by CHRIS
; add %p ("push"), like %j but does uses SOUTR% (for DECnet, TCP/IP)
; add erjmp/ercal simulation (mostly for %p), e.g.
; 	printf <%p...>,<netjfn>
;	 erjmp ioerr
;PS:<MACRO-LIBRARY>PRINTF.MAC.2,  6-Mar-84 17:11:56, EMACSed by Sy.Bill
; Add %r to print a real number.
;<CS-SOURCES>PRINTF.MAC.7, 20-Feb-84 12:56:18, Edit by CHRIS
; Change %J to %F, %= to %J, %= now sets output designator to immediate value
; (mostly to save typing and reduce errors due to typos)
; Arguments to %S are now immediate values, so buffer addresses can be used
; instead of literals containing byte pointers.

.PSECT ICODE

define printf (s,args) <
	if1,<.....p==0>
 	call doprin			;; call the routine to do the work
	 trn [	point 7,[asciz s]	;; pointer to format string
		irp <args>,<
		if1,<ifb <args>,<.....p==1>>
				 	;; flag null argument seen in
					;;  argument list - argument
					;;  probably needs quoting with <>'s
		z args>			;; expand the argument
		]			;; that's it
if1,<	ifn <.....p>,<printx ? BAD ARGUMENTS "args" FOR PRINTF "s">
	 purge .....p>
>;printf

; Note: When specifying the argument list, arguments containing commas
; may be interpreted incorrectly, due to the way the assembler interprets 
; commas within macro arguments, e.g.
; 	printf <This string has a %s%n>,<[point 7,[asciz "bad arg"]]>
; generates the error
;	? BAD ARGUMENT LIST FOR PRINTF "This string has a %s%n"
;
; The solution is to surround any arguments containing commas with <>, e.g.
;	printf <This string has no %s%n>,<<[point 7,[asciz "bad args"]]>>
;
; Also, %s (print asciz string function) converts an 18-bit address to a 7-bit
; byte pointer, which simplifies the argument specification for word-aligned
; strings.
;

; %j	set output designator to jfn (or byte pointer) addressed by argument.
;
; %=	set output designator to immediate value of argument, nominally
;	a string buffer address, which is converted to a 7-bit byte pointer
;	the argument is not evaluated, so %j should be used when the byte
;	pointer is contained in a variable, e.g.
;	
;		printf <%=Hi there%n>,<buffer>
;
;	is equivalent to
;	
;		printf <%jHi there%n>,<<[-1,,buffer]>>
;	
; %@	do 1 or more 'extra' indirect fetches to find the argument data
;	
; %'	print a sixbit word
;
; %+	ignore an argument (just increments the argument list pointer)
;
; %%	print a percent sign
;
; %?	flush output and do an esout%
;
; %xy	where x is a decimal (or, with a leading zero, octal) number and
;	y is a valid dispatch character, specifies a numeric argument
;
; %c	print the current time and date (negative numeric argument means take
;	the format word from the argument list)
;
; %d	print a decimal number
;
; %o	print an octal number
;
; %e	print the last error code
;
; %f	print the name of a file, given a jfn
;	
; %n	newline (if negative numeric arg, only if not at left margin)
;
; %q	c-like conditional (nyi)
;
; %r	print a floating point (real) number
;
; %s	print a string starting at the immediate value of the address.
;
; %t	print the time and date from data on the argument list.  with a
;	negative numeric argument, take the format flags from the arg list
;	too.
;
; %u	user or directory
;

	stdac.
; doprin - the handler routine printf
;
; preserves all acs except cx (clobbered by trvar)
;
; signxx holds the sign of the argument.  a function can effectively
;  have an argument of negative zero by omitting the number, e.g. "%-n"
;
; argrdx holds the radix under which the number will be interpreted.  The
;  number is interpreted as octal if it begins with a leading 0, decimal
;  otherwise.
;
; outdes is the output designator, which may be changed with "%j" (for
; jfns) or %= (for word-aligned buffer addresses)
;
; fmtwrd is nonzero if the user wants to specify the address of a word
; containing format flags for functions that take them, and either a
; fork handle or jsys error code for %*e

doprin::trvar <<acs,20>,<buffer,200>,signxx,outdes,fmtwrd,argrdx,dopush>
	movem acs			; save ac0
	movei 1+acs			; get start of ac block
	hrli 1				; and first ac to save
	blt 17+acs			; save acs
	move t1,.fp			; get frame pointer TRVAR set up
	pop t1,.fp+acs			; restore caller's .fp to fake acs
	pop t1,q3			; get address of arglst pointer in q3
	movem t1,p+acs			; restore caller's p to fake acs
	hrrz q3,(q3)			; fetch pointer to argument list
	movei t1,.priou			; get the default output designator
	movem t1,outdes			; save it
	setzm dopush			; don't "push" data by default

	movei q1,buffer
	hrli q1,(point 7,)		; q1 holds a running destination ptr
	move q2,(q3)			; q2 holds the source pointer
	setzm buffer			; ensure output is asciz

doprlp:	ildb t1,q2			; get a character
	cain t1,"%"			; is it the escape character?
	 jrst dspini
	jumpe t1,dprend
dopdpb:	idpb t1,q1			; else, just pass the character
	jrst doprlp			; and go get another one

dprend:	call endwrt			; flush pending output
dprret:	hrli 1+acs
	hrri 1
	blt 14				; restore acs 1-14
	move acs			; restore ac 0
	move cx,p+acs			; get user context stack pointer
	adjsp cx,1			; make it point to the return pc
	push p,cx			; save it on the stack
	move .fp,.fp+acs		; restore previous frame pointer
	move p,(p)				; flush trvar junk
	retskp				; return, skipping over arg list

dspini:	movei t1,1			; get argument multiplier
	movem t1,signxx			; set it
	movei t1,^d10			; get default argument radix
	movem t1,argrdx			; set it
	setzm fmtwrd			; say no "*" seen yet
	setzm p4			; p4 initialize the field width

dodisp:	ildb t1,q2			; get the next character
	jrst @dsptab(t1)		; get the address of the handler

dobdch:	movei t2,"%"			; get back the "%" character we ate
	idpb t2,q1			; deposit it, along with the next char
	jrst dopdpb

; endwrt - flush any pending output and reinitialize things

endwrt:	saveac <t1,t2,t3,t4>		; save the acs we need
	movei t1,buffer
	hrli t1,(point 7,)		; build ptr to start of buffer
	camn t1,q1			; have we written anything?
	 ret				;  no, just return
	move t1,q1			; get the output designator
	setz t2,			; get a null
	idpb t2,t1			; ensure string is asciz
	move t1,outdes			; t1/ destination designator
	hrroi t2,buffer			; t2/ source designator
	setzm t3			; t3/ terminate on null
	ifxe. t1,.lhalf			; byte pointer or jfn?
	 skipe dopush			; jfn - want to force data out?
	 ifskp.
	  sout%				; no, just write out the string
	   erjmp wrterr			; handle any errors
	 else.
	  soutr%			; yes, write it and force it out
	   erjmp wrterr			; handle any errors
	 endif.
	else.
	 call cpystr			; byte pointer - do it ourself
	endif.
	movem t1,outdes			; update output pointer
	movei q1,buffer			; reinitialize the string buffer
	hrli q1,(point 7,)		; q2 holds a running destination ptr
	setzm buffer			; ensure output is asciz
	ret

; here on output errors

opcode==-1b13

wrterr:	move cx,p+acs			; get the stack pointer from entry
	hrro cx,1(cx)			; get return pc (next on stack)
	move cx,1(cx)			; get the following instruction
	andx cx,opcode			; mask off the uninteresting bits
	camn cx,[ercal]			; ercal follows?
	 jrst dprerc			; yes, simulate it
	camn cx,[erjmp]			; erjmp follows?
	 jrst dprerj			; yes, simulate it

; here if no error handling supplied by user.  print an error message,
; halt, and return to user's program if continued

wrter1:	push p,[ifiw!wrter2]		; set up dummy return pc
	saveac <t1,t2,t3>		; save acs on jsmsg0's behalf
	hrroi t1,[asciz "PRINTF output failed: "]
	esout%
	callret jsmsg0			; print the jsys error

wrter2:	haltf%				; return here after acs are restored
	jrst dprret			; if continued, return to user

; simulate ercal for failing printf

dprerc:	move cx,p+acs			; get the stack pointer from entry
	push p,cx			; save it
	move cx,1(cx)			; get return pc (next on stack)
	hrroi cx,1(cx)			; get address of following instruction

; simulate erjmp for failing printf

dprerj:	move cx,p+acs			; get the stack pointer from entry
	push p,cx			; save it
	move cx,1(cx)			; get return pc (next on stack)
	hrrzi cx,1(cx)			; get the following instruction

dprer1:	hrli 1+acs			; ercal simulation joins us here
	hrri 1				; restore acs 1-14
	blt 14
	move acs			; restore ac 0
	move .fp,.fp+acs		; restore ac 15
	move p,(p)			; restore users stack pointer
	tlzn cx,-1			; simulating ercal?
	 push p,cx			; yes, push fake return pc
	move cx,(cx)			; get branch address in cx
	jrst @cx			; jump to indicated address
; come here to deposit a "?" instead of the field we couldn't handle.
; most jsys errors are handled by coming here.

%je:	movei t1,"?"			; get a question mark
	idpb t1,q1			; deposit it
	move t1,q1			; now get the byte pointer
	setz t2,			; get a null
	idpb t2,t1			; deposit it
	jrst doprlp			; and continue
; printf support routines

; cpystr - copy an asciz string in core
;
; call:		t1/ destination pointer
;		t2/ source pointer
;
; returns:	t1/ updated destination pointer
;
; preserves other acs

cpystr::saveac <t2,t3,t4>
	tlc t1,-1			; convert -1,,addr to point 7,addr
	tlcn t1,-1
	 hrli t1,(point 7,)
	tlc t2,-1
	tlcn t2,-1
	 hrli t2,(point 7,)
	do.
	 ildb t3,t2			; get a byte
	 jumpe t3,endlp.
	 idpb t3,t1			; deposit it
	 loop.
	od.
	move t4,t1			; get destination pointer
	idpb t3,t4			; make the string asciz
	ret				; and return

; strlen - find the length of a string
;
; accepts:
;	t1/ string pointer
; returns:
;	t1/ unchanged
;	t2/ string length
;
; preserves t3,t4

strlen::saveac <t1,t3>			; save acs we'll use
	tlce t1,-1
	tlcn t1,-1
	 hrli t1,(point 7)
	setzm t2			; zero count
strln1:	ildb t3,t1			; get a byte
	jumpe t3,r			; if null, all done
	aoja t2,strln1			; else count it and loop
; getarg - retrieve an argument for printf
;
; in order to allow the use of stkvar and trvar arguments to printf,
; we have to calculate the effective address of an argument ourselves,
; since contents of the acs (in particular, p and .fp) are different from
; the caller's context.  Effadr, in particular, takes an word containing
; Y, AC, and I fields, and returns in the effective address with respect to
; the context of printf's caller.
;
; getarg returns the argument in t2, and preserves all other acs except cx

getarg:	saveac <t1>			; preserve t1
	aos q3				; increment argument list pointer
	move t1,(q3)			; get argument address
	call effadr			; calculate the effective address
	move t2,(t1)			; return word addressed by it in t2
	ret				;  

; getadr is like getarg, except it returns the address of the argument
; instead of the argument itself, in case the caller has to manipulate
; the actual argument.
;
; getadr returns the address of the argument in t1, preserving all other
; acs except cx

getadr:	saveac <t2>
	aos q3				; increment the argument list ptr
	move t1,(q3)			; get the address of the argument
	call effadr			; calculate the effective address
	ret				; return it
; effadr - calculate an effective address using the caller's context
;
; accepts:
;	t1/	word with I, X, and Y fields
;
; returns:
;	t1/	18-bit effective address in caller's context
;
; clobbers no other acs except cx

defstr (I,,13,1)
defstr (X,,17,4)
defstr (Y,,35,18)

effadr:	saveac <t2>			; preserve all acs
effad2:	move t2,t1			; copy word into t2
	load t1,X,t2			; load the X field
	jumpe t1,effad1			; none there, skip ahead
	addi t1,acs			; calculate address of "fake" ac
	load t1,Y,(t1)			; get Y field from fake ac
	add t1,t2			; add Y field from t2
	hrr t2,t1			; update Y field in t1 (without carry)
	txz t2,X			; say index no longer needed
effad1:	load t1,Y,t2			; get Y part of address
	caig t1,17			; is this an accumulator reference?
	 addi t1,acs			; yes, address "fake" acs then
	txzn t2,I			; was indirect bit on?
	 ret				; no, all done then, so return
	move t1,(t1)			; yes, fetch next word
	jrst effad2			; and repeat the process
; printf field handler routines

; %[-0123456789] - accumulate a numeric argument in p4

%digit:	cain t1,"-"			; is it a dash?
	 jrst %dash			; yes, go handle it
	cain t1,"0"			; is it zero?
	 jumpe p4,%zero
	imuli p4,argrdx			; multiply existing field with by ^o10
	subi t1,"0"			; decode the "number"
	imul t1,signxx			; give it the right sign
	add p4,t1			; add it to the running sum
	jrst dodisp			; get another character

%dash:	movns signxx			; negate the sign
	jrst dodisp			; otherwise ignore the "-"

%zero:	movei t1,^d8			; set radix to octal
	movem t1,argrdx
	jrst dodisp			; and go get another character
; %o, %d - print a number.  Numeric argument is the number of columns, and a
; negative argument means use trailing instead of leading filler

%o:	skipa t3,[^d8]			; octal number
%d:	 movei t3,^d10			; decimal number
	skipge p4			; argument negative?
	ifskp.
	 hrl t3,p4			; t3/ field width,,radix
	else.
	 movms p4			; yes, make it positive
	 hrl t3,p4			; get it in the proper field
	 txo t3,no%lfl			; say we want leading filler
	endif.
	call getarg			; get the argument
	skipn fmtwrd			; format word specified?
	ifskp.
	 move t3,t2			; yes, save the argument
	 call getarg			; fetch the format word
	 exch t3,t2			; get them in the right acs
	endif.	 
	move t1,q1			; t1/ destination pointer
	nout%				; output the number
	 jfcl
	movem t1,q1			; save the updated pointer
	jrst doprlp			; and go back for more
; %f - print the filename for a jfn.  Numeric argument is the number of
; fields (from left to right), negative means don't punctuate.

%f:	skipn t1,p4			; numeric argument?
	 movei t1,5			; no, assume we want all fields
	movms t1			; make it positive
	caile t1,5			; too many fields?
	 movei t1,5			; yes, use the maximum then
	movei t2,5			; we want the difference from 5 now
	subm t2,t1			; t1 := (5-t1)
	imuli t1,3			; get the number of bits to shift
	move t3,[xwd 111110,0]		; get jfns bits
	lsh t3,(t1)			; calculate the jfns argument
	skipl p4			; argument negative?
	 txo t3,js%paf			; no, turn on punctuation
	call getarg			; t2/ jfn
	move t1,q1			; t1/ output designator
	skipn fmtwrd			; format word wanted?
	ifskp.
	 move t3,t2			; yes, save the argument
	 call getarg			; fetch the format word
	 exch t3,t2			; get them in the right acs
	endif.	 
	jfns%				; do the work
	 erjmp %je
	movem t1,q1			; update the destination pointer
	jrst doprlp			; keep looping
; %s - print a string.  numeric argument is maximum length, or if negative,
;  length to pad out to.

%s:	call getadr			; get immediate value
	move t2,t1			; get it in t2
	tlce t2,-1			; convert 0,,addr to "point 7,addr"
	tlcn t2,-1			; convert -1,,addr to "point 7,addr"
	 hrli t2,(point 7,)
	move t1,q1			; t1/ destination pointer
	movm t3,p4			; get field width, forcing positive
	skipn t3
	 movei t3,777777		; if no count, use +infinity
	setzm t4
	do.
	 sojl t3,endlp.			; leave loop when count exhausted
	 ildb t4,t2			; get a source byte
	 jumpe t4,endlp.		; if a null, leave the loop
	 idpb t4,t1			; deposit it
	 loop.
	od.
	skipl p4			; argument negative?
	 jrst %s1			; no, move on
	movei t4," "			; yes, pad with trailing spaces
	do.
	 sojl t3,endlp.
	 idpb t4,t1			; drop in a trailing blank
	 loop.
	od.
%s1:	movem t1,q1			; update the byte pointer
	setz t4,			; get a null
	idpb t4,t1			; make the string asciz
	jrst doprlp			; go back for some more
; %u - print a user or directory name.

%u:	move t1,q1			; t1/ destination designator
	call getarg			; t2/ user/directory number
	dirst%				; convert a string
	 erjmp %je
	movem t1,q1			; save the updated pointer
	jrst doprlp			; go back for more
; %l - go to left margin

%l:	call endwrt			; flush any pending output
	movei t1,.priin
	rfpos%				; get the cursor position
	hrrzs t2			; isolate column number
	jumpe t2,doprlp			; if 0, we're all done here
	callret %n			; join common code for %n

; %n - print n newlines (default is 1)

%n:	movms p4			; make any negative arg positive
	move t1,q1			; get the destination pointer
	do.
	 hrroi t2,[byte (7) .chcrt,.chlfd,.chnul]
	 call cpystr			; copy in the crlf
	 sojg p4,top.			; loop for the repeat count
	od.
	movem t1,q1			; save the updated pointer
	jrst doprlp
; %e - output the last jsys error.  Numeric argument is maximum length
;  of string; "*" means that next arg is a fork handle or error code.

%e:	skipn fmtwrd			; format word wanted?
	ifskp.
	 call getarg			; fetch the format word
	 hrrz t1,t2			; clear junk from left half
	 caile t1,.erbas		; error code?
	 ifskp.
	  geter%			; no, get last error for the fork
	   erjmp %je
	 endif.
	 hrli t2,.fhslf			; t2/ .fhslf,,error code
	else.
	 hrloi t2,.fhslf		; t2/ .fhslf,,last error code
	endif.
%e2:	move t1,q1			; t1/ destination designator
	movm t3,p4			; get argument, force positve
	movns t3			; make it negative now
	hrlzs t3			; t3/ -count,,0
	erstr%				; output the error string
	 jrst %je
	 jrst %je
	movem t1,q1			; update the destination pointer
	jrst doprlp			; ignore errors
; %q - do an ESOUT%

%q:	call endwrt			; flush any pending output
	hrroi t1,[asciz ""]
	esout%				; print the ? and crlf if necessary
	jrst doprlp
; %t - Print the time and date in a "nice format."  "*" modifier
; means find the flags in the next argument.  %c means use current time
; and date.

%t:	call getarg			; get the argument
	skipa t3,t2			; save time and date in t3
%c:	 seto t3,			; %c handler enters here
	skipe fmtwrd			; any format word specified?
	ifskp.
	 movx t2,ot%scl+ot%12h+ot%nsc	; no format word, so use default
	else.
	 call getarg			; format word, so get it
	endif.
	exch t2,t3			; swap time and flags
	move t1,q1			; get the destination designator
	odtim%				; print the time and date
	 erjmp %je			; error?
	movem t1,q1			; save updated byte pointer
	jrst doprlp
; %j - flush pending output and take new output designator from arg list
;      like %= below, but expects the address of a jfn or byte pointer as
;      it's argument, e.g. printf <%j...>,<netjfn>

%j:	call endwrt			; flush pending output
%j1:	call getarg			; get address of the argument
	movem t2,outdes			; save it as output designator
	jrst doprlp			; go get some more characters

; %p - like %j, but uses SOUTR% instead of SOUT% (for network jfns)

%p:	call endwrt			; flush any pending output
	setom dopush			; set the flag
	jrst %j1			; join code for %j
; %= - set output to constant in argument list.  converts buffer addresses to
;      7-bit byte pointers.

%set:	call endwrt			; flush pending output
	call getadr			; get the argument address
	move t2,t1			; get the (immediate) value in t2
	tlce t2,-1			; convert -1,,addr or 0,,addr to 
	tlcn t2,-1			;  7-bit string pointer
	 hrli t2,(point 7)		; ...
	movem t2,outdes			; save the new output designator
	jrst doprlp			; go get some more characters
; %% - print a percent sign

%pcent:	move t1,q1			; output designator
	hrroi t2,[asciz "%"]		; get a "%"
	call cpystr			; drop it in the output buffer
	movem t1,q1			; update destination pointer
	jrst doprlp			; and go back for more
; %*x - specifies that a format word follows the argument for function x.

%star:	setom fmtwrd			; save the flag
	setz p4,			; clear any numeric argument
	movei t1,1			; get default multiplier
	movem t1,signxx			; save it
	movei t1,^d10			; restore default radix
	movem t1,argrdx
	jrst dodisp			; now find next char to dispatch on

; %' - Print a sixbit string.  Numeric argument is field width, negative
; argument means convert to lowercase instead of upper case.

%6:	move t1,q1			; t1/ destination designator
	call getarg			; t2/ sixbit word
	caig p4,6			; if numeric arg is too large
	skipg p4			;  or too small
	 movei p4,6			; p4/ positive loop count
	move t3,[point 6,t2]		; t3/ source pointer
	do.
	 ildb t4,t3			; load a byte
	 addi t4,40			; convert to uppercase
	 skipl signxx			; was argument negative?
	 ifskp.				; yes, lower case it then
	  cail t4,"A"			; is it uppercase alpha?
	  caile t4,"Z"			; well?
	  anskp.			; yes, so
	  addi t4,40			;  convert to lowercase
	 endif.
	 idpb t4,t1			; drop converted char in output buffer
	 sojg p4,top.			; keep looping
	od.
	movem t1,q1			; save updated byte pointer
	jrst doprlp			; and go back for more
; %R - print a floating point number

%r:	call getarg			; get the number to output
	movem t2,p1			; save the number to print
	skipn fmtwrd			; argument given for format?
	ifskp.
	 call getarg			; yes, so get the argument
	 move t3,t2			; put in flout register
	else.
	 setzm t3			; else use monitor's default
	endif.
	move t1,q1			; get the output designator
	move t2,p1			; here is the number
	flout%				; output it
	 erjmp %je			; handle errors
	movem t1,q1			; save the updated pointer
	jrst doprlp			; and go back for more
; %h - print a host number

; "*" modifier means always use dot notation

%h:	call getarg			; get the host number
	move t3,t2			; t3/ host number
	move t2,q1			; t2/ destination
	skipe fmtwrd			; "*" specified?
	 jrst hstnum			; yes, just use dot notation
	movx t1,.gthns			; t1/ funtion code
	gthst%				; convert number to string
	 erjmp hstnum			; failed, print octets
	movem t2,q1			; update the pointer
	jrst doprlp			; and go back for more

hstnum:	movem t3,p1			; get host number in p1
	move p2,[point 8,p1,3]		; set up byte pointer to octets in p2
	move t1,q1			; get destination pointer
	movei t3,^d10			; radix is decimal
	movei t4,3			; loop 4 times
	do.
	 ildb t2,p2			; get an octet
	 nout%				; print the number
	  jfcl				; can't happen
	 jumpe t4,endlp.		; exit if all done
	 movei t2,"."			; get a dot
	 idpb t2,t1			; deposit it
	 soja t4,top.			; loop
	od.
	movem t1,q1			; save update byte pointer
	jrst doprlp			; go back for more

define xx (chr,addr) <
  irpc <chr>,<
	reloc dsptab+"chr"
	ifiw!addr
	reloc
  >
>

dsptab:	repeat 200,<ifiw!dobdch>	; default is to ignore meaning of "%"
	xx <=>,%set			; %= set output designator to constant
	xx <*>,%star			; %* - specify an extra argument
	xx ',%6				; %' - print a sixbit word
	xx %,%pcent			; %% - a percent sign
	xx ?,%q				; %? - simulate esout%
	xx <-0123456789>,%digit		; %1 - decimal field width
	xx cC,%c			; %c - current time and date
	xx dD,%d			; %d - decimal number
	xx eE,%e			; %e - string for last jsys error
	xx fF,%f			; %f - name associated with jfn
	xx nN,%n			; %n - newline (no argument)
	xx oO,%o			; %o - octal number
	xx sS,%s			; %s - a string from immediate addr
	xx tT,%t			; %t - time and date
	xx uU,%u			; %u - user or directory
	xx jJ,%j			; %j - output to jfn
	xx pP,%p			; %p - output to jfn, "push" output
	xx rR,%r			; %r - real (floating) number
	xx lL,%l			; %l - go to left margin
	xx hH,%h			; %h - print a host name
.ENDPS
;end of PRINTF code
; Macros

DEFINE OKINT <JSP CX,OKINT0>	;allow interrupts
DEFINE NOINT <JSP CX,NOINT0>	;disallow interrupts

DEFINE LOG (MSG, ARGS) <	;log message
IFN FTLOG,<				
	CALL [CALL OPNLOG
	      IFNB <ARGS>,<PRINTF <%j%c MSG'%n>,<LOGJFN,ARGS>>
	      IFB <ARGS>,<PRINTF <%j%c MSG'%n>,<LOGJFN>>
	      CALLRET CLSLOG]
>;IFN FTLOG
>;LOG

DEFINE JMSG (MSG) <		;log message, restart appropriately
	ERJMP  [LOG <? MSG - %e>
		SKIPN SUPERF
		 JRST ISTOP	;inferiors quit
		JRST RESTART]	;superior restarts
>

DEFINE EMSG (MSG) <
	JRST   [LOG <? MSG - %e>
		SKIPN SUPERF
		 JRST ISTOP	;inferiors quit
		JRST RESTART]	;superior restarts
>

DEFINE CMSG (MSG) <		;print message on "console"
	JRST   [PRINTF <? MSG - %e>
		SKIPN SUPERF
	 	 JRST ISTOP
		JRST RESTART]
>
DEFINE FATAL (MSG,ARGS,ADDR<R>) < ;only used in actual LPD code
 JRST [	IFNB <ARGS>,<LOG <MSG>,<ARGS>>
	IFB <ARGS>,<LOG <MSG>>
	CALL NAK
	JRST ADDR]
>
;Pure data

.PSECT PURE
TCPSCK:	ASCIZ/TCP:515#;timeout:60/	;socket to listen on for lpd requests
IFE STANSW&LOTSW,<
LOGNAM:	ASCIZ/PS:<SPOOL>LPD.LOG/ ;log file name
SCNFLN:	ASCIZ/PS:<SPOOL>cf*.*/	;files to scan in <SPOOL>
>;IFE STANSW&LOTSW
IFN STANSW&LOTSW,<
LOGNAM:	ASCIZ/SPOOL:LPD.LOG/ 	;log file name
SCNFLN:	ASCIZ/SPOOL:cf*.*/	;files to scan in <SPOOL>
>;IFN STANSW&LOTSW
EXENAM: ASCIZ/SYSTEM:LPD.EXE/	;our name
.ENDPS
; Access Checking

COMMENT =

LPD uses a number of tests to screen out the riff-raff who might be
trying to use our printers.  The first thing checked is the foreign
address.  If it is on the local network (as defined by LCLMSK and
LCLNET), or the hostname appears in the host table at WLDHST, the
connection is accepted, subject to verification of individual user
eligibility for printer use.  

Note that at Stanford, local hosts may not be in the NIC host table,
but we can still obtain a host name from them via the PUPNM% jsys.

User eligibility is determined by first seeing if there is a directory
for the remote site; for example, a machine named Glacier would have a
directory PS:<GLACIER> on the machine LPD is running on.  If such a
directory exists, then we do an existance check for
PS:<MACHINE.USERNAME>.  If that also exists, then everything is fine
and we can print the file.  

Note: Since Stanford LOTS doesn't have billable printers, we allow any
      host to print on our lineprinters providing the user name of the
      requestor exists at LOTS -- PAH
=
DEFINE HADDR (B1,B2,B3,B4) <BYTE (4) 0 (8) ^D<B1>,^D<B2>,^D<B3>,^D<B4>>

.PSECT PURE

IFN STANSW,<
LCLMSK:	HADDR -1,0,0,0		; local network mask
LCLNET:	HADDR 36,0,0,0		; local network number
>;IFN STANSW

IFN PUPSW,<
DEFSTR PUPNET,HOSTNO,3+8+8,8		; xx.40.xx.xx
DEFSTR PUPHST,HOSTNO,3+8+8+8+8,8	; xx.xx.xx.213
>;IFN PUPSW

; a list of patterns is matched against the internet host name of the
; client (as returned by GTHST%) if the test above fails.

DEFINE T (S) <[ASCIZ |S|]>

WLDHST:	T SU*			; the vax relay, etc etc
NWLD==.-WLDHST

.ENDPS
;Main program, top fork

.PSECT SCODE
START:	RESET%			;flush any garbage
	MOVE P,[IOWD PDLEN,PDL]	;set up stack pointer
	MOVX A,.FHSLF
	SETOM B,C
	EPCAP%			;enable all capabilities
	SETOM SUPERF		;we are the top level
	CALL PSIINI		;set up interrupt system
	CALL FRKINI		;set up fork tables
	CALL PIDINI		;initialize pid quotas
	SETZM SPLDIR		;don't know where <SPOOL> is yet
	PRINTF <%=%h>,<OURNAM,[-1]> ;get our hostname
	HRROI A,OURNAM
	CALL LC			;lowercase it for losing unix
	LOG <LPD starting up; scanning for old print requests>
	CALL SCAN		;scan the spool directory for old requests
	 LOG <scan failed, last error: %e>
MAIN:	MOVE A,NRUN		;get number of forks running
	CAIL A,NFKS		;can we create any more?
WAITPC:	 WAIT%			;nope, wait for one to terminate
	CALL LISTEN		;listen for a request
	 NOP			;ignore failure
	JRST MAIN		;proceed directly to GO and collect $200.00

RESTART:MOVX A,RSTINT		;wait a while after something bad happens
	DISMS%
	JRST START		;and restart
;support routines for LOG macro
OPNLOG:	SAVEAC <A,B,C>		;save from destruction
	MOVX A,GJ%SHT
	HRROI B,LOGNAM
	GTJFN%			;try to get handle on log file
	IFJER.
	 CMSG <GTJFN failed for log file> ;trouble
	ENDIF.
	MOVEM A,LOGJFN		;save jfn
	MOVEI C,^D10		;try a bunch of times to get log file
OPNLG1: MOVE A,LOGJFN
	MOVX B,OF%APP!FLD(7,OF%BSZ) ;open for append access
	OPENF%			;try to open it
	IFJER.			;no luck
	 MOVX A,^D1000		;wait a second
	 DISMS%
	 SOJG C,OPNLG1		;try again a few times if needed
	 MOVE A,LOGJFN		;didn't work, get jfn back
	 SETZM LOGJFN		;clear cell
	 RLJFN%			;flush jfn 
	  ERJMP .+1		;just can't win
	 CMSG <OPENF failed for log file> ;give up for now, complain 
	ENDIF.
	RET

CLSLOG:	SAVEAC <A>
	SETZM A			; get a zero
	EXCH A,LOGJFN		; swap with the jfn
	CLOSF%			;close the file
	 CMSG <CLOSF on log file failed> ;complain and restart, can't keep 
	RET			;file open
;PSI stuff

;PSIINI - called at startup to initialize PSI system
PSIINI:	MOVEI A,.FHSLF		;this process
	MOVE B,[LEVTAB,,CHNTAB]	;tables for monitor's perusal
	SIR%			;set addresses of tables
	EIR%			;enable interrupt system
	MOVX B,PICHNS		;activate the actual channels we want
	AIC%
IFN DEBUG,<
	MOVE A,[.CHCNA,,STSCHN]	;status interrupt on ^A
	ATI%			;if debugging code enabled
>;IFN DEBUG	
	RET
;Interrupt control code

;allow interrupts
OKINT0:	PUSH P,A		;save A
	MOVEI A,.FHSLF		;this fork
	EIR%			;enable interrupt system
	POP P,A			;restore A
	JRSTF @CX		;restore flags and PC

;disallow interrupts
NOINT0:	PUSH P,A		;save A
	MOVEI A,.FHSLF		;this fork
	DIR%			;disable interrupt system
	POP P,A			;restore A
	JRSTF @CX		;restore flags and PC
;FRKINT - fork termination interrupt received
FRKINT:	CALL FKINT		;call fork termination code
	DEBRK%			;attempt to return from interrupt
	 JMSG <DEBRK failed %e> ;probably coding error if we get here

;handler for fork termination interrupt
FKINT:	SAVEAC <A,B,C,D,Q1,Q2,Q3,FX,CX>	;save acs
	HRRZ A,LEV2PC		;get pc of interrupted fork
	CAIE A,WAITPC+1		;are we WAIT%ing for a free fork?
	IFSKP.			;yes
	 SETONE PC%USR,LEV2PC	;force return to user mode
	ENDIF.
	MOVSI FX,-NFKS		;form AOBJN pointer
FKINT0:	JE FKRUN,,FKINT1	;this fork here?
	LOAD A,FH		;yes, get fork handle
	RFSTS%			;read status
	 JMSG <RFSTS failed>
	HRRZS B			;isolate PC
	LOAD D,RF%STS,A		;get fork status
	CAIE D,.RFHLT		;halt
	CAIN D,.RFFPT		;forced halt?
	 SOSA NRUN		;yes, one less running
	  JRST FKINT1		;no, next fork
	SETZRO FKRUN		;turn off running bit
IFN DEBUG,<			;if debugging
	LOAD A,FH
	MOVEM B,Q1		; save pc
	RUNTM%			; get it's runtime
	MOVE B,Q1		; get pc back
	MOVEM A,Q1		; save run time
	MOVEM C,Q3		; save console time
>;IFN DEBUG
	LOAD C,FH		;get fork handle
	TRZ C,.FHSLF		;convert to fork number
	CAIE D,.RFHLT		;did this fork halt normally?
	IFSKP.			;yes
IFN DEBUG,<
	 LOAD A,FH		; get the fork handle
	 LOG <Fork %o halted, pc %o, last error %*e>,<c,b,a>
	 LOAD B,FKRT		; get fork's initial runtime
	 SUB Q1,B		; subtract it from final runtime
	 IDIVI Q1,^D1000	; convert to seconds
	 LOAD B,FKCT		; same for fork's console time
	 MOVE Q2,Q3		; get start time in q2
	 SUB Q2,B
	 IDIVI Q2,^D1000
	 LOG <Fork %o used %d cpu seconds in %d seconds>,<c,q1,q2>
>;IFN DEBUG
	 MOVE A,NFORKS
	 SUB A,NRUN
	 CAILE A,MAXIDL		;too many forks
	 IFNSK.
IFN DEBUG,<
	  LOG <Deleting fork %o>,<c>
>;IFN DEBUG
	  CALL DELFRK		;yep, delete this guy
	 ENDIF.
	ELSE.
IFN DEBUG,<
	 LOAD A,FH		; get the fork handle
	 LOG <Fork %o terminated, pc %o, status %o, %*e>,<c,b,d,a>
	 LOAD A,FKRT
	 SUB Q1,B
	 IDIVI Q1,^D1000	; calculate runtime
	 LOAD B,FKCT
	 MOVE Q2,Q3		; get console time in q2
	 SUB Q2,B
	 IDIVI Q2,^D1000	; and console time
	 LOG <Fork %o used %d cpu seconds in %d seconds>,<c,q1,q2>
>;IFN DEBUG
	 CALL DELFRK		;got an error, flush it
	ENDIF.
	SETZRO FKJFN		;flush the jfn from our tables
FKINT1:	AOBJN FX,FKINT0		;loop over all the forks
	RET			;and return
IFN DEBUG,<
;STSINT - 
STSINT:	CALL STATUS		;call status printer
	DEBRK%
	 JMSG <DEBRK failed>

; called at interrupt level to print fork status

STATUS:	SAVEAC <A,B,C,D,FX,CX>	; don't clobber any acs
	MOVSI FX,-NFKS		; make an aobjn pointer
	NOINT			; prevent interrupts
	PRINTF <Forks: %d (%d active)%nConnections: %d%n>,<nforks,nrun,njfns>
	SETZB A,B		; clear counters
	SETZM C
	PRINTF <FX JFN HOST%n>
STS1:	LOAD D,FH		;get fork handle
	IFQN. FKRUN		;is it running?
	 LOAD A,FKJFN		;yes
	 GDSTS%			;get connection status
	 IFJER.
	  SETZM C
	 ENDIF.
	 HRRZ B,FX		;isolate fork handle
	 PRINTF <%2o %3o %h (%*e)%n>,<b,a,c,d>
	ELSE.
	 HRRZ B,FX
	 IFQN. FKJFN
	  LOAD A,FKJFN
	  PRINTF <%2o %3o  -- (%*e)%n>,<b,a,d>
	 ELSE.
	  IFQN. FH
	   PRINTF <%2o  --  -- (%*e)%n>,<b,d>
	  ENDIF.
	 ENDIF.
	ENDIF.
	AOBJN FX,STS1
	OKINT			; allow interrupts again
	RET			; return

>;IFN DEBUG
;Fork handling stuff

; scans the fork table looking for an idle fork.  if one is found, it's
; index is returned, otherwise a new fork is created unless the table is
; full.
;
; returns:
;	+1 no more forks
;	+2 success, fork index in fx

GETFRK:	MOVSI FX,-NFKS			; make an aobjn pointer
GETFK1:	JN FKJFN,,GETFK2		; fork in use?
	JE FH,,GETFK2			; no, and fork exists?
	 RETSKP				; yes, just return this handle
GETFK2:	AOBJN FX,GETFK1

; no idle fork exists, so create one if table can hold it

	MOVSI FX,-NFKS		;make another aobjn pointer
GETFK3:	JN FKJFN,,GETFK9	;fork in use?
	HRRZS FX		;no, isolate the fork index
	JN FH,,RSKP		;if fork exists, just return it
	MOVX A,CR%CAP!CR%MAP	;else make one, our caps and map
	CFORK%
	 JMSG (CFORK failed)	;nice try, anyway
	AOS NFORKS		;bump the fork count
	STOR A,FH		;save the handle
IFN DEBUG,<
	TXZ A,.FHSLF
	LOG <Created fork %o, table entry %o>,<A,FX>
	LOAD A,FH
>;IFN DEBUG
	CALL MAPSLF		;map appropriate parts of ourself into child
	RETSKP			; return with fx set up

GETFK9:	AOBJN FX,GETFK3		; loop if more to try
	RET			; otherwise, fail

;here to delete a fork
DELFRK:	LOAD A,FH		;get fork handle
	KFORK%			;exterminate, exterminate, exterminate
	 JMSG<KFORK failed>	
	SOS NFORKS		;decrement number of forks running
	SETZRO FH		;clear the fork handle
	RET
; frkini - initialize the fork tables

FRKINI:	SETZM FKSTAT		; clear the fork table
	MOVE A,[XWD FKSTAT,FKSTAT+1]
	BLT A,FKSTAT+NFKS
	RET

; set our pid quota as needed
PIDINI:	ACVAR <<ARGBLK,3>>
	GJINF%			;get job number
	MOVEM C,ARGBLK+1	;store in right slot
	MOVEI C,MXPIDS		;pid quota desired
	MOVEM C,ARGBLK+2
	MOVEI C,.MUSPQ		;set quota function
	MOVEM C,ARGBLK		
	MOVEI A,3		;length of arg block
	MOVEI B,ARGBLK		;addr of " "
	MUTIL%			;talk to the gods 
	 JMSG <MUTIL to set pid quota failed> ;they struck us down
	RET
	ENDAV.
; subfork setup

;copy ourselves into inferior, diddling page maps appropriately
MAPSLF:	SAVEAC <A,B,C>
	STKVAR <FORKH>
	MOVEM A,FORKH
	SETZM INITF		;never run before
IFE FTMAP,<
	MOVX A,GJ%SHT!GJ%OLD
	HRROI B,EXENAM		;get copy of ourselves
	GTJFN%
	 JMSG <Can't find SYSTEM:NLPD.EXE>
	LOAD B,FH		;form jfn,,fh in a
	HRL A,B
	GET%			;get into address space of new fork
	 JMSG <GET failed>
>;IFE FTMAP
IFN FTMAP,<
	MOVE A,[.FHSLF,,<INFCOD/1000>]
	HRL B,FORKH
	HRR B,A
	MOVX C,PM%CNT!PM%RD!FLD(<INFLEN/1000>,PM%RPT)
	PMAP%
	 JMSG <INFCOD PMAP failed>
>;IFN FTMAP
	MOVE A,[.FHSLF,,<INFDAT/1000>]
	HRL B,FORKH
	HRR B,A
	MOVX C,PM%CNT!PM%RD!PM%CPY!FLD(<INDLEN/1000>,PM%RPT)
	PMAP%
	 JMSG <INFDAT PMAP failed>
IFN FTMAP,<
	MOVE A,[.FHSLF,,<PURDAT/1000>]
	HRL B,FORKH
	HRR B,A
	MOVX C,PM%CNT!PM%RD!FLD(<PURLEN/1000>,PM%RPT) ;this can be read-only
	PMAP%
	 JMSG <PURDAT PMAP failed>
>;IFN FTMAP
	MOVE A,[.FHSLF,,37]		;copy DDT's section
	HRL B,FORKH
	HRRI B,37
	MOVX C,SM%RD!SM%WR!SM%EX!1
	SMAP%
	RET
	ENDSV.
; Listen - listen for a request

LISTEN:	ACVAR <SAVJFN>
	MOVX A,GJ%SHT
	HRROI B,TCPSCK
	GTJFN%			;get handle on port
	 JMSG <GTJFN failed>
	HRRZ SAVJFN,A		;save jfn away
	HRRZS A
	MOVX B,OF%RD!OF%WR!FLD(^D8,OF%BSZ)!FLD(.TCMWI,OF%MOD)
	OPENF%			;open connection
	IFJER.
	 LOG <TCP open error: %e> ;oops
	 MOVE A,SAVJFN		;get jfn back
	 RLJFN%			;release it
	  NOP
	 RET			;return to caller
	ENDIF.
	AOS NJFNS		;bump up number of connections
	GDSTS%			;find out who is talking to us
	 JMSG <GDSTS failed>
	LOG <Connect from %h>,<C> ;log it
	CALL GETFRK		;get a fork for this one
	IFNSK.			;oops, couldn't get a fork
	 LOG <? can't allocate a fork - %e> ;put in Pearl Harbor file
	 CALLRET NETCLS		;shut them down
	ENDIF.
	MOVE A,SAVJFN
	STOR A,FKJFN		;store jfn in slot for subfork
IFN DEBUG,<
	LOAD A,FH		;fork handle
	RUNTM%			;get runtime
	 JMSG <RUNTM failed>
	STOR A,FKRT		;save runtime
	STOR C,FKCT		;and console time
>;IFN DEBUG
	NOINT			;don't allow interruptions now
	SETZM FRKACS		;clear fork acs for IPC
	MOVE A,[FRKACS,,FRKACS+1]
	BLT A,FRKACS+17
	LOAD A,FH		;get fork handle
	MOVE B,SAVJFN		;get jfn for it
	MOVEM B,FRKACS+INIJFN	;put in right ac
	SETZM FRKACS+RANK	;tell it is subfork
	MOVEI B,FRKACS		;addr of acs for subfork
	SFACS			;set them
	 JMSG <SFACS failed>
IFE FTMAP,<
	LOAD A,FH		;get fork handle
	MOVEI B,1		;offset 1
	SFRKV%			;start it up
	 JMSG <SFRKV failed>
>;IFE FTMAP
IFN FTMAP,<
	LOAD A,FH		;get fork handle
	MOVEI B,LPD		;start in actual LPD code
	SFORK%			;start fork
	 JMSG <SFORK failed>
>;IFN FTMAP
	SETONE FKRUN		;flag fork is running
	AOS NRUN		;bump count up by one
	OKINT			;okay to be interrupted now
	RETSKP			;return success
	ENDAV.
.ENDPS
 
;LPD work routines

;Main routine of actual code that talks to remote hosts
.PSECT ICODE			;get in right code segment

;subfork starts here
LPD:	MOVEM INIJFN,NETJFN	;save our connection jfn
	MOVEM RANK,SUPERF	;and our rank (we are peons)
	RESET%			;do this for good measure
	MOVE P,[IOWD PDLEN,PDL]	;set up stack
	MOVX A,.FHSLF
	SETOM B,C
	EPCAP%			;enable all capabilities
	CALL GETPID		;get pids to talk to quasar
	IFNSK.			;can't talk to quasar, complain and die
	 LOG <LPD: Couldn't assign pids - %e>
	 JRST ISTOP
	ENDIF.				
	SKIPE INITF		;do we need to initialize more?
	 JRST LPD1
	MOVX A,.FHSLF
	MOVE B,[XWD LEVTAB,CHNTAB]
	SIR%			; set up interrupt tables
	EIR%			; enable interrupts
	MOVX B,PICHNS
	AIC%			; active interrupt channels
	SETZM SPLDIR		; zero out idea of spool dir. #
	PRINTF <%=%H>,<OURNAM,[-1]> ; get our host name
	HRROI A,OURNAM
	CALL LC			; lowercase it
	SETOM INITF		;we have been initialized
LPD1:	MOVE A,NETJFN		;get the connection jfn
	GDSTS%			;get the status
	 JMSG <GDSTS failed>
	MOVEM C,HOSTNO		;save remote host addr
	PRINTF <%=%h>,<REMHST,HOSTNO> ;fill in the blanks
	CALL ACCCHK		;check access
	 JRST ISTOP		;no good, halt
	CALL GETJOB		;go figure out what they want to do and do it
	IFNSK.			;failure
	 LOG <GETJOB failed, last error: %e> ;complain
	ENDIF.
	SKIPE NETJFN		;do we have a connection still
	 CALL NETCLS		;flush it
	SKIPN A,DSKJFN		;still have an open disk file?
	IFSKP.			;yes,
	 TXO A,CZ%ABT		;flush it with extreme prejudice
	 CLOSF%
	  LOG <Disk file close failed, last error: %e>
	 SETZM DSKJFN		;deny ever having seen it
	ENDIF.
	SKIPN SCNFLG		;need to check for print requests?
	 JRST ISTOP		;nope, stop
	CALL SCAN		;yes, scan spool directory
	 LOG <Scan failed, last error: %e> ;complain about failure
	CALL EXPSPL		;expunge spool directory
ISTOP:	HALTF%			;stop
	HALT .			;really stop!

ACCCHK:
	MOVEI A,.GTHNS		;convert number to string
	HRROI B,HSTNAM		;into this location
	MOVE C,HOSTNO		;with this host number
	GTHST%			;go call crufty jsys
IFN PUPSW,<
	IFJER.			;failed, try pup name
	 LOAD B,PUPNET		;get pup net num
	 LOAD C,PUPHST		;and pup host num
	 HRROI A,HSTNAM
	 HRLM B,C		
	 MOVX B,PN%FLD!PN%OCT!C	;50,,316 = Fuji
	 SETZM D
	 PUPNM%			;look up host name
	 IFJER.
	  LOG <PUPNM% failed on %h>,<HOSTNO> ;
	 ENDIF.
	ENDIF.
>;IFN PUPSW
IFE PUPSW,<
	IFJER.			;failed, use dot notation
	 PRINTF <%=%h>,<HSTNAM,HOSTNO> 
	ENDIF.
>;IFE PUPSW
IFN STANSW,<
IFE NICSW,<
	MOVE A,HSTNAM
	TRZ A,77777
	CAME A,[BYTE (7) "S","U","-",0,0] ;SU- prefix?
	IFSKP.			;yes, strip it off
>;IFE NICSW
	 MOVE B,[POINT 7,HSTNAM]
IFE NICSW,<
	 MOVE C,[POINT 7,HSTNAM,6+7+7] ;point at first non-prefix char
>;IFE NICSW
IFN NICSW,<
	MOVE A,HSTNAM
	TRZ A,377
	MOVE C,[POINT 7,HSTNAM]
	CAMN A,[BYTE (7) "S","R","I","-",0]	;SRI- prefix?
	 MOVE C,[POINT 7,HSTNAM,6+7+7+7] ;point at first non-prefix char
>;IFN NICSW	
ACCCH0:	 ILDB A,C
	 CAIN A,"."		;go until ".ARPA"
	  MOVEI A,0
	 IDPB A,B
	 JUMPN A,ACCCH0		;loop until we hit null
IFE NICSW,<
	ENDIF.
>;IFE NICSW
>;IFN STANSW
	CALL CHKOK		;make sure this site is legit
	IFNSK.
	 LOG <host is not authorized to talk to us>
	 PRINTF <%plpd: sorry, your host (%s) isn't authorized to talk to me%n>,<NETJFN,REMHST>
	 CALLRET NETCLS		; close down the connection
	ENDIF.
	MOVE A,NETJFN
	MOVEI B,.TCRTW		; read a word from the TCB
	MOVEI C,11		; this location
	TCOPR%
	 JMSG <TCOPR to read foreign port failed>
	HRRZS C			; make sure we only get right half
	CAIGE C,^D1024		; should be less than ^D1024
	IFSKP.
	 LOG <Foreign port of %d from host %s not allowed access>,<c,remhst>
	 PRINTF <%plpd: sorry, illegal foreign port (%d)%n>,<netjfn,c>
	 CALLRET NETCLS			; close down the connection
	ENDIF.
	RETSKP
;;; This code could be used as part of a more complex access checking routine
REPEAT 0,<
	MOVE C,HOSTNO		; get the host number
	AND C,LCLMSK		; keep the interesting bits
	CAMN C,LCLNET		; local network host?
	 RETSKP			; yes, return success
	MOVSI D,-NWLD		; make an aobjn pointer
	DO.
	 MOVX A,.WLSTR
	 HRRO B,WLDHST(D)	; point at the wild host name
	 HRROI C,REMHST		; and at the remote host name
	 WILD%			; do they match?
  	  JMSG <WILD%% failed>	
	 JUMPE A,RSKP		; if they match, return success
	 AOBJN D,TOP.		; if other possibilities, loop
	ENDDO.
	LOG <host is not authorized to talk to us>
	PRINTF <%plpd: sorry, your host (%s) isn't authorized to talk to me%n>,<netjfn,remhst>
	CALLRET NETCLS			; close down the connection
>;REPEAT 0
; chkok - check that site can talk to us
; this is the routine to change for customizing access checking
; this version merely checks to make sure that there is an account with
; the name PS:<SITE> on the local host.  In the PRINT routine, we will
; check further to make sure there exists PS:<SITE.USER> so that we have
; someone to whom to bill the request.

CHKOK:
ifn nicsw,<
	retskp
>
IFN STANSW&<LOTSW!CSLISW>,<
	RETSKP				; Allow all prints at LOTS
>;IFN STANSW&<LOTSW!CSLISW>
	STKVAR <<TEMP,25>>
	HRROI A,TEMP
	SETZM TEMP
	MOVEI B,25-1(A)
	HRLI A,1(A)
	MOVSS A
	BLT A,(B)		;clear out temp string space
	HRROI A,TEMP		;point at temporary string space
	HRROI B,[ASCIZ/PS:</]	;>
	CALL CPYSTR
	HRROI B,HSTNAM		;PS:<FUJI
	CALL CPYSTR			
	MOVEI B,">"		;PS:<FUJI>
	IDPB B,A
	SETZ B,			
	IDPB B,A
	MOVX A,RC%EMO		;exact match only, please
	HRROI B,TEMP
	RCDIR%			;is there is a valid acct. for site?
	TXNE A,RC%NOM
	 RET
	RETSKP
	ENDSV.

; getjob - read a job from the remote lpd

; returns +1 always, with the connection closed

GETJOB:	MOVX A,REQINT			; get input timeout interval
	CALL ALARM			; set up timer interrupt
	IFNSK.
	 LOG <GETJOB: input taking too long>
	 CALLRET NETCLS			;go flush net connection and return
	ENDIF.
	MOVE A,NETJFN			; get the requested function
	BIN%				; ...
	 ERJMP NETCLS			; connection must have gone away
	CAIL B,1
	CAILE B,NLPREQ			; within range of legal lpd requests?
	 FATAL (Illegal request code %d%n,b) ; no, fail
	CALL @LPREQS(B)			; call the requested function
	 RET				; it failed, return now
	SKIPE NETJFN			; still have a connection?
	 CALL NETCLS			; yes, close it now
	RETSKP

; dispatch table for top-level requests

LPREQS:	IFIW NETEOF			; shouldn't get here
	IFIW PRODLP			; prod the printer along
	IFIW LPQJOB			; receive and queue a job
	IFIW LPQSHT			; return a short queue listing
	IFIW LPQLNG			; return a long queue listing
	IFIW LPQRM			; remove a file from the queue
NLPREQ==.-LPREQS
; prodlp - prod the printer along

PRODLP:	CALL GETLPN			; get the printer name
	 RET				; failed
	LOG <%s: wakeup request>,<lpname>
	CALL ACK			; pretend we did something
	 RET
	RETSKP
; lpqjob - receive and queue a job

LPQJOB:	CALL ACK			; tell lpd we're here
	 RET
	CALL GETLPN			; get the printer name
	 RET
	LOG <%s: create request>,<lpname>
LPQJLP:	CALL ACK			; send an ack
	 RET				; failed, just returns
	CALL TMROFF			; reset the timer
	MOVX A,JOBINT
	CALL TMRON			; set new timeout interval
	MOVE A,NETJFN			; get the jfn
	BIN%				; get the function code
	 ERJMP RSKP			; on eof, return
	CAIL B,1
	CAILE B,NLJREQ			; within range of job requests?
	 FATAL (Illegal job request %d,b) ; no fail
	CALL @LPJREQ(B)			; call the requested function
	 RET				; failed, propagate fail return
	JRST LPQJLP			; loop for another job request

; dispatch table for job requests

LPJREQ:	IFIW NETEOF			; shouldn't get here
	IFIW LPDFIN			; clean up - bad data was sent
	IFIW LPDRCF			; read a cf (control file)
	IFIW LPDRDF			; read a df (data file)
NLJREQ==.-LPJREQ
; lpdfin - flush queue files (bad data was sent)

LPDFIN:	LOG <%s: cleanup (bad data sent)>,<lpname>
	RETSKP
; lpdrcf - read an lpd control file

LPDRCF:	CALL GETFIL			; read the file
	 RET
	LOG <%s: control file %s>,<lpname,lpdfil>
	CALL ACK
	 RET
	AOS SCNFLG			; say we should scan the queue
	RETSKP

LPDRDF:	CALL GETFL8			; read an 8-bit file data file
	 RET
	LOG <%s: data file %s>,<lpname,lpdfil>
	CALL ACK
	 RET
	RETSKP
; lpqsht and lpqlng - return a queue listing

; since the remote lpq issues only one command at a time, we fake an error
; so the command loop doesn't try to read another command.  for now, only
; one kind of listing.

LPQLNG:
LPQSHT:	STKVAR <TEMP>
	CALL GETLPN
	 RET
	LOG <%s: short queue list request>,<LPNAME>
	HRROI A,LPNAME			; point at the printer name
	CALL LISTQ			; get the queue listing
	 FATAL <listq failed%n>
	CALL SNDQSR			; 
	 FATAL <sndqsr failed, last error: %e%n>
	JUMPE A,RSKP			; if no message text, return now
	PRINTF <%p%s: %s:
>,<NETJFN,OURNAM,LPNAME>

LSTQLP:	MOVEM B,TEMP			; save "more" indicator from sndqsr
	HRRO B,A			; get queue listing text in b
	MOVE A,NETJFN			; connection jfn
	SETZM C				; stop on null
	SOUTR%				; send the queue listing
	 ERJMP NETEOF
	SKIPN A,TEMP			; any more messages coming?
	IFSKP.
	  CALL RCVQSR			; get the next message
	   RET				; failed, return now
	  JRST LSTQLP
	ENDIF.
;	MOVE A,NETJFN			; after last message, send a
;	HRROI B,[BYTE (7) .CHLFD]	;  linefeed
;	MOVNI C,1
;	SOUTR%
;	 ERJMP NETEOF
	RETSKP
; lpqrm - remove a queue entry from a file

; returns +1 always (lprm only submits one request at a time)
; note: requests are canceled based on the remote userid, which
; requires a simple binary patch to quasar (see lpdqsr.mac).
; if lpdqsr isn't configured for this, the call to cancel will fail,
; and an appropriate message is sent to the remote user.

LPQRM:	SETZM REQNO
	SETZM REQUSR
	SETZM CNBLK
	MOVE A,[CNBLK,,CNBLK+1]
	BLT A,CNBLK+CN.MAX		;clear arg block for cancel
	CALL GETLPN
	 RET
	LOG <%s: rm "%s">,<LPNAME,LINE>
	HRROI A,REMUSR			; point to the remote user name
	CALL GETWRD
	 RET
	HRROI A,REQUSR			; remote requestor (can pr */user:foo)
	CALL GETWRD
	 NOP
	HRROI A,REQNO
	CALL GETWRD
	 NOP
	SKIPN REQNO
	IFSKP.				;got both foreign requestor and req no
	 HRROI A,REQNO
	 MOVX C,^D10
	 NIN%
	 IFNSK.
	  SETZM REQNO			;pretend we never saw req. no
	 ELSE.
	  MOVEM B,REQNO			;else save it away
	 ENDIF.
	ELSE.				;only got one thing, is it a username or a request number?
	 HRROI A,REQUSR
	 MOVX C,^D10
	 NIN%
	  JRST LPQRM1			;assume it is username
	 LDB D,A			;get next character in string
	 SKIPE D			;is it a terminating null?
	  JRST LPQRM1			;no, again assume it was username
	 MOVEM B,REQNO			;save number
	 SETZM REQUSR			;don't think we have username in future
	ENDIF.
LPQRM1:	HRROI A,SUSRNM
	HRROI B,HSTNAM
	CALL CPYSTR
	MOVEI B,"."
	IDPB B,A
	HRROI B,REMUSR
	CALL CPYSTR
	SETZ B,
	IDPB B,A
	LOG <CANCEL PRINT */USER:%s>,<SUSRNM>
	HRROI A,SUSRNM
	MOVEM A,CNBLK+CN.RON		;user name
	HRROI A,[ASCIZ//]		;no job name or mask
	MOVEM A,CNBLK+CN.JN
	MOVEM A,CNBLK+CN.JNM
	MOVE A,REQNO		;request number
	MOVEM A,CNBLK+CN.REQ
	HRROI A,SUSRNM
	SKIPN REQUSR
	IFSKP.
	 SETZM PXYUSR
	 HRROI A,PXYUSR
	 HRROI B,HSTNAM
	 CALL CPYSTR
	 MOVEI B,"."
	 IDPB B,A
	 HRROI B,REQUSR
	 CALL CPYSTR		;remotesite.proxyuser
	 HRROI A,PXYUSR
	ENDIF.	
	MOVEM A,CNBLK+CN.FON	;/user:
	HRROI A,LPNAME		;printer name
	MOVEM A,CNBLK+CN.LPT
	MOVEI A,CNBLK		;address of argument block
	CALL CANCEL
	IFSKP.
	 CALL SNDQSR
	 IFSKP.
	  LOG <%s>,<@a>
	  PRINTF <%p%s
>,<netjfn,@a>
	 ELSE.
	  LOG <cancel/sndqsr failed, last jsys error %e>
	 ENDIF.
	ELSE.
	 PRINTF <%plpd: sorry, I can't do that for you
>,<netjfn>
	 LOG <failed to set up cancel request block>
	ENDIF.
	RETSKP
; scan - scan the spool are for lpd jobs

SCAN:	SETZM SCNFLG			; clear the flag
	STKVAR <WLDJFN>
	MOVX A,GJ%SHT!GJ%IFG
	HRROI B,SCNFLN
	GTJFN%				; see if any control files exist
	 RETSKP				; no, just return
	MOVEM A,WLDJFN			; save the jfn
BIGLP:	SETZM MBXHST			; CLEAR JOB-SPECIFIC VARIABLES
	SETZM MBXUSR
	SETZM NOTE
	SETZM LPNAME
	SETZM SPLFNM
	SETZM CANFLG
	SETZM MAIFLG
	SETZM TRFFLG
	SETZM DITFLG
	SETZM PRFLG
	MOVE A,[SPLFNM,,SPLFNM+1]
	BLT A,SPLFNM+LINLEN-1
	HRRZ A,WLDJFN			; CLEAR OUT THE FLAGS
	MOVX B,OF%RD+FLD(7,OF%BSZ)
	OPENF%				; OPEN THE NEXT FILE
	IFJER.
	 HRRZ A,WLDJFN
	 RLJFN%				; FAILED, RELEASE THE JFN
	  ERJMP .+1
	 RET
	ENDIF.
	MOVX C,JS%NAM
	HRRZ B,A
	HRROI A,FILNAM
	JFNS%				; GET THE NAME FIELD OF THE FILENAME
	 ERJMP R			; (CONTAINS THE UNIX REQUEST NUMBER
	setz b,
	idpb b,a
	HRROI A,LPNAME			;  AND HOST LPR WAS DONE ON)
	HRRZ B,WLDJFN
	MOVX C,JS%TYP
	JFNS%				; GET THE FILE TYPE (WHICH IS THE
	 ERJMP R			;  PRINTER NAME)
	HRRZ A,WLDJFN
	DELF%				; DELETE THE INPUT FILE NOW
	 ERJMP R
	
SCANLP:	HRRZ A,WLDJFN			; GET THE JFN
	BIN%				; READ A CHARACTER
	 ERJMP SCNLP9			; FINISH UP ON EOF
	MOVE D,[XWD -NCMDS,CMDTAB]
	DO.				; SEARCH TABLE FOR COMMAND HANDLER
	 HLRZ C,(D)			; GET THE NEXT CHARACTER
	 CAIE C,(B)			; FOUND A MATCH?
	 AOBJN D,TOP.
	 MOVE D,(D)
	 CALL (D)			; CALL HANDLER WITH JFN IN A
	  RET				; ROUTINE FAILED?
	OD.
	JRST SCANLP

SCNLP9: CALL PRINT			; PRINT LAST FILE IN GROUP
	 LOG <Print after cf end-of-file failed>
	HRRZ A,WLDJFN			; GET THE JFN
	TXO A,CO%NRJ
	CLOSF%				; CLOSE IT, BUT DON'T RELEASE IT
	IFJER.
	  LOG <Couldn't CLOSF% WLDJFN in SCAN, last error:  %e>
	ENDIF.
	MOVE A,WLDJFN			; GET THE JFN
	GNJFN%				; STEP IT
	 RETSKP				; NO MORE FILES, SO RETURN SUCCESS
	JRST BIGLP			; MORE TO GO, SO PRINT THEM
;expunge spool directory
EXPSPL:	SKIPN B,SPLDIR
	IFNSK.
	 MOVX A,RC%EMO
IFE STANSW&LOTSW,<
	 HRROI B,[ASCIZ/PS:<SPOOL>/]
>;IFE STANSW&LOTSW
IFN STANSW&LOTSW,<
	 HRROI B,[ASCIZ/SPOOL:/]
>;IFN STANSW&LOTSW
	 RCDIR%
	 TXNE A,RC%NOM
	  RET				;PUNT IF COULDN'T FIND IT
	 MOVEM C,SPLDIR
	 MOVE B,C
	ENDIF.
	SETZM A
	DELDF%				;EXPUNGE!
	RET
;Dispatch table for control file commands

DEFINE CMD (CHAR,ADDR) <XWD "CHAR",ADDR>

CMDTAB:	PHASE 0
;	CMD J,GETJNM		; J - "job name" on banner page
	CMD H,SETHST		; H - "host name" of machine where lpr was done
	CMD P,SETUSR		; P - "person" user's login name
	CMD f,GETFNM		; f - "file name" name of text file to print
	CMD l,GETFNM		; l - "file name" text file with control chars
	CMD p,GTFNPR		; p - "file name" text file to print with pr(1)
	CMD N,DONOTE		; N - "name" of file (used by lpq)
	CMD T,PRTITL		; T - "title" for pr
	CMD M,SETMAI		; M - "mail" to user when done printing
	CMD d,FLUSH		; d - "file name" dvi file to print - NOP as LSRSPL handles correctly and other case is too hard
	CMD D,FLUSH		; D - "document control" passed to filter
	CMD C,FLUSH		; C - "class name" on banner page
	CMD L,FLUSH		; L - "literal" user's name to print on banner
	CMD I,FLUSH		; I - "indent" amount to indent output
	CMD t,FLUSH		; t - "file name" troff(1) file to print
	CMD n,FLUSH		; n - "file name" ditroff(1) file to print
	CMD g,FLUSH		; g - "file name" plot(1G) file to print
	CMD v,FLUSH		; v - "file name" plain raster file to print
	CMD c,FLUSH		; c - "file name" cifplot file to print
	CMD 1,FLUSH		; 1 - "R font file" for troff
	CMD 2,FLUSH		; 2 - "I font file" for troff
	CMD 3,FLUSH		; 3 - "B font file" for troff
	CMD 4,FLUSH		; 4 - "S font file" for troff
	CMD U,FLUSH		; U - "unlink" name of file to remove (after printing)
NCMDS:!	XWD 0,FLUSH		; default is ignore the line
	DEPHASE

FILTAB:	PHASE 0
	"p",,PRFILT	;run pr(1)
	"t",,TRFILT	;run troff(1)
	"n",,DTRFLT	;run ditroff(1)
	"g",,PLFILT	;run plot(1g)
	"v",,RSTFLT	;raster file
	"c",,CIFFLT	;cifplot file
NFILTS:!0
	DEPHASE
; PRINT - PRINT A FILE

; This routine is called whenever we encounter a l,p, or f command while
; scanning the cf file, and we already have a file to be printed in SPLFNM, and
; after we have read all of the CF file, to handle the last file in the CF
; file.  The reason it's done this way, rather than from the more intuitive
; f,l, or p commands in the table above, is because LPD passes the original
; name of the spool file *after* it tells us which file we should be printing.
; LPD makes two passes over the control file, so it's less sensitive to the
; order in which the CF commands are given.

PRINT:	STKVAR <<TEMP,25>,JFN>
	SKIPE SPLFNM			; ANY FILE TO PRINT?
	IFSKP.
	 LOG <PRINT called and no spool file present>
	 RET
	ENDIF.
	MOVX A,GJ%SHT+GJ%OLD
	HRROI B,SPLFNM
	GTJFN%				; TRY TO GET A JFN ON THE FILE
	IFNSK.
	 LOG <Couldn't find %S (%E)>,<SPLFNM>
	 JRST PRINT2
	ENDIF.
	MOVEM A,JFN			; SAVE IT
	SETZM USRNAM
	MOVE A,[POINT 7,USRNAM]
	MOVE B,[POINT 7,REMUSR]
PRINT0:	ILDB C,B
	CAIE C,"!"			;IS IT A "!"?
	IFSKP.
	 CALL CPYSTR			;YES, REST MUST BE USERNAME, COPY IT
	 SETZ B,
	 IDPB B,A			;TIE OFF WITH NULL
	ELSE.
	 SKIPE C			;END OF STRING
	 IFSKP.				;YES
	  LOG <Couldn't find username in REMUSR> ;OOPS, TROUBLE
	  RET
	 ENDIF.
	 JRST PRINT0			;NO, GET NEXT CHARACTER
	ENDIF.
	HRROI A,SUSRNM			;ASSEMBLE FUJI.SATZ IN SUSRNM
IFE STANSW&<LOTSW!CSLISW>,<
	HRROI B,HSTNAM			;JUST LOOK FOR THE SAME USER AT LOTS
	CALL CPYSTR
	MOVEI B,"."
	IDPB B,A
>;IFE STANSW&<LOTSW!CSLISW>
	HRROI B,USRNAM
	CALL CPYSTR			
	SETZ B,
	IDPB B,A
	HRROI A,TEMP			;MAKE PS:<FUJI.SATZ> IN TEMP
	HRROI B,[ASCIZ/PS:</]		;>
	CALL CPYSTR
	HRROI B,SUSRNM
	CALL CPYSTR			;<
	MOVEI B,">"
	IDPB B,A
	SETZ B,
	IDPB B,A
IFE NICSW,<
	MOVX A,RC%EMO
	HRROI B,TEMP
	RCDIR%				;IS THERE IS A VALID ACCT. FOR SITE?
	JRST PRINT1
	TXNE A,RC%NOM
	 JRST CANPRT			;NO, CAN IT
>;IFE NICSW
PRINT1:	CALL MNGNOT			;MUNG NOTE FIELD INTO TRFLNM
	SKIPN PRFLG			;NEED TO RUN pr(1)?
	IFSKP.
	 MOVE A,JFN			;get the jfn for swapping trickery
	 CALL DOPR			;run pr(1) over the file
	  CALL CANPRT			;some error, cancel this
	 MOVEM A,JFN			;stash new jfn
	ENDIF.
ifn nicsw,<
;check if file is postscript, if so set it's file class field
;jfn on file is JFN, filename is TRFLNM
	move a,[point 7,trflnm]
ckifpl:	ildb b,a
	jumpe b,notps
	caie b,"."
	 jrst ckifpl
	ildb b,a
	caie b,"p"
	 jrst ckifpl
	ildb b,a
	caie b,"s"
	 jrst ckifpl
	ildb b,a
	jumpe b,setfps		; ahh, plain old postscript extension
	caie b,"."		; maybe has a generation number too?
	 jrst ckifpl		; no, skip it then

setfps:	move a,jfn
	hrli a,.fbctl		; change that word
	movx b,fb%fcf		; change the file class field
	movx c,fld(.fbps,fb%fcf)	; ...
	chfdb%
notps:	
	move a,[point 7,temp]
	movei b,175
	idpb b,a
	move b,[point 7,trflnm]
	setz c,
	SOUT%
	move a,jfn
	hrli a,.sflwr
	hrroi 2,temp
	SFUST%			;set for spoolers to get file name
	 erjmp .+1
>
	MOVE A,JFN
IFE NICSW,<
	HRROI B,SUSRNM			; USE "FUJI.SATZ" AS REQUEST OWNER
>
IFN NICSW,<
	HRROI B,MBXUSR			; USE USER NAME AS OWNER, DUH.
>
	HRROI C,LPNAME			; GET PRINTER NAME
	HRROI D,TRFLNM			; USE TRUNCATED FILENAME AS NOTE
	CALL CREATE			; SEND IT ALL OFF TO QUASAR
	IFSKP.
	 LOG <Print %S for %S@%S on %S printer, job note "%S">,<LINE,MBXUSR,MBXHST,LPNAME,TRFLNM>
	 AOS (P)
	ENDIF.
	MOVE A,JFN
	RLJFN%			; RELEASE THE FILE HANDLE IN ANY CASE
	 ERJMP .+1
PRINT2:	SKIPE MAIFLG		;WANT MAIL SENT?
	CALL DOMAIL		;YES, SEND IT
	SETZM SPLFNM		; FLUSH THE SPOOL FILE NAME
	SETZM NOTE		; AND THE NOTE
	RET			; AND RETURN ACCORDING TO CREATE
;HERE TO CAN A PRINT REQUEST 
CANPRT:	MOVE A,JFN
	RLJFN%
	 ERJMP .+1
IFN DEBUG,<	
	LOG <CANPRT: canning print request for file %s%n last error: %e>,<SPLFNM>
>;IFN DEBUG
	SETOM CANFLG
	SKIPE MAIFLG		;Want to send mail?
	CALL DOMAIL		;Do it, tell bad news
	SETZM SPLFNM
	SETZM NOTE
	RET
	ENDSV.
;HERE TO RUN pr(1) OVER FILES
;TAKES A/JFN of input file
;RETURNS A/JFN of output file, input jfn has been closed and discarded

DOPR:	STKVAR <JFN1,JFN2,PRFORK,PRJFN,PRIJFN,PROJFN,<NMBUF,40>>
	MOVEM A,JFN1			;save input jfn
	MOVX A,CR%CAP			;make a fork with our caps
	SETZ B,
	CFORK%
	IFJER.				;mutant!
	 LOG <CFORK% in DOPR failed, last error: %e>
	 RET
	ENDIF.
	MOVEM A,PRFORK			;save handle on child
	MOVX A,GJ%SHT!GJ%OLD		;file must exist
	HRROI B,[ASCIZ/SYS:PR.EXE/]	;program to run
	GTJFN%
	IFJER.				;it didn't, oh well
	 LOG <Couldn't find SYS:PR.EXE in DOPR, last error: %e>
	 RET
	ENDIF.
	HRRZM A,PRJFN
	HRL A,PRFORK
	GET%				;put it in child's address space
	IFJER.
	 LOG <GET% in SYS:PR.EXE failed, last error: %e>
	 RET
	ENDIF.
	HRROI A,NMBUF			;copy name from jfn here
	MOVE B,JFN1
	MOVX C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)!JS%PAF			;<SPOOLING-DIRECTORY>FOOBAR.BAZ
	JFNS%
	IFJER.
	 LOG <Couldn't form filename for output file in DOPR, last error: %e>
	 RET
	ENDIF.
	MOVE A,JFN1
	HRLI A,.FBBYV
	MOVX B,FLD(-1,FB%RET)
	MOVX C,FLD(1,FB%RET)		;force gen retent. count to 1
	CHFDB%
	IFJER.
	 LOG <Couldn't CHFDB% input file in DOPR, last error: %e> ;cont., non-fatal
	ENDIF.
	MOVX A,GJ%SHT!GJ%FOU!GJ%NEW
	HRROI B,NMBUF
	GTJFN%
	 RET
	MOVX B,FLD(^D7,OF%BSZ)!OF%WR
	OPENF%
	 RET
	MOVEM A,JFN2
	MOVE A,JFN1
	MOVX B,FLD(^D8,OF%BSZ)!OF%RD
	OPENF%
	 RET
DOPR1:	MOVE A,JFN1
	MOVE B,[POINT 8,FCPYBF]
	MOVNI C,FCPLEN*4-1
	SIN%
	 ERJMP CPEOF
	MOVE A,JFN2
	MOVE B,[POINT 8,FCPYBF]
	MOVNI C,FCPLEN*4-1
	SOUT%
	JRST DOPR1
CPEOF:	ADDI C,FCPLEN*4-1		;assume EOF
	MOVNS C
	MOVE B,[POINT 8,FCPYBF]
	MOVE A,JFN2
	SOUT%
	CLOSF%
	IFJER.
	  LOG <Couldn't CLOSF% JFN2 in DOPR, last error:  %e>
	ENDIF.
	MOVE A,JFN1
	CLOSF%
	IFJER.
	  LOG <Couldn't CLOSF% JFN1 in DOPR, last error:  %e>
	ENDIF.
IFN 0,<
	CALL POPEN			;get a pipe
	IFNSK.				;oops, got lung cancer!
	 LOG <POPEN called in DOPR failed, last error %e> ;our dying gasp...
	 RET
	ENDIF.
	MOVEM A,PROJFN
	MOVEM B,PRIJFN
	MOVE A,PRFORK
	HRLO B,PRIJFN			;input from pipe, output to cntr. term
	SPJFN%
	IFJER.
	 LOG <Couldn't SPJFN% inferior in DOPR, last error: %e>
	 RET
	ENDIF.
>;IFN 0
	HRROI A,RSBUF
	HRROI B,[ASCIZ/PR </]	;>
	SETZB C,D
	SOUT%
	HRROI B,NMBUF
	SOUT%				;<
	HRROI B,[ASCIZ/ >/]
	SOUT%
	HRROI B,NMBUF
	SOUT%
	SKIPN TITLE
	IFSKP.
	 HRROI B,[ASCIZ/ -h /]
	 SOUT%
	 MOVEI B,42		;"
	 IDPB B,A
	 HRROI B,TITLE
	 SOUT%
	 MOVEI B,42
	 IDPB B,A
	ENDIF.
	MOVEI B,.CHCRT
	IDPB B,A
	MOVEI B,.CHLFD
	IDPB B,A
	MOVEI B,0
	IDPB B,A
IFN 0,<
	MOVE A,PROJFN
	HRROI B,RSBUF
	SETZB C,D
	SOUTR%
	IFJER.
	 LOG <SOUTR% in DOPR failed, last error: %e>
	 RET
	ENDIF.
	CLOSF%
	IFJER.
	  LOG <Couldn't CLOSF% PROJFN in DOPR, last error:  %e>
	ENDIF.
>;IFN 0
IFE 0,<
	HRROI A,RSBUF
	RSCAN%
	IFJER.
	 LOG <RSCAN to PR failed, last error: %e>
	 RET
	ENDIF.
	MOVX A,.RSINI
	RSCAN%
	IFJER.
	 LOG <RSCAN .RSINI failed, last error: %e>
	 RET
	ENDIF.
>;IFE 0
	MOVE A,PRFORK
	SETZ B,
	SFRKV%				;start it up
	IFJER.
	 LOG <Couldn't SFRKV% inferior in DOPR, last error: %e>
	 RET
	ENDIF.
	WFORK%				;wait for it to finish
	KFORK%				;terminate
	MOVX A,GJ%SHT!GJ%OLD
	HRROI B,NMBUF
	GTJFN%				;get jfn on file
	IFJER.
	 LOG <Couldn't re-GTJFN% output file in DOPR, last error: %e>
	 RET
	ENDIF.
	HRRZS A				;return it, success return
	RETSKP

;POPEN - create and open a pipe
;Returns +1 failure, T1/ error code
;        +2 success, T1/ JFN on write side
;                    T2/ JFN on read side

POPEN:  STKVAR <<PIPSTR,10>,WRTJFN,REDJFN>      ;Local storage
        MOVX T1,GJ%SHT          ;Using short form
        HRROI T2,[ASCIZ/PIP:/]  ;A pipe with default size buffers
        GTJFN%                  ;Create an instance of a pipe device
         ERJMP R
        MOVEM T1,WRTJFN         ;Save JFN, use it for the write side
        HRROI T1,PIPSTR         ;Write string into this buffer
        MOVE T2,WRTJFN          ;Get back the first JFN
        MOVE T3,[1B2!1B8!JS%PAF] ;Output device and filename w/punc
        JFNS%                   ;Build a second string for GTJFN%
        MOVEI T3,"."            ;Get dot to separate name and extension
        IDPB T3,T1              ;Tack on the dot
        MOVE T2,WRTJFN          ;Get back that JFN
        MOVX T3,1B8             ;Output filename again, no punc.
        JFNS%                   ;Create "PIP:#.#"
        SETZ T3,                ;Get a null byte
        IDPB T3,T1              ;Tie off the second GTJFN% string
        MOVX T1,GJ%SHT          ;Using short form
        HRROI T2,PIPSTR         ;Point to string we just built
        GTJFN%                  ;Get a JFN on the other side of pipe
         ERJMP R
        MOVEM T1,REDJFN         ;Use that as the read side
        MOVE T1,WRTJFN          ;Get the JFN to use for the write side
        MOVE T2,[FLD(7,OF%BSZ)!OF%WR]   ;7-bits, write access
        OPENF%                  ;Create write side
         ERJMP R
        MOVE T1,REDJFN          ;Get the JFN to use for the read side
        MOVE T2,[FLD(7,OF%BSZ)!OF%RD]   ;7-bits, read access
        OPENF%                  ;Create read side
         ERJMP R
        MOVE T1,WRTJFN          ;Return write JFN (input side)
        MOVE T2,REDJFN          ;Return read JFN (output side)
        RETSKP                  ;Skip return to caller
;DOMAIL - SEND MAIL TO USER
;Offsets for argument block
.QMLEN==:0			;Length of block (including this word)
.QMFRM==:1			;Pointer to FROM field
.QMTO==:2			;Pointer to TO field
.QMSUB==:3			;Pointer to SUBJECT field
.QMMSG==:4			;Pointer to message body
.QMSND==:5			;Pointer to Sender field
.QMMAX==:6			;Maximum length of argument block

DOMAIL:	HRROI A,MAILDS		;point at buffer for destination
	SKIPN MBXUSR		;do we have a user?
	 RET			;nope, quit now
	HRROI B,MBXUSR
	SETZM C
	SOUT%
	SKIPN MBXHST
	 RET
	HRROI B,MBXHST
	MOVEI C,"@"		;USER@
	IDPB C,A
	SETZM C
	SOUT%			;USER@HOST
	MOVEI B,0
	IDPB B,A
	HRROI A,MAILDS
	MOVEM A,MAIARG+.QMTO	;stuff argument block (to)
	SETZM A,MAIARG+.QMFRM	;let SNDMAI fill this in
	MOVEI A,5
	MOVEM A,MAIARG+.QMLEN	;length
	HRROI A,MSGBUF
	HRROI B,[ASCIZ/Your print request /]
	SETZM C
	SOUT%
	SKIPN TRFLNM
	IFSKP.
	 HRROI B,TRFLNM
	 SOUT%
	ENDIF.
	HRROI B,[ASCIZ/ has been cancelled.
/]
	SKIPN CANFLG
	 HRROI B,[ASCIZ/ has been queued for printing.
/]
	SOUT%
	MOVEI B,0
	IDPB B,A
	HRROI A,MSGBUF
	MOVEM A,MAIARG+.QMMSG
	MOVEI A,MAIARG
	CALL SNDMAI
	 LOG <Failed to send mail to %s@%s>,<MBXUSR,MBXHST>
	RET
;Mung note field into truncated filename
MNGNOT:	STKVAR <SAVPOS>
	MOVE B,[POINT 7,NOTE]		;POINT AT ORIGINAL NOTE FIELD
	MOVEM B,SAVPOS			;SAVE THAT AS 
MNGNT0:	ILDB A,B			;GET A CHARACTER
	CAIN A,"/"			;IS IT A "/"?
	 MOVEM B,SAVPOS			;SAVE THIS POSITION
	SKIPE A				;EOS?
	 JRST MNGNT0			;NOPE, LOOP BACK
	SETZM TRFLNM		
	MOVE A,[TRFLNM,,TRFLNM+1]
	BLT A,TRFLNM+20-1		;CLEAR IT OUT TO AVOID LOSSAGE
	HRROI A,TRFLNM			;THIS IS WHERE WE WANT TRUNC'D FILENAME
	MOVE B,SAVPOS			;GET WHERE WE SAW LAST "/"
	CAME B,[POINT 7,NOTE]		;WHAT WE STARTED WITH?
	 IBP B				;NOPE, ADVANCE OVER "/"
	CALLRET CPYSTR			;JUMP INTO STRING COPY ROUTINE, RETURN
	ENDSV.
	
; GETFNM - READ THE REMOTE FILENAME AND BUILD THE SPOOL FILE NAME

; A/ JFN

GETFNM:	ACVAR <JFN>			; SAVE JFN IN CASE WE CALL PRINT
	MOVE JFN,A			; ...
	SKIPN SPLFNM			; DO WE ALREADY HAVE A SPOOL FILE?
	IFSKP.
	 PUSH P,A			; SAVE THE JFN
	 CALL PRINT			; YES, PRINT IT
	  LOG <Print failed within multiple file group>
	 POP P,A
	ENDIF.
	PRINTF <%=%S!%S>,<REMUSR,MBXHST,MBXUSR>	; CREATE OWNER STRING
	MOVE A,JFN			; RESTORE THE JFN
	HRROI B,LINE			; SET UP DESTINATION
	CALL CMDLIN			; GET THE COMMAND LINE
	 RET				; FAILED?
	HRROI A,LINE			; POINT TO FILENAME
	CALL QUOTE			; QUOTE CHARS FOR CASE INSENSITIVITY
IFE STANSW&LOTSW,<
	PRINTF <%=PS:<SPOOL>%S.%S>,<SPLFNM,LINE,LPNAME>
>;IFE STANSW&LOTSW
IFN STANSW&LOTSW,<
	PRINTF <%=SPOOL:%S.%S>,<SPLFNM,LINE,LPNAME>
>;IFN STANSW&LOTSW
	ENDAV.				; FLUSH THE ASUBR SYMBOL
	RETSKP				; ALL DONE
; GTFNPR - GET FILE NAME FOR PR AND GO THROUGH GETFNM STUFF

; A/JFN

GTFNPR:	SETOM PRFLG
	CALLRET GETFNM
; PRTITL - SET UP TITLE FOR PR

; A/JFN

PRTITL:	SKIPE TITLE		; DO WE ALREADY HAVE A TITLE?
	 LOG <Second T command found - this shouldn't happen>
	HRROI B,TITLE		;SET DESTINATION
	CALLRET CMDLIN		;GET COMMAND LINE
; SETMAI - SEND MAIL AFTER PRINTING (QUEUEING, ACTUALLY)

;A/JFN

SETMAI:	SETOM MAIFLG		;WANT TO SEND MAIL WHEN DONE
	HRROI B,LINE
	CALLRET CMDLIN			;into the bitbucket with them bits!
; DONOTE - SET UP THE NOTE STRING

; A/ JFN

DONOTE:	SKIPE NOTE			; DO WE ALREADY HAVE A NOTE?
	 LOG <Second N command found - this shouldn't happen>
	HRROI B,NOTE			; SET UP DESTINATION
	CALLRET CMDLIN			; GET THE COMMAND LINE

; SETHST - SET UP HOSTNAME FOR SENDING MAIL

; A/ JFN

SETHST:	HRROI B,MBXHST
	CALLRET CMDLIN

; SETUSR - SET UP USERNAME FOR SENDING MAIL

; A/ JFN

SETUSR:	HRROI B,MBXUSR
	CALLRET CMDLIN

; FLUSH - IGNORE THE CURRENT INPUT LINE

; A/ JFN
IFE DEBUG,<
FLUSH:	HRROI B,LINE
	CALLRET CMDLIN
>;IFE DEBUG
IFN DEBUG,<
FLUSH:	LSH C,^D<36-7>
	MOVEM C,SAVCHR
	HRROI B,LINE
	CALL CMDLIN
	 LOG <failure return from CMDLIN in FLUSH - %e>
	LOG <flushing control card %s %s>,<SAVCHR,LINE>
	RETSKP
>;IFN DEBUG
	SUBTTL MISCELLANEOUS ROUTINES

; ACK - TELL REMOTE LPD WE'RE STILL WITH HIM
;
; RETURNS:
;	+1 FAILURE, CONNECTION CLOSED
;	+2 SUCCESS

ACK:	MOVE A,NETJFN			; TELL LPD WE'RE HERE
	HRROI B,[0]			; SEND A NULL BYTE
	MOVNI C,1
	SOUTR%				; SEND A NULL
	 ERJMP NETEOF			; CLOSE CONNECTION ON ERROR
	RETSKP				; OTHERWISE, RETURN SUCCESS

; NAK - SEND NEGATIVE ACKNOWLEDGEMENT AND FAIL RETURN
;
; RETURNS +1 ALWAYS, CONNECTION CLOSED

NAK:	SKIPE NETJFN			; HAVE A JFN?
	 PRINTF <%p
%s: LPD: fatal error
>,<netjfn,ournam>
	CALLRET NETCLS
; NETEOF - PRINT ERROR MESSAGE AND CLOSE THE NETWORK CONNECTION
;
; RETURNS +1 ALWAYS

NETEOF:	LOG <NETEOF: %E>
	CALLRET NETCLS

; NETCLS - CLOSE THE CONNECTION
;
; RETURNS +1 ALWAYS

NETCLS:	SKIPN A,NETJFN			; HAVE A JFN?
	 JRST NETCL1
	LOG <Closing connection from %H>,<HOSTNO>
	MOVX A,CLSINT			; GET TIMEOUT INTERVAL FOR NET CLOSE
	CALL ALARM			; SET UP NEW TIMER INTERRUPT
	IFNSK.
	 LOG <Close timed out>
	 JRST NETCL1
	ENDIF.
	MOVE A,NETJFN			; GET THE JFN
IFDEF TCOPR%,<
	MOVEI B,.TCSFN
	TCOPR%				; SEND A FIN
	IFJER.
	 LOG <Can't send FIN: %E>,.+1
	ENDIF.
	MOVE A,NETJFN			; GET THE JFN
>;IFDEF TCOPR%
	TXO A,CZ%ABT			; ALREADY SENT FIN, DON'T WAIT
	CLOSF%				; YES, CLOSE IT
	IFJER.
	 LOG <close failed, last error: %E>
	ENDIF.
NETCL1:	SETZM NETJFN			; CLEAR JFN CELL
	SETZM HOSTNO			; CLEAR HOST NUMBER
	SETZM LPNAME			; CLEAR PRINTER NAME
	RET
; GETLPN - READ THE REMOTE PRINTER NAME

GETLPN:	CALL GETLIN			; READ IN CURRENT LINE
	 RET
	HRROI A,LPNAME
	HRROI B,LINE
	CALL GETWRD			; EXTRACT LINE PRINTER NAME
	 RET
	RETSKP				; ALL DONE
; GETFIL - COPY A FILE FROM THE REMOTE LPD TO DISK
;
; RETURNS:
;	+1 FAILED
;	+2 FILE READ AND WRITTEN TO DISK
;
; COUNT/ NEGATIVE COUNT OF REMAINING CHARACTERS 
;
; GETFL8 IS AN ALTERNATE ENTRY POINT WHICH SPECIFIES THAT
; THE FILE IS TO BE OPENED IN 8-BIT MODE.

GETFL8:	SKIPA A,[8]
GETFIL: MOVEI A,7
	ACVAR <COUNT,XFRSIZ,FILBSZ>
	MOVEM A,FILBSZ		; Save the byte size
	MOVE A,NETJFN		; source is net connection
	MOVEI C,^D10		; radix is decimal
	NIN%			; read length of file in chars
	 ERJMP NETEOF
	MOVEM B,COUNT		; save it
	CALL GETLIN		; read rest of current line
	 RET
	SETZM LPDFIL
	MOVE A,[LPDFIL,,LPDFIL+1]
	BLT A,LPDFIL+LINLEN-1
	HRROI A,LPDFIL		; destination is filnam
	HRROI B,LINE		; source is line we just read
	CALL GETWRD		; extract the filename
	 RET
	HRROI A,LPDFIL
	CALL QUOTE		;quote letters with ^V for case (in)sensitivity
IFE STANSW&LOTSW,<
	PRINTF <%=PS:<SPOOL>%S.%S>,<FILNAM,LPDFIL,LPNAME>
>;IFE STANSW&LOTSW
IFN STANSW&LOTSW,<
	PRINTF <%=SPOOL:%S.%S>,<FILNAM,LPDFIL,LPNAME>
>;IFN STANSW&LOTSW
	MOVX A,GJ%SHT
	HRROI B,FILNAM
	GTJFN%			; get a handle on the spool file
	 FATAL (Can't get a JFN for %S - %E,FILNAM)
	MOVEM A,DSKJFN
	MOVX B,OF%WR		; get the write-access bit
	MOVE C,FILBSZ		; get the bytesize
	STOR C,OF%BSZ,B		; store it
	OPENF%			; open the file for write
	IFNSK.			;
	 FATAL (Can't open %S - %E,FILNAM,.+1)
	 MOVE A,DSKJFN
	 RLJFN%
	  ERJMP .+1
	 SETZM DSKJFN
	 RET
	ENDIF.
FILELP:	MOVE A,NETJFN
	MOVE B,[POINT 8,BUFFER]	; make an 8-bit byte pointer
	MOVE C,COUNT		; get the number of characters left
	MOVEI D,BUFLEN*5-1	; assume 7 bit chars
	CAIE FILBSZ,^D7		;
	 MOVEI D,BUFLEN*4-1	; except if 8 bit
	CAMLE C,D		; greater than buffer length?
	 MOVEI C,(D)		; yes, subsitute buffer length
	MOVEM C,XFRSIZ		; remember transfer size we asked for
	MOVEI D,.CHLFD
	SIN%			; read some input
	 ERJMP NETEOF		; connection went away
	SUB XFRSIZ,C		; update count of characters read
	MOVE A,DSKJFN		; get destination file jfn
	MOVE B,[POINT 8,BUFFER]	;
	MOVN C,XFRSIZ		;
	SOUT%			;
	SUB COUNT,XFRSIZ	; update count of remaining characters
	JUMPN COUNT,FILELP	; if more to read, loop
	MOVE A,NETJFN		; get the network jfn again
	BIN%			; get the null we should see here
	 ERJMP NETEOF		; connection gone?
	SKIPE B
	 FATAL (DIDN'T FIND EXPECTED NULL IN STREAM)
	MOVE A,DSKJFN		; else close the output file
	CLOSF%			; ...
	 FATAL (CAN'T CLOSE %S - %E,FILNAM)
	SETZM DSKJFN
	ENDAV.			; flush acvar symbols
	RETSKP			; all done
; GETWRD - EXTRACT A SPACE-DELIMITED TOKEN FROM A LINE

; ACCEPTS:
;	A/ DESTINATION STRING POINTER
;	B/ SOURCE STRING POINTER
; RETURNS:
;	+1 NO WORD FOUND BEFORE EOL
;	+2 SUCCESS, WITH IPDATED STRING POINTER IN B

GETWRD:	TLC A,-1		; convert -1,,addr to point 7,addr
	TLCN A,-1
	 HRLI A,(POINT 7,)
	TLC B,-1
	TLCN B,-1
	 HRLI B,(POINT 7,)
	DO.
	 ILDB C,B		; get a byte
	 CAIE C,.CHLFD
	 CAIN C,.CHNUL
	  RET
	 CAIE C,.CHTAB			; NULL?
	 CAIN C,.CHSPC			; SPACE?
	  LOOP.
	OD.
	DO.
	 IDPB C,A		; got a good byte, deposit it
	 ILDB C,B		; get another one
	 CAIE C,.CHNUL		; end of the token?
	 CAIN C,.CHSPC
	  EXIT.			; yes, exit loop
	 CAIE C,.CHLFD		; linefeed?  shouldn't find one
	 CAIN C,.CHTAB		; tab?  not likely
	  EXIT.			; one or the other, exit loop
	 LOOP.			; and loop
	OD.
	SETZ C,			; found end of word, make it asciz
	IDPB C,A
	RETSKP			; all done
				
; GETLIN - GET A LINE FROM THE NETWORK CONNECTION

GETLIN:	MOVE A,NETJFN		; source is the network
	SETZM LINE
	MOVE B,[LINE,,LINE+1]
	BLT B,LINE+LINLEN-1	;clear out line before reading into it
	HRROI B,LINE
;	callret cmdlin			; fall through to cmdlin

; CMDLIN - READ A LINE (TERMINATED BY A LINEFEED)

; A/ JFN
; B/ DESTINATION BYTE POINTER

CMDLIN:	MOVEI C,LINLEN*5-1	; max length (in 7 bit chars)
	MOVEI D,.CHLFD		; break on linefeed
	SIN%			; read the printer name
	 ERJMP R		; failed?
	LDB D,B			; get the last character
	CAIE D,.CHLFD		; linefeed?
	 FATAL (LINE TOO LONG)	; no, forget it
	SETZ D,				; REMOVE THE TRAILING LINEFEED
	DPB D,B				; ...
	RETSKP				; ALL DONE
; LC - LOWERCASE A STRING IN PLACE

LC:	TLC A,-1			; CONVERT -1,,ADDR TO POINT 7,ADDR
	TLCN A,-1
	 HRLI A,(POINT 7,)
LCLP:	ILDB B,A		; get a byte
	JUMPE B,R		; if null, all done
	CAIL B,"A"		; uppercase?
	CAILE B,"Z"		; ...
	 JRST LCLP		; no, loop
	ADDI B,"a"-"A"		; yes, convert to lowercase
	DPB B,A			; and put it back
	JRST LCLP		; loop for more
; QUOTE - Quote a line with ^V's in place
; Takes A/ pointer to string
; Returns: +1 always, 
QUOTE:	SAVEAC<C>		;save C since we step on it
	STKVAR <<TEMP,40>>	;big temporary buffer
	MOVE C,A		;save user's pointer
	MOVE B,A		;copy from user buffer into our buffer
	HRROI A,TEMP
	CALL CPYSTR		;we now have a copy in TEMP
	MOVE A,C
	TLC A,-1		;fix up -1,,ADDR into POINT 7,ADDR
	TLN A,-1		;if needed
	 HRLI A,(POINT 7,)
	MOVE B,[POINT 7,TEMP]	;point to our buffer
QUOTLP:	ILDB C,B		;get a character
	CAIN C,"."		;a dot?
	 JRST QUOTL0		;yes, quote it so it isn't filename punc.
	CAIL C,"a"		;lowercase?
	 CAILE C,"z"
	  JRST QUOTL1		;no, just copy it
QUOTL0:	MOVEI D,""		;get quoting character
	IDPB D,A		;save in user buffer
QUOTL1:	IDPB C,A		;save char in user buffer
	JUMPE C,R		;null, all done, return
	JRST QUOTLP		;loop back

	ENDSV.
; ALARM - TIMER COROUTINE
;
; ACCEPTS:
;	A/	TIME IN MILLISECONDS TO WAIT
;
; RETURNS:
;	+1 CALLER TIMED OUT
;	+2 TIMER INTERRUPT SET
;
; THIS COROUTINE SETS UP A TIMER INTERRUPT AND THEN CALLS IT'S
; CALLER (WITH WHAT LOOKS LIKE A +2 RETURN).  IF THE CALLER RETURNS
; BEFORE THE SPECIFIED TIME HAS ELAPSED, THIS ROUTINE JUST RETURNS
; +1 OR +2 TO THE CALLER'S CALLER, DEPENDING ON HOW THE CALLER RETURNED.
; IF THE TIMER INTERRUPT OCCURS BEFORE THE CALLER RETURNS, THEN WE
; RESTORE THE STACK POINTER TO WHAT IT WAS ON ENTRY, AND RETURN +1
; TO THE CALLER.  THE STACK POINTER IS CHANGED, SO THIS MUST BE CALLED
; BEFORE ANYTHING THAT DEPENDS ON THAT (LIKE STKVAR), BUT AFTER ROUTINES
; WHICH RESTORE ACS LIKE SAVEAC, TRVAR, ETC.
;
; THE CONTENTS OF THE ACS ARE UNCHANGED AFTER A +2 ROUTINE (EXCEPT FOR
; CX AND P), BUT INDETERMINATE (EXCEPT FOR P) AFTER A +1 RETURN.
;
; N.B. THIS ROUTINE PRECLUDES THE USE OF TIMER INTERRUPTS FOR ANY OTHER
; PURPOSE. TO BE MORE GENERAL, THIS ROUTINE SHOULD SAVE AND RESTORE ALL ACS,
; AND MAINTAIN A STACK OF TIMEOUT INTERVALS SO ALARMS CAN BE NESTED AND USED
; INTERACTIVELY WITH OTHER TIMERS.

ALARM:	CALL TMROFF			; FLUSH ANY OLD TIMERS
	MOVEM P, TIMERP			; SAVE STACK POINTER FOR TMRINT
	PUSH P, (P)			; PUSH CURRENT STACK TOP DOWN
	AOS (P)				; CALCULATE NEW "RETURN ADDRESS"
	CALL TMRON			; SET UP THE TIMER INTERRUPT
	CALL @(P)			; CALL OUR CALLER
	 SKIPA				; PROPOGATE ANY SKIP RETURN
	  AOS -2(P)			;  BY BUMPING CALLER'S RETURN PC
	CALL TMROFF			; DISABLE THE TIMER INTERRUPT
	ADJSP P, -2			; FORGET DUMMY RETURNS ADDR'S
	RET				; RETURN TO CALLER'S CALLER
; TIMER INTERRUPT HANDLER

TMRINT:	MOVE P, TIMERP			; RESTORE STACK POINTER
	POP P, LEV1PC			; SET UP RETURN TO TIMEIT'S CALLER
	DEBRK%
	 ERMSG (CAN'T DISMISS TIMER INTERRUPT)

; TMRON - TURN ON TIMER INTERRUPT

; A/ MILLISECONDS UNTIL TIMER INTERRUPT

TMRON:	SAVEAC <A,B,C>			; SAVE AC'S WE NEED
	MOVEI C, TMRCHN			; C/ CHANNEL TO INTERRUPT ON
	MOVE B, A			; B/ TIMEOUT INTERVAL
	MOVE A, [XWD .FHSLF,.TIMEL]	; A/ FORK,,FUNCTION CODE
	TIMER%				; SET UP TIMER INTERRUPT
	 ERMSG (CAN'T SET UP TIMER INTERRUPT)
	RET				; RETURN

; TMROFF - TURN OFF TIMER INTERRUPT

TMROFF:	SAVEAC <A,B,C>			; SAVE AC'S WE NEED
	MOVE A, [XWD .FHSLF,.TIMAL]	; A/ FORK.,,FUNCTION CODE
	SETZB B, C			; NO INTERVAL OR CHANNEL
	TIMER%				; REMOVE ALL PENDING INTERRUPTS
	 ERMSG (CAN'T REMOVE PENDING TIMER INTERRUPTS)
	RET				; RETURN

.ENDPS
; Storage Definitions

;Per-subfork data

.PSECT IDATA
PDL:	BLOCK PDLEN
INITF:	0			;0 if never run before, -1 if initialized
SUPERF:	0			;0 if inferior, -1 if top level
SCNFLG:	0
TIMERP:	0
LEV1PC:	0			;level 1 pc save location
LEV2PC:	0			;level 2 pc save location
LEV3PC:	0			;level 3 pc save location
SPLDIR:	0			;dir. no. of spooling directory
HOSTNO:	0			;remote host addr
NETJFN:	0			;network jfn
LOGJFN: 0			;logfile jfn
DSKJFN: 0			;cfa* or dfa* jfn (disk file)
PRFLG:	0			;use pr for this guy
DITFLG:	0			;use ditroff for this guy
TRFFLG:	0			;use troff for this guy
MAIFLG:	0			;send user mail when done
CANFLG:	0			;cancelling this guy
IFN DEBUG,<
SAVCHR:	0			;character of command card being flushed
>;IFN DEBUG
LINE:	BLOCK LINLEN		;line of network input
BUFFER:	BLOCK BUFLEN		;file buffer
LPDFIL:	BLOCK LINLEN		;current file name from remote lpd
FILNAM:	BLOCK LINLEN		;name field of TOPS-20 file name
SPLFNM:	BLOCK LINLEN		;spool file name
LPNAME:	BLOCK 20		;name of printer to use
OURNAM:	BLOCK 20		;our host name
HSTNAM:	BLOCK 20		;originator's host name
USRNAM:	BLOCK 20		;originator's user name
NOTE:	BLOCK 20		;note field for listing
TITLE:	BLOCK 20		;title for PR
MBXHST:	BLOCK 20		;mail host (NYI)
MBXUSR:	BLOCK 20		;mail user (NYI)
REMUSR:	BLOCK 40		;host!user
REMHST:	BLOCK 20		;remote internet host name (needed?)
SUSRNM:	BLOCK 20		;"host.user"
TRFLNM:	BLOCK 20		;/a/b/c/d -> d
REQNO:	BLOCK 2			;request number (both text and number)
REQUSR:	BLOCK 20		;request for this user (/user:)
PXYUSR: BLOCK 40		;used with REQUSR in LPQRM
CNBLK:	BLOCK CN.MAX+1		;arg block for cancel (lpdqsr)
MSGBUF:	BLOCK 20		;message buffer
MAILDS:	BLOCK 20		;destination of message (foo@site)
MAIARG:	BLOCK 6			;argument block for SNDMAI
RSBUF:	BLOCK 50			;rscan buffer for PR and friends
FCPLEN==5000			;5 pages for copying files from 8 to 7 bits
FCPYBF:	BLOCK FCPLEN		;buffer for doing so
.ENDPS
;Main fork data locations
.PSECT SDATA

NRUN:	0			;active fork count
NFORKS:	0			;subfork count
NJFNS:	0			;connection count
FKSTAT:	BLOCK NFKS		;fork status
IFN DEBUG,<
FKTIM1:	BLOCK NFKS		;fork clock time
FKTIM2:	BLOCK NFKS		;fork cpu time
>;IFN DEBUG
FRKACS:	BLOCK 20		;fork acs on inferior startup
.ENDPS

.PSECT PURE
IFN DEBUG,<
CHNTAB:	2,,TMRINT
	2,,STSINT
	REPEAT <.ICIFT-<.-CHNTAB>>,<EXP 0>
	2,,FRKINT
	REPEAT <^D36-<.-CHNTAB>>,<EXP 0>
>;IFN DEBUG
IFE DEBUG,<
CHNTAB:	2,,TMRINT
	REPEAT <.ICIFT-<.-CHNTAB>>,<EXP 0>
	2,,FRKINT
	REPEAT <^D36-<.-CHNTAB>>,<EXP 0>
>;IFE DEBUG

LEVTAB:	LEV1PC
	LEV2PC
	LEV3PC

EVEC:	JRST START
	JRST LPD
	BYTE (3)VWHO(9)VMAJOR(6)VMINOR(18)VEDIT	
EVECL==.-EVEC
.ENDPS

END <EVECL,,EVEC>