Google
 

Trailing-Edge - PDP-10 Archives - tops20tools_v6_9-jan-86_dumper - tools/phone20/phnsrv.mac
There are 3 other files named phnsrv.mac in the archive. Click here to see a list.
;MSC:<BUDNE.FONE.REED>PHNSRV.MAC.1003 16-Aug-85 NM+1D.1H.51M.13S., by BUDNE
; Released to "integration tools clearinghouse"
;MSC:<BUDNE.FONE>PHNSRV.MAC.1000 26-Dec-84 NM+4D.10H.50M.52S., by BUDNE
; Remove PTYnnn STUFF
;MSC:<BUDNE.FONE>PHNSRV.MAC.999 10-Jun-84 FQ+4D.14H.0M.3S., by BUDNE
; CLEAR ALL USRXX VARS AT KFORK TIME
;MSC:<BUDNE.FONE>PHNSRV.MAC.995  5-Jun-84 NM+7D.0H.5M.41S., by BUDNE
; ONLY RETURN STATUS FOR DIR, VERIFY, AND RING (AS WITH VAX)
	TITLE	PHNSRV - TOPS-20 Phone server
	SUBTTL	Robert A. Brown/Philip L. Budne

	SUBTTL	Definitions and symbols
	SEARCH	MONSYM,MACSYM,JOBDAT
	SALL			;PRETTY LISTINGS
	.DIRECTIVE FLBLST	;PRETTIER LISTINGS
	.REQUEST SYS:MACREL	;FOR ACVAR

PURPAG==400			;PAGE FOR PURE CODE & DATA
PURADR==PURPAG*1000		;ADDRESS FOR PURE CODE & DATA

	TWOSEG	PURADR

ASCIZ "
Copyright (c) 1984, 1985 by Philip L. Budne and Digital Equipment Corp.
"
; This program may be copied for non profit use, with the inclusion of
; the above Copyright.  No title to and ownership of the software is
; hereby transferred.
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by anyone.
;
; Neither Digital nor the Author assume responsibility for the use or
; reliability of this software anywhere.


;Parameters
EDIT==^D1000			;LAST MAJOR EDIT
MAXJOB==^D510			;NUMBER OF JOBS TO SCAN
MAXSRV==^D10			;MAXIMUM NUMBER OF INFERIOR SERVER FORKS
IFNDEF DEBUGF,DEBUGF==0		;DEBUG MODE

DATAPG==300			;PAGE FOR DATA BUFFER IN INFERIOR
DATADR=DATAPG*1000		;ADDR TO MATCH
DATLEN==1000			;ONE PAGE OF DATA

;Rel 6.0 Symbols
IFNDEF .TT102,.TT102==:^D37	;VT102
IFNDEF .TTH19,.TTH19==:^D38	;HEATHKIT/ZENITH H19/Z19
IFNDEF .TT131,.TT131==:^D39	;VT131
IFNDEF .TT200,.TT200==:^D40	;VT200
IFNDEF .MORTF,.MORTF==:54	;READ TERMINAL FLAGS
IFNDEF MO%NUM,MO%NUM==:1B34	;  REFUSE USER-MESSAGES
IFNDEF MO%NTM,MO%NTM==:1B35	;  INHIBIT NON-JOB OUTPUT

;AC definitions
T0==0
T1==1
T2==2
T3==3
T4==4
T5==5

.FPAC==6			;FIRST PRESERVED AC
.NPAC==14-6			;THIS MANY (6..13)

AX==14				;BYTE POINTER
I==15				;USER INDEX (** DO NOT TRY USING TRVAR!! **)
;;;16				;USED BY MACSYM (ACVAR,STKVAR)
P==17				;PDL

;Instructions
OPDEF	PJRST	[ JUMPA	13, ]
OPDEF	$FATAL	[ 1B8 ]		;ERROR LUUO

DEFINE	RETSKP	< JRST	CPOPJ1 >
DEFINE	FATAL(MESS) <
  IFB <MESS>,< $FATAL 0 ;> $FATAL [ASCIZ ~MESS~]
> ;FATAL

DEFINE	EFATAL(MESS) < ERCAL [ FATAL(MESS) ] > ;EFATAL
;Protocol message codes
MS$CHK==:^D7			;CHECK USER
MS$RNG==:^D8			;RING PHONE
MS$HUP==:^D9			;HANGUP
MS$BUS==:^D10			;TARGET IS BUSY
MS$ANS==:^D11			;TARGET HAS ANSWERED
MS$REJ==:^D12			;REJECT CALL
MS$DON==:^D13			;DONE WITH SLAVE
MS$TXT==:^D14			;CONVERSATION TEXT
MS$DIR==:^D15			;NEXT DIRECTORY LINE
MS$FAX==:^D16			;MAKE A RECORD FACSIMILE (*NOT USED*)
MS$3RD==:^D17			;HANDLE FORCED LINK TO THIRD PARTY
MS$HLD==:^D18			;PUT ON HOLD
MS$OFF==:^D19			;TAKEN OFF HOLD

;Status codes
ST$OTH==:^D0			;OTHER..
ST$AOK==:^D1			;OK
ST$IUS==:^D2			;INVALID USER SYNTAX
ST$FAI==:^D3			;SLAVE FAILED
ST$UID==:^D4			;UID MISSING
ST$SNP==:^D5			;SLAVE DOES NOT HAVE PRIVS
ST$UNE==:^D6			;USER DOES NOT EXIST
ST$TTY==:^D7			;PHONE CANNOT USE TTY
ST$LOG==:^D8			;USER HAS LOGGED OFF
ST$OFF==:^D9			;"OFF THE HOOK" /NOBROAD, REFUSE LYNX, TTY GAG
	SUBTTL	SHARED VARIABLES

MYPID:	BLOCK	1		;PHNSRV PID (USED BY INFERIORS)
LCLNOD:	BLOCK	2		;LOCAL NODE NAME (USED BY INFERIORS)
TRCFLG:	BLOCK	1		;TRACE FORK TERMINATIONS (FOR TESTING)
PIGFLG:	BLOCK	1		;INFERIORS RUN LOCKED IN HIGH QUEUE (OFF)
NUMACT:	BLOCK	1		;NUMBER OF ACTIVE INFERIORS

;PER FORK INFORMATION (SHARED)
USRFK:	BLOCK	MAXSRV		;FORK INDEX FOR THIS USER SLAVE PROCESS
USRPD:	BLOCK	MAXSRV		;TARGET USER'S PID
USRNM:	BLOCK	MAXSRV		;TARGET USER'S USER NUMBER
USRJB:	BLOCK	MAXSRV		;TARGET USER JOB NUMBER
USRJF:	BLOCK	MAXSRV		;TARGET USER JFN

SYSVER:	BLOCK	40		;SYSTEM VERSION STRING (FOR SYSTAT)
;;;PTYPAR:	BLOCK	1		;NUMBER OF FIRST PTY (FOR DIR/SYSTAT)
OPRUNO:	BLOCK	1		;OPERATOR USER NUMBER (FOR DIR/SYSTAT)
P1FLG:	BLOCK	1		;PSI LEVEL 1 PC
P2FLG:	BLOCK	1		;PSI LEVEL 2 PC
P3FLG:	BLOCK	1		;PSI LEVEL 3 PC
ACSAVE:	BLOCK	17		;AC SAVE AREA FOR FORK TERMINATION INTERUPT
	SUBTTL	IMPURE STORAGE

; **Private copies of these exist for each fork**

	RELOC			;TO LOW SEG
PLIST:	BLOCK	<LPLIST==30>	;PUSH DOWN LIST (STACK)
JUNK:	BLOCK	100		;TEMP JUNK BUFFER
SAVPNT:	BLOCK	1		;BP TO DATA FIELD OF MESSAGE
GJIBLK:	BLOCK	.JIMAX+1	;FOR GETJI'S IN RING ETC..
PC1:	BLOCK	1		;INFERIOR LEVEL 1 PSI PC
FOJBLK:	BLOCK	3		;BLOCK FOR .MUFOJ IN CHKPID
QRYBLK:	BLOCK	10		;BLOCK FOR .MUQRY IN QRYPID
RINGFL:	BLOCK	1		;STATE OF RING FLAG
ONCE:	BLOCK	1		;FIRST TIME FLAG (DIR,SYSTAT)
NETJFN:	BLOCK	1		;NETWORK JFN FROM FOREIGN MASTER

IPCBLK:	BLOCK	20		;DATA BUFFER (FOR SUPERIOR IPCF ONLY)
IPRCVS:	BLOCK	11		;MRECV BLOCK
IPSNDS:	BLOCK	4		;MSEND BLOCK

PIDNAM:	BLOCK	^D<<39+7+4>/5>	;USER PID NAME

	RELOC			;BACK TO HISEG
	SUBTTL	CONSTANTS

LEVTAB:	EXP	P1FLG,P2FLG,P3FLG ;PSI LEVEL TABLE

DEFINE	XX	(LEV,ADR,OFF,LBL) <
    IFNB <OFF>,BLOCK OFF-.
    IFNB <LBL>,LBL:!
    IFN <LEV+ADR>,<
	CHNMSK==CHNMSK!1B<.>
	LEV,,ADR
    > ;IFN LEV+ADR
> ;XX

CHNMSK==0
CHNTAB:	PHASE	0		;PSI CHANNEL TABLE
	XX	1,CONINT,,CONCHN ;DECNOT CONNECT
	XX	1,POVINT,.ICPOV	;PDL OVERFLOW
	XX	1,EOFINT,.ICEOF	;EOF
	XX	1,DAEINT,.ICDAE	;DATA ERROR
	XX	1,ILIINT,.ICILI	;ILL INSTR
	XX	1,INFINT,.ICIFT	;INFERIOR FORK TERMINATION
	XX	0,0,^D36	;FILL UP TABLE
	DEPHASE
	SUBTTL	SERVER DISPATCH TABLE

DEFINE	ACTION(OFFSET,ROUT) <
	BLOCK	OFFSET-.
	EXP	ROUT
> ;ACTION

DSPTAB:	PHASE	0		;*** FUNCTION DISPATCH ***
	ACTION	MS$CHK,CHECK	;Check out user		(*) RETURNS STATUS
	ACTION	MS$RNG,RING	;Ring phone		(*) RETURNS STATUS
	ACTION	MS$HUP,FORWRD	;Remote has hung up
	ACTION	MS$BUS,FORWRD	;Master is busy
	ACTION	MS$ANS,FORWRD	;Phone answered
	ACTION	MS$REJ,FORWRD	;Call rejected
	ACTION	MS$DON,SRVERR	;Slave no longer needed
	ACTION	MS$TXT,FORWRD	;Conversation text
	ACTION	MS$DIR,DIRECT	;Directory request	(*) RETURNS STRING
	ACTION	MS$FAX,0	;Facsimile (**NOT USED**)
	ACTION	MS$3RD,FORWRD	;Add third party
	ACTION	MS$HLD,FORWRD	;Put PHONE on hold
	ACTION	MS$OFF,FORWRD	;Take PHONE off hold
MAXDSP==.-1
	DEPHASE
	SUBTTL	MAIN PROGRAM

START:	RESET			;STOP THE WORLD!!
	MOVE	P,[IOWD LPLIST,PLIST] ;SET UP PDL
	MOVE	T1,[CALL LUUOH]	;LUUO INSTR
	MOVEM	T1,.JB41	;STORE
	CALL	PSIINI		;INITIALIZE PSI SYSTEM
	CALL	INIT		;INITIALIZE THE WORLD
	CALL	IPCINI		;INITIALIZE IPCF
	CALL	NEWJFN		;GET NET JFN
	WAIT			;SLEEP UNTIL CONNECT
CONWAI:	JFCL			;PC ENDS UP HERE
NEWJFN:	SETZM	NETJFN		;NO LISTENER JFN
	MOVSI	T1,(GJ%SHT)	;SHORT FORM
	HRROI	T2,[ASCIZ/SRV:29./] ;TELEPHONE SERVER
	GTJFN			;GET JFN
	 FATAL	(Could not get JFN) ; CAN'T?

	MOVX	T2,<FLD(8,OF%BSZ)!OF%WR!OF%RD> ;OPEN FOR READ/WRITE IN 8 BIT
	OPENF			;TRY IT!
	 FATAL	(Could not open JFN)

	MOVEM	T1,NETJFN	;SAVE SERVER JFN
	MOVEI	T2,.MOACN	;ASSIGN INTERRUPT SYSTEM CHANNEL NUMBERS
	MOVX	T3,<FLD(CONCHN,MO%CDN)!FLD(.MOCIA,MO%DAV)!FLD(.MOCIA,MO%INA)>
	MTOPR			;DEVICE OPERATION; ENABLE FOR CONNECT INTERUPTS
	 EFATAL	(Could not connect to PSI)
	RET

CONINT:
IFE DEBUGF,<
	CALL	GOTCON		;HANDLE CONNECT INTERUPT
	CALL	NEWJFN		;GET FRESH NET JFN
> ;IFE DEBUGF
IFN DEBUGF,<
	SETZ	I,
	MOVE	T1,NETJFN	;GET JFN
	MOVEM	T1,USRJF(I)	;SAVE
	MOVEI	T2,.MOCC	;CONNECT
	SETZB	T3,T4		;NO DATA
	MTOPR			;DEVICE FUNCTION
	MOVEI	T1,SERVER
	MOVEM	T1,P1FLG
> ;IFN DEBUGF
	DEBRK			;RETURN FROM INTERUPT
	 EFATAL	(CONINT DEBRK failed)

GOTCON:	MOVSI	I,-MAXSRV	;FOR ALL FORKS
GOC.1:	SKIPE	USRFK(I)	;FREE?
	 AOBJN	I,GOC.1		; NO, KEEP LOOKING
	JUMPGE	I,GOC.2		;NONE FOUND, REJECT
	MOVE	T1,NETJFN	;GET JFN
	MOVEI	T2,.MOCC	;CONNECT
	SETZB	T3,T4		;NO DATA
	MTOPR			;DEVICE FUNCTION
	 ERJMP	GOC.2		;FAILED!
	CALL	NEWFRK		;START SERVER
	 JRST	GOC.2		; FAILED
	RET			;AOK
GOC.2:	MOVE	T1,NETJFN	;GET JFN
	TLO	T1,(CZ%ABT)	;ABORT I/O
	CLOSF			;CLOSE
	 ERJMP	.+1		; SIGH
	RET
	SUBTTL	SERVER FORK MAIN CODE

SERVER:
IFE DEBUGF,<
	RESET			;STOP THE WORLD!
> ;IFE DEBUGF
	MOVE	P,[IOWD LPLIST,PLIST] ;GET A PDL
	MOVEI	T1,.FHSLF	;THIS FORK
	SETO	T3,		;ALL CAPS
	EPCAP			;ENABLE

IFE DEBUGF,<
	SKIPN	PIGFLG		;BE PIGGY?
	 IFSKP.			; CHECK...
	  MOVX	T2,<FLD(1,JP%MNQ)!FLD(2,JP%MXQ)> ;RUN IN QUEUE 1
	  SPRIW			;GET PIGGY
	   ERJMP .+1	;SIGH
	 ENDIF.
> ;IFE DEBUGF

;Clear shared vars
	SETZM	USRPD(I)	;NO MORE PID
	SETZM	USRNM(I)	;NO MORE USER NUMBER
	SETZM	USRJB(I)	;NO MORE JOB

;Clear private vars
	SETZM	RINGFL		;NO FIRST RING
	SETZM	ONCE		;ZERO COUNT
	SUBTTL	SERVER MAIN LOOP
SRVLOP:	MOVE	T1,USRJF(I)	;GET FILE
	MOVE	T2,[POINT 8,DATADR] ;GET ADDRESS
	MOVNI	T3,DATLEN*4-1	;GET LENGTH IN 8 BIT BYTES (W/ ROOM FOR NULL)
	SINR			;READ!
	 ERJMP	SRVERR		;SIGH
	ADDI	T3,DATLEN*4-1	;GET LENGTH OF DATA
	SETZ	T1,		;GET NULL
	IDPB	T1,T2		;ENSURE ASCIZ

	MOVE	AX,[POINT 8,DATADR] ;INTIAL BYTE POINTER
	ILDB	T1,AX		;GET COMMAND BYTE
	CAIG	T1,MAXDSP	;IN RANGE?
	 SKIPN	T1,DSPTAB(T1)	;GET DISPATCH ADDR
	  MOVEI	T1,SNDOTH	; RETURN "SOME OTHER ERROR"
	CALL	(T1)		;EXECUTE
	 TRN			;EXPECT THE UNEXPECTED
	JRST	SRVLOP		;LOOP

SRVERR:	HALTF			;DIE ON ERROR
SRVDED:	JFCL			;MAGIC LABEL
IFN 0,<
;Remote systat
SYST:	MOVE	AX,[POINT 8,DATADR] ;Initial byte pointer
	SKIPN	T1,ONCE		;First time ?
	 JRST	[AOS	T1,ONCE ;Mark were here
		 MOVEI	T2,SYSTAB ;Output system name
		 CALL	DOWRT	;Write it
		 JRST	SYST3]
SYST0:	AOS	T1,ONCE
	CAILE	T1,MAXJOB
	 PJRST	SNDNUL
;;;; MUCH STUFF HERE
SYST3:	RETSKP
> ;IFN 0 (SYSTAT)

;Forward the message to local target
FORWRD:	SKIPE	T1,USRPD(I)	;HAVE A PID FOR OUR USER?
	 CALL	CHKPID		; IS PID VALID?
	  RET			;  NOPE
	CALL	SIPCF		;  FORWARD IT TO THE LOCAL PHONE
	 TRN
	RET
	SUBTTL	CODE 8: RING USER

RING:	STKVAR	<SAVEBP,THSRNG>	;SAVED BP, CURRENT RING
	MOVEM	AX,SAVEBP	;SAVE MESSAGE DATA
RG.XXX:	ILDB	T1,AX		;GET BYTE
	JUMPN	T1,RG.XXX	;TOSS USER NAME
	ILDB	T1,AX		;GET RING FLAG
	SKIPN	RINGFL		;ALREADY GOT FIRST RING?
	 MOVEM	T1,RINGFL	;NO, STORE NEW FLAG (SHOULD BE TRUE)
	MOVEM	T1,THSRNG	;SAVE CURRENT STATE
	CALL	FNDUSR		;CHECK FOR A PID
	 JRST	RG.MES		; NONE, JUST SEND VIA TTMSG
	CAMN	T1,USRPD(I)	;SAME PID AS LAST TIME?
	 JRST	RG.FWD		; YES, JUST FORWARD

;Here with a new PID
	MOVEM	T1,USRPD(I)	;NO, SAVE NEW PID
	SKIPN	RINGFL		;WAS SOME PAST RING THE FIRST?
	 JRST	RG.FWD		; NO, THIS ONE *SHOULD* BE

;Here with a new PID, after first ring sent: forward with flag set
	MOVE	T1,SAVEBP	;GET DATA
RG.FAK:	ILDB	T0,T1		;GET BYTE
	JUMPN	T0,RG.FAK	;TILL END OF USER
	MOVEI	T0,1		;GET TRUE
	IDPB	T0,T1		;STORE RING FLAG

;Here to forward a ring
RG.FWD:	MOVE	T2,SAVEBP	;GET USER BP
	SKIPE	THSRNG		;WAS THIS RING THE FIRST?
	 CALL	LCLRNG		; YES, DO LOCAL RING FIRST
	  TRN			;  NO+IGNORE ERROR
	CALL	FORWRD		;FORWARD LOCAL PACKET
	PJRST	SNDAOK

RG.MES:	MOVE	T2,SAVEBP	;GET BP TO USER
	CALL	LCLRNG		;DO LOCAL RING
	 PJRST	SNDERR		; RETURN ERROR CODE
	PJRST	SNDAOK		;RETURN AOK
	SUBTTL	DO LOCAL RING
;Creates message text in JUNK buffer and send to all
;*MUST BE DONE BEFORE FORWARD, SINCE IPCF SENDS PAGE W/ USER NAME IN IT!!!*
; T2/	BP to user
;	CALL	LCLRNG
;	 <error code in T1>
;	<AOK>
LCLRNG:	ACVAR	<X1,X2,X3>
	HRROI	T1,JUNK		;POINT TO BUFFER
	CALL	CPYSTR
	MOVEI	T2,[ASCIZ/ is calling you at /]
	CALL	CPYSTR
	MOVEI	T2,LCLNOD	;NODE NAME
	CALL	CPYSTR
	MOVEI	T2,[ASCIZ/ on /]
	CALL	CPYSTR
	SETOB	T2,T3		;NOW, FANCY
	ODTIM			;OUTPUT
	 ERJMP	.+1		; FUEY!
	MOVEI	T2,[BYTE(7) 7,7,7,12,15,0] ;DING**3, CRLF
	CALL	CPYST0

;Now loop for all jobs, and blat the OK ones.
LR.BEG:	MOVE	X1,[1-MAXJOB,,1] ;AOBJN COUNT
	SETZB	X2,X3		;COUNT OF MATCHES, SENDS
LR.LOP:	MOVEI	T1,(X1)		;GET JOB
	MOVE	T2,[-.JISTM-1,,GJIBLK] ;BUFFER
	SETZ	T3,		;START AT JOB
	GETJI			;GET INFO
	 JRST	LR.BOT		; U LOSE

	MOVE	T2,USRNM(I)	;GET USER NUMBER
	CAME	T2,GJIBLK+.JIUNO ;MATCH
	 JRST	LR.BOT		; NO, KEEP LOOKIN

	SKIPG	T1,GJIBLK+.JITNO ;GET TERMINAL NUMBER
	 JRST	LR.BOT		; DETACHED
	ADDI	X2,1		;INCR MATCHES

;;;	MOVEI	T1,.TTDES(T1)	;GET DESC
;;;	CALL	CHKTTY		;CHECK TYPE & LINKS
;;;	 JRST	LR.BOT		; NO GOOD

	MOVE	T1,GJIBLK+.JITNO ;GET TTY NUMBER
	MOVEI	T1,.TTDES(T1)	;MAKE DEVICE
	HRROI	T2,JUNK		;GET TEXT
	TTMSG			;SHOVE BELOW SPY LEVEL
	 ERJMP [SETZ	T3,	; TERMINATE ON ZERO.
		SOUT		; TRY WITH SOUT
		 ERJMP	.+1	; IGNORE ERROR
		JRST	.+1 ]	;KEEP GOING
	ADDI	X3,1		;INCR SENDS

LR.BOT:	AOBJN	X1,LR.LOP	;...LOOP FOR ALL JOBS
	JUMPN	X3,CPOPJ1	;AOK IF ANY SENDS DONE
	MOVEI	T1,ST$TTY	;ASSUME BAD TTY
	CAIG	X2,0		;ANY MATCHES?
	 MOVEI	T1,ST$LOG	; NO, "USER LOGGED OFF"
	RET
	ENDAV.
;Code 7, First packet; check this guy out

CHECK:	CALL	PNTDAT		;POINT TO DATA
	CALL	GETUSR		;GET USER NUMBER OF TARGET INTO USRNM(I)
	 PJRST	SNDERR		; RETURNS ERROR IN T1
	CALL	LKUS		;CHECK IF LOGGED IN, WITH NICE TTY
	 PJRST	SNDERR		; SORRY, RETURN ERROR
	CALL	FNDUSR		;CHECK FOR USER WITH PID
	 TRNA			; ERROR?, WHAT ERROR?
	  MOVEM	T1,USRPD(I)	;GOTCHA!
	PJRST	SNDAOK		;RETURN OK
;Code 15, Directory; list available users

DIRECT:	AOS	T1,ONCE		;GET NEXT JOB
	CAILE	T1,MAXJOB	;DONE?
	 PJRST	SNDNUL		; YES, SEND NULL RECORD
	MOVE	AX,[POINT 8,DATADR] ;INITIAL BYTE POINTER
	MOVE	T2,[-.JIBAT-1,,GJIBLK] ;WHAT TO STORE WHERE
	SETZ	T3,		;START AT BEGINING
	GETJI			;GET JOB INFO
	 JRST	DIRECT		;NO JOB, GET NEXT

	SKIPE	T1,GJIBLK+.JIUNO ;LOGGED IN?
	 CAMN	T1,OPRUNO	; SKIP <OPERATOR>
	  JRST	DIRECT		;  GET ANOTHER

	SKIPN	GJIBLK+.JIBAT	;BATCH?
	 SKIPGE	GJIBLK+.JITNO	; GET TERMINAL NUMBER
	  JRST	DIRECT		;  RE-JECT

	MOVEI	T2,GJIBLK+.JIPNM ;PROGRAM NAME?
	CALL	SIXOUT		;TYPE "PROCESS NAME"
	MOVEI	T1,"I"-100	;TAB
	IDPB	T1,AX
	IDPB	T1,AX
	MOVE	T1,AX		;GET DEST BP
	MOVE	T2,GJIBLK+.JIUNO ;GET USER NUMBER AGAIN
	DIRST			;CONVERT TO STRING
	 ERCAL	DIRECT
	MOVEI	T2," "		;TERMINATE WITH A SPACE
	IDPB	T2,T1		;STORE
	MOVEI	T2,^D8*2	;DESIRED WIDTH
	CALL	DOPAD		;PAD WITH TABS

	MOVE	T2,GJIBLK+.JITNO ;GET TERMINAL NUMBER
	MOVEI	T1,.TTDES(T2)	;GET DEVICE DESC
	CALL	CHKTYP		;GOOD TTY TYPE?
	 JRST	[MOVEI	T2,[ASCIZ/unusable	---/]
		 JRST	DIRR2]

;;;	MOVE	T1,GJIBLK+.JITNO ;GET TERMINAL NUMBER
	MOVEI	T2,[ASCIZ /TTY/] ;ASS-U-ME IT IS A TTY
;;;	CAML	T1,PTYPAR	;IS IT A PTY?
;;;	 MOVEI	T2,[ASCIZ /PTY/] ; YES...
	CALL	DOWRT		;WRITE PREFIX
	MOVE	T1,AX		;BORROW BP
	MOVE	T2,GJIBLK+.JITNO ;GET TTY NUMBER
;;;	CAML	T2,PTYPAR	;A PTY?
;;;	 SUB	T2,PTYPAR	; YES, REMOVE OFFSET
	MOVEI	T3,10		;OCTAL
	NOUT
	 ERJMP	.+1
	MOVE	AX,T1		;RESTORE BP
	
	MOVE	T1,GJIBLK+.JITNO ;GET TERMINAL NUMBER
	MOVEI	T1,.TTDES(T1)	;GET TERMINAL DEVICE DESC
	CALL	CHKLNK		;ALLOW LINKS ?
	 SKIPA	T2,[[ASCIZ "		refuse links/user messages"]]
	  MOVEI	T2,[ASCIZ  "		available"]
DIRR2:	CALL	DOWRT		;WRITE PHONE STATUS
DIRR3:	SETZ	T2,
	IDPB	T2,AX		;ENSURE A NULL
	CALL	DECOUT		;WRITE TEXT
	RET
;Write text to DECnet
DECOUT:	SETZ	T3,		;CLEAR COUNT
	MOVE	T2,[POINT 8,DATADR] ;POINT TO BUFFER
DECOU2:	ILDB	T0,T2		;GET NEXT CHAR
	CAIE	T0,0		;NULL?
	 SOJA	T3,DECOU2	;NO, COUNT IT

;Write counted data to DECnet
DECCNT:	MOVE	T1,USRJF(I)	;NET JFN
	MOVE	T2,[POINT 8,DATADR] ;BP TO BUFFER
	SOUTR			;OUTPUT RECORD
	 ERJMP	SRVERR
	RET

;SEND EMPTY RECORD TO TERMINATE DIRECTORY
SNDNUL:	SETZM	DATADR		;ZERO BUFFER
	MOVEI	T3,0		;LENGTH
	PJRST	DECCNT		;SEND

SNDOTH:	SKIPA	T1,[ST$OTH]	;"SOME OTHER ERROR"
SNDAOK:	 MOVEI	T1,ST$AOK	; ALL OK
SNDERR:	SETZM	DATADR		;CLEAR BUFFER
	DPB	T1,[POINT 8,DATADR,7] ;STORE CODE
	MOVNI	T3,1		;XMIT ONE BYTE
	PJRST	DECCNT		;SEND, AND RETURN
	SUBTTL	Initialization

PSIINI:	MOVEI	T1,.FHSLF	;CURRENT PROCESS
	MOVE	T2,[LEVTAB,,CHNTAB] ;PSI tables
	SIR			;SET UP TABLES
	MOVX	T2,CHNMSK	;GET CHAN MASK
	AIC			;ENABLE CHANNELS
	EIR			;ENABLE PSI
	RET

INIT:	MOVEI	T1,.FHSLF	;THIS FORK
	SETO	T3,		;ENABLE ALL CAPABILITIES
	EPCAP

	MOVEI	T1,.NDGLN	;GET OUR NODE NAME
	MOVEI	T2,T3		;ARGBLOCK
	HRROI	T3,LCLNOD	;STORE HERE
	NODE			;GET NODE NAME

	MOVX	T1,RC%EMO	;GET EXACT MATCH
	HRROI	T2,[ASCIZ/OPERATOR/]
	SETZ	T3,
	RCUSR			;GET OPERATOR USER NUMBER
	MOVEM	T3,OPRUNO	;SAVE

	MOVE	T1,[SIXBIT/SYSVER/] ;GET SYSTEM STRING FOR SYSTAT REQUESTS
	SYSGT
	HLLZ	T3,T2		;KEEP COUNTER
SYVLOP:	HRL	T1,T3		;INDEX INTO TABLE
	HRR	T1,T2		;GET TABLE NUMBER
	GETAB
	 FATAL	(GETAB failed)
	MOVEM	T1,SYSVER(T3)	;STORE VALUE
	AOBJN	T3,SYVLOP	;LOOP

;;;	MOVE	T1,[SIXBIT /PTYPAR/] ;GET PTY INFO
;;;	SYSGT
;;;	HRRZM	T1,PTYPAR	;STORE FIRST PTY
	RET
;Look for a valid user
LKUS:	MOVEI	T5,1		;START WITH JOB 1
	SETO	T4,		;NO ERROR CODE
LK.TOP:	MOVEI	T1,(T5)		;GET JOB NUMBER
	MOVE	T2,[-3,,GJIBLK] ;WHERE TO STORE INFO
	SETZ	T3,		;START AT ZERO
	GETJI
	 ERJMP	LK.BOT
	MOVE	T1,GJIBLK+.JIUNO ;GET USER NUMBER
	CAME	T1,USRNM(I)	;MATCH REQUESTED ONE
	 JRST	LK.BOT		;NO, KEEP LOOKING
	SKIPG	T1,GJIBLK+.JITNO ;DETACHED?
	 JRST	[MOVEI	T4,ST$TTY ; "NOT AT A PHONE"
		 JRST	LK.BOT]	;KEEP LOOKING
	ADDI	T1,.TTDES	;MAKE INTO DEVICE DESCRIPTOR
	MOVEM	T1,JUNK		;SAVE TERMINAL NUMBER
	CALL	CHKLNK		;CHECK LINKS
	 JRST	[MOVEI	T4,ST$OFF ; "OFF THE HOOK"
		 JRST	LK.BOT]
	MOVE	T1,JUNK		;GET TTY DES
	CALL	CHKTYP		;CHECK TTY TYPE
	  JRST	[MOVEI	T4,ST$TTY ; "NOT AT A PHONE"
		 JRST	LK.BOT]
;;;	MOVE	T2,GJIBLK+.JIJNO ;SAVE JOB NUMBER
;;;	MOVEM	T2,USRJB(I)
	RETSKP
LK.BOT:	CAIG	T5,MAXJOB	;LAST JOB?
	 AOJA	T5,LK.TOP	;KEEP LOOPING
	MOVEI	T1,ST$TTY	;ASSUME "NOT AT A PHONE"
	CAIL	T4,0		;ANY ERRORS?
	 MOVE	T1,T4		; YES, RETURN CODE IN T1
	RET
;Point to data area
PNTDAT:	MOVE	T1,[POINT 8,DATADR,7] ;POINT PAST CODE
PD.1:	ILDB	T0,T1		;GET NEXT BYTE
	JUMPN	T0,PD.1		;LOOP TILL NULL (END OF SENDER)
	MOVEM	T1,SAVPNT	;SAVE BYTE POINTER
	RET

;Get user number from data packet
;Assumes data of form {[_]NODE::}[_]OURNODE::LUSER
; SAVPNT/ BP to user id
;	CALL	GETUSR
;	 <failed to parse>
;	<ok>
; T2/	BP to USER
; T3/	BP to last NODE::
; T4/	flag,,count
GETUSR:	MOVE	T1,SAVPNT	;GET BYTE POINTER TO DATA
	MOVE	T3,T1		;SETUP BP TO BEFORE LAST NODE::
	MOVE	T2,T1		;SETUP BP TO AFTER END OF LAST NODE::
	SETZ	T4,		;ZERO COUNT
;Here to start field
GU.1:	ILDB	T0,T1		;GET NEXT CHAR
	CAIE	T0,"_"		;VAX QUOTE CHAR?
	 JRST	GU.2		; NO, CHECK IT OUT
	MOVSI	T4,1		;ZERO COUNT, SET NODE FLAG
;Here to parse text
GU.L:	ILDB	T0,T1		;GET ANOTHER
GU.2:	JUMPE	T0,GU.3		;END OF STRING
	CAIE	T0,":"		;A COLEN?
	 AOJA	T4,GU.L		; NO, KEEP LOOKING
	ILDB	T0,T1		;GET NEXT BYTE
	CAIN	T0,":"		;BETTER BE A ":"
	 TRNN	T4,-1		; YES, ANY COUNT?
	  JRST	GU.IUS		;  NO; NULL FIELD, OR ONLY ONE ":"
	MOVE	T3,T2		;SAVE START OF LAST NODE
	MOVE	T2,T1		;MIGHT BE LAST NODE IN LIST, SAVE BP TO USER
	SETZ	T4,		;ZERO COUNT
	JRST	GU.1		;START AGAIN
;Here at end of string
GU.3:	TLNN	T4,1		;LAST FIELD HAVE AN "_" ?
	 CAMN	T2,T3		; NO, PARSE ANYTHING?
	  JRST	GU.IUS		;  NOTHING PASED OR USER BEGAN WITH "_"
	TRNN	T4,-1		;EMPTY FIELD?
	 JRST [	MOVEI	T1,ST$UID ; "USER MISSING"
		RET ]		; BOMB
	MOVX	T1,RC%EMO	;EXACT MATCHES ONLY
	RCUSR			;GREAT NAME..
	TLNE	T1,(RC%NOM!RC%AMB) ;NO MATCH OR AMBIGUOUS ??
	 JRST [ MOVEI	T1,ST$UNE ; "Target user does not exist"
		RET ]		;  RETURN SAD.
	MOVEM	T3,USRNM(I)	;SAVE USER NUMBER
	RETSKP			;RETURN HAPPY

GU.IUS:	MOVEI	T1,ST$IUS	;"ILLEGAL USER SYNTAX"
	RET
; AX/	dest byte pointer
; T2/	Addr of string
;	CALL	DOWRT
;	<always>
; AX/	updated

DOWRT:	HRLI	T2,(POINT 7,)	;Usual byte size
DOWRT2:	ILDB	T0,T2		;Get character
	JUMPE	T0,CPOPJ	;Done if null
	IDPB	T0,AX		;Store in 8 bits
	JRST	DOWRT2		;And continue

;Pad with a tab after text output JSYS (DIRST/DEVST)
DOPAD:	PUSH	P,T2		;SAVE DESIRED WIDTH
	PUSH	P,T1		;SAVE BP
	CALL	CLB		;CALCULATE ACTUAL
	POP	P,AX		;RESTORE BP
	POP	P,T3		;GET DESIRED LENGTH
DOPAD1:	CAIL	T2,(T3)		;PAST IT?
	 RET			; YES, QUIT
	MOVEI	T0,"I"-100	;NO, ADD A TAB
	IDPB	T0,AX		;DEPOSIT
	ADDI	T2,^D8		;EQUIVILENT
	ANDI	T2,^-<^D8-1>	;ROUNDING
	JRST	DOPAD1		;TRY AGAIN

;Calculate difference for two 8-bit byte pointers
; AX/	old pointer
; T1/	new pointer
;	CALL	CLB
; T2/	number of bytes difference
CLB:	MOVEI	T2,(T1)		;GET WORD INFO FROM NEW POINTER
	SUBI	T2,(AX)		;CALCULATE DIFFERENCE FROM OLD POINTER
	LSH	T2,2		;FOUR CHARACTERS PER WORD
CLB1:	LDB	T0,[POINT 6,AX,5] ;GET CHARACTER COUNT FROM OLD
	LDB	T3,[POINT 6,T1,5] ;AND FROM NEW
	SUBI	T0,(T3)		;SUBTRACT OLD FROM NEW
	ASH	T0,-3		;CHANGE BITS TO BYTES
	ADD	T2,T0		;ADD TO NUMBER FROM WORDS
	RET			;ALL DONE
	SUBTTL	IPCF -- RIPCFS - Recieve short message
; For HERE message, or <SYSTEM>INFO
RIPCFS:	MOVX	T1,IP%TTL	;TRUNCATE
	MOVEM	T1,IPRCVS+.IPCFL ;STORE FLAGS
	MOVE	T1,MYPID	;PHNSRV PID
	MOVEM	T1,IPRCVS+.IPCFR ;RECIEVE SIDE
	SETZM	IPRCVS+.IPCFS	;UNKNOWN SENDER
	MOVE	T2,[20,,IPCBLK]	;POINTER TO MESSAGE AREA
	MOVEM	T2,IPRCVS+.IPCFP ;STORE
	MOVEI	T1,11		;LENGTH DESCRIPTOR BLOCK
	MOVEI	T2,IPRCVS	;LOCATION OF DESCRIPTOR BLOCK
	MRECV			;FINALLY!
	 ERJMP	CPOPJ		;WE HAD AN ERROR FOLKS
	RETSKP

	SUBTTL	IPCF -- SIPCFS - Send short message
SIPCFS:	MOVEM	T1,IPSNDS+.IPCFR ;STORE TARGET
	SETZM	IPSNDS+.IPCFL	;CLEAR FLAGS
	MOVE	T1,MYPID	;FROM PHNSRV
	MOVEM	T1,IPSNDS+.IPCFS ;STORE PID
	MOVE	T1,[20,,IPCBLK] ;POINT TO PACKET BLOCK
	MOVEM	T1,IPSNDS+.IPCFP ;STORE
	MOVEI	T1,4		;LENGTH OF PACKET DESC BLOCK
	MOVEI	T2,IPSNDS	;ADDRESS
	MSEND			;MAKE REQUEST
	 ERJMP	CPOPJ
	RETSKP
;Find PID assoc with a name
; T1/	BP to name
;	CALL	FNDPID
;	 <lose>
;	<win>
; T1/	PID
FNDPID:	HRROI	T2,IPCBLK+.IPCI2 ;DEST
	CALL	CPYTXT		;STORE NAME
	MOVEI	T1,.IPCIW	;LOOKUP
	MOVEM	T1,IPCBLK+.IPCI0 ;STORE FUCNTION
	SETZM	IPCBLK+.IPCI1	;FOR MY EYES ONLY
	CALL	IPCSYS		;SEND TO SYSINF
	 RET			; PASS ERROR
	MOVE	T1,IPCBLK+.IPCI1 ;PID
	RETSKP

;Assign name to MYPID
; T1/	BP to name
NAMPID:	HRROI	T2,IPCBLK+.IPCI2
	CALL	CPYTXT		;STORE NAME
	MOVEI	T1,.IPCII	;CREATE NAME
	MOVEM	T1,IPCBLK+.IPCI0 ;STORE FUCNTION
	SETZM	IPCBLK+.IPCI1	;FOR MY EYES ONLY

;Deal with SYSINF
IPCSYS:	SETZ	T1,		;SYSINF
	CALL	SIPCFS		;SEND MESS OFF
	 JRST	ISY.2		; SIGH
ISY.1:	CALL	RIPCFS		;RECEIVE A SHORT PACKET
	 JRST	ISY.2		; ITS NOT MY FAULT!!
	LDB	T1,[POINTR IPRCVS,IP%CFC] ;GET PRIV-SENDER FIELD
	CAIE	T1,.IPCCF	;FROM SYSTEM-WIDE <SYSTEM>INFO?
	 CAIN	T1,.IPCCP	; OR FROM MY <SYSTEM>INFO?
	  TRNA			;  YES!!
	   JRST	ISY.1		;   NO, WAIT FOR IT THEN
	LDB	T2,[POINTR IPRCVS,IP%CFE] ;GET SYSINF RETURN CODE
	JUMPN	T2,CPOPJ	;ERROR
	RETSKP
ISY.2:	SETZ	T2,		;RETURN NO ERROR
	RET
	SUBTTL	IPCF -- IPCINI - Initialization
IPCINI:	MOVEI	T1,.FHSLF	;FOR THIS PROCESS
	CALL	CREPID		;CREATE A PID
	 FATAL	(Could not create PHNSRV PID) ; REPORT ERROR
	MOVEM	T1,MYPID	;SAVE THE PID

IFN 0,<
	HRROI	T1,[ASCIZ "PHNSRV"] ;CALL ME PHNSRV...
	CALL	NAMPID		;... PHNSRV IS MY NAME
	 PJRST	IPCERR

	MOVEI	T1,3		;LENGTH
	MOVEI	T2,T3		;ADDRESS
	MOVEI	T3,.MUPIC	;IPCF/PI FUNCTION
	MOVE	T4,MYPID	;PID
	MOVEI	T5,IPCCHN	;CHANNEL
	MUTIL
	 EFATAL	(.MUPIC failed)
> ;IFN0
	RET

IPCERR:	TMSG	<
==============================
PHNSRV: Error >
	MOVEI	T1,.PRIOU	;TTY
	MOVEI	T3,10		;OKTAL
	NOUT			;TYPE
	 TRN
	TMSG	< from <SYSTEM>INFO >
	HRROI	T1,[ASCIZ /(Duplicate name has been specified)/]
	CAIN	T2,.IPCDN	;MOST LIKELY ERROR
	 PSOUT
	CALL	ENDERR
	SUBTTL	IPCF -- SIPCF - Send an IPCF page to a local master
; Always sends a page (should be fastest)
SIPCF:	MOVEI	T1,IP%CFV	;SEND A PAGE
	MOVEM	T1,IPSNDS+.IPCFL ;STORE FLAGS
	MOVE	T1,[1000,,DATAPG] ;SEND THE BUFFER WE JUST GOT
	MOVEM	T1,IPSNDS+.IPCFP ;STORE POINTER
	MOVE	T1,USRPD(I)	;GET USER'S PID
	MOVEM	T1,IPSNDS+.IPCFR ;STORE RECIEVER
	MOVEI	T1,4
	MOVEI	T2,IPSNDS
	MSEND
	 ERJMP	CPOPJ
	RETSKP


	SUBTTL	IPCF -- QRYPID - Query IPCF queue for a PID
; T1/	PID
;	CALL	QRYPID
;	 <empty>
;	<some>
QRYPID:	MOVEM	T1,QRYBLK+1	;STORE PID IN BLOCK
	MOVEI	T1,.MUQRY	;FUNCTION
	MOVEM	T1,QRYBLK	;STORE
	DMOVE	T1,[EXP 10,QRYBLK] ;LENGTH, ADDR
	MUTIL			;ANY MORE PACKETS?
	 ERJMP	CPOPJ		; ASSUME ERROR MEANS NO.
	RETSKP			;YES


	SUBTTL	IPCF -- CHKPID - Find owning job for a PID
;Check a PID
; T1/	PID
;	CALL	CHKPID
;	 <invalid>
;	<valid>
; T1/	owning job
CHKPID:	MOVEM	T1,FOJBLK+1	;STORE PID
	MOVEI	T1,.MUFOJ	;FUNCTION
	MOVEM	T1,FOJBLK	;STORE
	DMOVE	T1,[EXP 3,FOJBLK] ;LEN & ADDR
	MUTIL			;FIND THE PID'S JOB
	 ERJMP	CPOPJ		;RETURN ERROR
	MOVE	T1,FOJBLK+2	;GET JOB NUMBER
	RETSKP			;RETURN HAPPY

	SUBTTL	IPCF -- CREPID - Create a PID
; T1/	Flags
;	CALL	CREPID
;	 <lose>
;	<win>
; T1/	PID
CREPID:	DMOVE	T1,[EXP 3,T3]	;LEN & ADDR
	DMOVE	T3,[EXP .MUCRE,.FHSLF] ;CREATE FOR THIS PROCESS
	MUTIL			;DOIT
	 ERJMP	CPOPJ		;RETURN ERROR
	MOVE	T1,T5		;GET PID
	RETSKP			;RETURN HAPPY


	SUBTTL	IPCF -- DESPID - Destroy a PID
; T1/	PID
;	CALL	DESPID
;	 <lose>
;	<win>
DESPID:	MOVE	T4,T1		;PUT PID IN PLACE
	DMOVE	T1,[EXP 2,T3]	;LEN & ADDR
	MOVEI	T3,.MUDES	;FUNCTION
	MUTIL			;DOIT
	 ERJMP	CPOPJ		;RETURN ERROR
	RETSKP			;RETURN HAPPY
;Output full SIXBIT word
; T2/	Addr of SIXBIT word
; AX/	Dest BP
;	CALL	SIXOUT
;	<always>
; AX/	Updated BP
SIXOUT:	MOVEI	T1,6		;BYTE COUNT
	HRLI	T2,(POINT 6,)	;MAKE BP
SIXOU2:	ILDB	T0,T2		;GET NEXT BYTE
	ADDI	T0,40		;MAKE INTO ASCII
	IDPB	T0,AX		;STORE
	SOJG	T1,SIXOU2	;LOOP
	RET


;Check for OK terminal type
; T1/	Terminal specifier
;	CALL	CHKTYP
;	 <Not supported by PHONE>
;	<ok>
CHKTYP:	GTTYP			;GET TTY TYPE
	 ERJMP	CPOPJ		;YOU LOSE
	CAIE	T2,.TTV52	;VT52?
	 CAIN	T2,.TT100	;VT100?
	  RETSKP		;OK
	CAIE	T2,.TT125	;VT125?
	 CAIN	T2,.TTK100	;GIGI?
	  RETSKP		;OK
	CAIE	T2,.TT131	;VT131?
	 CAIN	T2,.TT102	;VT102?
	  RETSKP		;OK
	CAIE	T2,.TT200	;VT2XX?
	 CAIN	T2,.TTH19	;HEATHKIT-19?
	  RETSKP		;OK
	RET			;UNSUPPORTED

;Check terminal characteristics
; T1/	tty spec
;	CALL	CHKTTY
CHKTTY:	ACVAR	<X1>
	MOVE	X1,T1		;SAVE DESC
	CALL	CHKTYP		;OK TYPE?
	 RET			;NO
	MOVE	T1,X1		;GET TTY AGAIN

;Check terminal LINKs status
; T1/	Terminal specifier
;	CALL	CHKLNK
;	 <refuse links>
;	<accept links>
CHKLNK:	MOVEI	T2,.MORTF	;NEW FANGLED TERMINAL BITS
	MTOPR			;READ THEM
	 ERJMP	CHKLN2		; OLD MONITOR?
	TRNE	T3,MO%NUM!MO%NTM ;GOT YER EARS ON?
	 RET			; NO, YOU LOSE
	JRST	CPOPJ1		;YES, YOU WIN

CHKLN2:	RFMOD			;GET TERMINAL JFN MODE WORD
	 ERJMP	CPOPJ		;WHOOPS!
	TRNE	T2,TT%ALK	;ALLOW LINKS ?
CPOPJ1:	 AOS	(P)		;YES.
CPOPJ:	RET			;NO.
	ENDAV.			;(FROM CHKTTY)
;Create new inferior fork & all its mappings
; I/	"fork number"
;	CALL	NEWFRK
NEWFRK:	MOVE	T1,NETJFN	;GET JFN TO BE USED
	MOVEM	T1,USRJF(I)	;SAVE
	MOVSI	T1,(CR%CAP!CR%ACS) ;GIVE CAPABILITIES & ACS
	MOVEI	T2,0		;START WITH OUR AC0
	CFORK			;CREATE FORK
	 EFATAL	(CFORK FAILED)	;DIE
	MOVEM	T1,USRFK(I)	;STORE FORK INDEX
	MOVSI	T2,(T1)		;GET INFERIOR,,0
	MOVSI	T1,.FHSLF	;GET SUPERIOR,,0
	SKIPN	T3,.JBREL	;GET LINK END OF LOW SEG
	 FATAL	(.JBREL is empty)
	ADDI	T3,777		;ROUND UP
	LSH	T3,-^D9		;MAKE PAGE COUNT
	HRLI	T3,(PM%CNT!PM%RD!PM%CPY) ;GET FUNNY BITS
	PMAP			;SET UP MAPPING FOR IMPURE DATA
	 EFATAL	(PMAP1 failed)	;DIE
	HRRI	T1,PURPAG	;GET SUPERIOR,,PAGE
	HRRI	T2,PURPAG	;GET INFERIOR,,PAGE
	MOVE	T3,[PM%CNT!PM%RWX!<1000-PURPAG>] ;COPY FROM PURPAG UP
	PMAP			;MAP WITH WRITE ACCESS
	 EFATAL	(PMAP2 failed)
	MOVE	T1,USRFK(I)	;GET INFERIOR FORK
	MOVEI	T2,SERVER	;START AT SERVER START ADDR
	SFORK			;START THE FORK
	 EFATAL	(SFORK failed)	;SIGH
	AOS	NUMACT		;NUMBER OF ACTIVE FORKS
	RETSKP

;Here on inferior termination interupt
INFINT:	MOVEM	16,ACSAVE+16	;SAVE AC16
	MOVEI	16,ACSAVE	;FROM ACS TO ACSAVE
	BLT	16,ACSAVE+15	;COPY AC0..15
	MOVSI	I,-MAXSRV	;ALL SERVERS
IIN.L:	SKIPN	T1,USRFK(I)	;GET HANDLE
	 JRST	IIN.B		; NO FORK!
	CALL	CHKFRK		;CHECK THIS FORK
	 TRNA			;ITS DEAD JIM!
	  JRST	IIN.B		;OK

	SKIPN	TRCFLG		;FORK TRACE?
	 IFSKP.
	  PUSH	P,T1		;SAVE T1
	  TMSG	<FORK >
	  POP	P,T3		;RESTORE STATE
	  HRROI	T1,[ASCIZ "HALTED"]
	  CAIE	T3,.RFHLT	;REALLY?
	   HRROI T1,[ASCIZ "^C"]
	  PSOUT
	  TMSG	< AT >
	  MOVEI	T0,(T2)		;GET PC
	  CALL	SYMOUT		;TYPE SYMBOL
	  CALL	CRLF
	 ENDIF.

	MOVE	T1,USRFK(I)	;GET HANDLE
	KFORK			;REMOVE DEAD BODY
	 ERJMP	.+1		;YAWN
	SOS	NUMACT		;DECR NUMBER OF ACTIVE FORKS
	SKIPN	T1,USRJF(I)	;HAD A JFN?
	 JRST	IIN.B		; NO
	TLO	T1,(CZ%ABT)	;YES, ABORT I/O
	CLOSF			;AND CLOSE
	 ERJMP	.+1		; IGNORE ERROR
	SETZM	USRJF(I)	;CLEAR JFN
	SETZM	USRFK(I)	;CLEAR AWAY HANDLE
	SETZM	USRPD(I)	;CLEAR PID
	SETZM	USRJB(I)	;CLEAR JOB NUMBER
	SETZM	USRNM(I)	;CLEAR USER NUMBER
IIN.B:	AOBJN	I,IIN.L		;..LOOP
	SKIPN	NETJFN		;HAVE AN OPEN LISTENER?
	 CALL	NEWJFN		; NO, GET ONE
	MOVSI	16,ACSAVE	;ACSAVE TO ACS
	BLT	16,16		;AC0..16
	DEBRK
	 EFATAL	(INFINT DEBRK failed)

;Check fork status
; T1/	Handle
;	CALL	CHKFRK
;	 <dead>
;	<alive>
CHKFRK:	RFSTS			;GET FORK STATUS
	 ERJMP	CPOPJ		;MUST BE DEAD..
	HLRZ	T1,T1		;GET STATUS CODE
	CAIN	T1,-1		;GOOD HANDLE?
	 RET			;NOPE.
	ANDI	T1,(RF%STS)	;GET JUST STATE
	CAIE	T1,.RFHLT	;HALTED?
	 CAIN	T1,.RFFPT	; FORCED TERMINATION?
	  RET			;  YEP
	RETSKP			;OTHERWISE LOOKS GOOD.
;Find user w/ PID
; I/	User index
;	CALL	FNDUSR
;	 <not found>
;	<found>
; T1/	PID if found

FNDUSR:	MOVE	T1,[POINT 7,PIDNAM]
	MOVEI	T2,"<"		;>START PID NAME
	IDPB	T2,T1		;STORE
	SKIPE	T2,USRNM(I)	;GET USER NUMBER
	 DIRST			;CONVERT DIR # TO STRING
	  RET			; YOU LOSE<
	HRROI	T2,[ASCIZ ">PHONE"]
	CALL	CPYST0		;COPY W/ NULL

	HRROI	T1,PIDNAM	;GET NAME
	CALL	FNDPID		;WHO OWNS IT?
	 RET			; NOONE
	RETSKP

IFN 0,<
;Hang until prev instruction skips
;	<TEST-INSTR>
;	 CALL	HANG
HANG:	PUSH	P,T1		;SAVE AN AC
	MOVEI	T1,^D250	;1/4 SEC
	DISMS			;SLEEP.
	POP	P,T1		;RESTORE
	SOS	(P)		;DO TEST AGAIN
	RET

;Get lock on JOBxxx vars
;	CALL	JOBXP
JOBXP:	AOSE	JOBLCK		;INTERLOCK
	 CALL	HANG		;WAIT FOR SUCCESS
	MOVEM	I,JOBOWN	;MAKE US THE OWNER
	RET

;Release JOBxxx lock
;	CALL	JOBXV
JOBXV:	CAME	I,JOBOWN	;DO WE OWN?
	 RET			;NOPE.
	SETOM	JOBOWN		;NO OWNER
	SETOM	JOBLCK		;FREE LOCK
	RET
> ;IFN 0
	SUBTTL	ERROR STUFF

POVINT:	MOVEI	T1,[ASCIZ /PDL overflow/]
	TRNA
EOFINT:  MOVEI	T1,[ASCIZ /File EOF/]
	TRNA
DAEINT:	 MOVEI	T1,[ASCIZ /Data error/]
	TRNA
ILIINT:	 MOVEI	T1,[ASCIZ /Illegal instruction/]
	MOVE	P,[IOWD LPLIST,PLIST] ;SET UP PDL
	MOVEM	T1,.JBUUO	;STORE STRING ADDR FOR FAKE LUUO
	PUSH	P,P1FLG		;PUSH "CALL" PC
	MOVEI	T1,LUUOH	;WHERE TO START
	MOVEM	T1,P1FLG	;STORE AS RETURN ADDR
	DEBRK

LUUOH:	MOVEI	T1,.PRIOU
	DOBE
	TMSG	<
==============================
PHNSRV: >
	HRRO	T1,.JBUUO	;GET LUUO INSTR
	TRNN	T1,-1		;HAVE TEXT?
	 HRROI	T1,[ASCIZ /FATAL error/]
	PSOUT

ENDERR:	MOVEI	T1,.PRIOU
	FMSG	<
 last error: >
	MOVEI	T1,.PRIOU
	HRLOI	T2,.FHSLF
	SETZ	T3,
	ERSTR
	 TRNA
	  TRN
	FMSG	<
 called from: >
	HRRZ	T0,(P)		;GET CALL PC
	SUBI	T0,1
	CALL	SYMOUT
	FMSG	<
 at >
	SETO	2,
	ODTIM
	FMSG	<
==============================
>
	HALTF
	JRST	START
SYM==0
;Symbol output routine
; SYM/	desired symbol
;	CALL	SYMOUT
;(For details, read "Introduction to DECSYSTEM-20 Assembly Language
; Programming", by Ralph Gorin, published by Digital Press, 1981.)

SYMOUT:	SETZB	T3,T5		;NO CURRENT PROGRAM NAME OR BEST SYMBOL
	MOVE	T4,.JBSYM	;SYMBOL TABLE POINTER
	HLRO	T1,T4
	SUB	T4,T1		;-COUNT,,ENDING ADDRESS +1
SYMLUP:	LDB	T1,[400400,,-2(T4)] ;SYMBOL TYPE
	JUMPE	T1,NXTSYM	;PROGRAM NAMES ARE UNINTERESTING
	CAILE	T1,2		;0=PROG NAME, 1=GLOBAL, 2=LOCAL
	 JRST	NXTSYM		;NONE OF THE KIND WE WANT
	MOVE	T1,-1(T4)	;VALUE OF THE SYMBOL
	CAMN	T1,SYM		;EXACT MATCH?
	 JRST [	MOVE T5,T4	;YES, SELECT IT
		JRST FNDSYM]
	CAML	T1,SYM		;SMALLER THAN VALUE SOUGHT?
	 JRST	NXTSYM		;TOO LARGE
	SKIPE	T2,T5		;GET BEST ONE SO FAR IF THERE IS ONE
	 CAML	T1,-1(T2)	;COMPARE TO PREVIOUS BEST
	  MOVE	T5,T4		;CURRENT SYMBOL IS BEST MATCH SO FAR
NXTSYM:	ADD	T4,[2000000-2]	;ADD 2 IN THE LEFT, SUB 2 IN THE RIGHT
	JUMPL	T4,SYMLUP	;LOOP UNLESS CONTROL COUNT IS EXHAUSTED
	SKIPN	T4,T5		;DID WE FIND ANYTHING HELPFUL?
	 JRST	OCTSYM

;FOUND AN ENTRY THAT LOOKS CLOSE.  SEE IF IT REALLY IS AND IF SO USE IT
FNDSYM:	MOVE	T1,SYM		;DESIRED VALUE
	SUB	T1,-1(T4)	;LESS SYMBOL'S VALUE = OFFSET
	CAIL	T1,200		;IS OFFSET SMALL ENOUGH?
	 JRST	OCTSYM		;NO, NOT A GOOD ENOUGH MATCH
	MOVE	T4,T5		;GET THE SYMBOL'S ADDRESS
	MOVE	T1,-2(T4)	;SYMBOL NAME
	TLZ	T1,740000	;CLEAR FLAGS
	CALL	SQZTYO		;PRINT SYMBOL NAME
	MOVE	T2,SYM		;GET DESIRED VALUE
	SUB	T2,-1(T4)	;LESS THIS SYMBOL'S VALUE
	JUMPE	T2,CPOPJ	;IF NO OFFSET, DON'T PRINT "+0"
	MOVEI	T1,"+"		;ADD + TO THE OUTPUT LINE
	PBOUT
	TRNA
OCTSYM:	 MOVE	T2,SYM		;HERE IF PC MUST BE IN OCTAL
	MOVEI	T1,.PRIOU	;AND COPY NUMERIC OFFSET TO OUTPUT
	MOVEI	T3,10
	NOUT
	 HALT	.-1		;BLEAH
	RET

;Output squoze
; A/ radix50 symbol
;	CALL	SQZTYO
SQZTYO:	IDIVI	T1,50		;DIVIDE BY 50
	PUSH	P,T2		;SAVE REMAINDER
	CAIE	T1,0		;DONE?
	 CALL	SQZTYO		; NO, RECURSE
	POP	P,T1		;GET CHARACTER
	ADJBP	T1,[350700,,[ASCII/ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%/]]
	LDB	T1,T1		;CONVERT SQUOZE CODE TO ASCII
	PBOUT
	RET

;Copy string w/ null
; ** ORDER REVERSED FROM CPYST0 **
; T1/	Source
; T2/	Dest
CPYTXT:	EXCH	T1,T2
	CALL	CPYST0
	EXCH	T1,T2
	RET

;Copy string w/ null
; T1/	Dest
; T2/	Source
CPYST0:	CALL	CHKBPS		;CHECK BPS
ST0LOP:	ILDB	T0,T2		;GET A BYTE
	IDPB	T0,T1		;STORE
	JUMPN	T0,ST0LOP	;END?
	RET

;Copy a string
; T1/	Dest
; T2/	Source
CPYSTR:	CALL	CHKBPS		;CHECK BYTE POINTERS
CPYST2:	ILDB	T0,T2		;GET A CHAR
	JUMPE	T0,CPOPJ	;END.
	IDPB	T0,T1		;STORE
	JRST	CPYST2		;LOOP

;Check byte pointers
CHKBPS:	MOVEI	T4,T1
	CALL	CHKBP
	MOVEI	T4,T2
CHKBP:	HLRZ	T0,(T4)		;GET LH
	CAIE	T0,0		;ADDR
	 CAIN	T0,-1		; OR HRROI?
	  MOVEI	T0,(POINT 7,)	;  YES, MAKE INTO BP
	HRLM	T0,(T4)		;RESTORE
	RET

CRLF:	TMSG	<
>
	RET
	SUBTTL	SPECIAL	ACVAR SUPPORT

.SAV1:	PUSH P,.FPAC
	PUSHJ P,0(.A16)		;CONTINUE PROGRAM
	 SKIPA
	AOS -1(P)
	POP P,.FPAC
	POPJ P,

.SAV2:	PUSH P,.FPAC
	PUSH P,.FPAC+1
	PUSHJ P,0(.A16)
	 SKIPA
	AOS -2(P)
	POP P,.FPAC+1
	POP P,.FPAC
	POPJ P,

.SAV3:
.SAV4:	PUSH P,.FPAC
	PUSH P,.FPAC+1
	PUSH P,.FPAC+2
	PUSH P,.FPAC+3
	PUSHJ P,0(.A16)
	 SKIPA
	AOS -4(P)
	POP P,.FPAC+3
	POP P,.FPAC+2
	POP P,.FPAC+1
	POP P,.FPAC
	POPJ P,

LITTER:	END	START