Google
 

Trailing-Edge - PDP-10 Archives - LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86 - tools/phone20/phone.mac
There are 3 other files named phone.mac in the archive. Click here to see a list.
;MSC:<BUDNE.FONE>PHONE.MAC.1733 16-Aug-85 NM+1D.1H.50M.32S., by BUDNE
; Released to "integration tools clearinghouse"
;MSC:<BUDNE.FONE>PHONE.MAC.1719 26-Jun-85 FQ+1D.19H.38M.48S., by BUDNE
; Add more status info, and OUTSTR LUUO
;MSC:<BUDNE.FONE>PHONE.MAC.1706 26-Jun-85 FQ+1D.18H.37M.30S., by BUDNE
; Add code at .ERROR to check for lossage from DNCONN
;MSC:<BUDNE.FONE>PHONE.MAC.1700 26-Dec-84 NM+4D.10H.49M.6S., by BUDNE
; Remove PTYnnn stuff
;MSC:<BUDNE.FONE>PHONE.MAC.1698  1-Dec-84 FQ+1D.14H.19M.18S., by BUDNE
; Make sure zero ring flag gets sent in MAKMSG
;MSC:<BUDNE.FONE>PHONE.MAC.1680 24-Jul-84 LQ+4D.11H.17M.1S., by BUDNE
; USE DNCONN FROM TGRADY'S MS11 STUFF, IT RETURNS THE ROUTE, FLUSH PHCONN

;  *** WISH LIST ***
;TRY CONNECT W/O DNCONN FIRST; PUT LOCAL NODE FDB FIRST??? (NAH)
;SAVE/RESET PROGRAM NAME FOR PUSH/MAIL COMMANDS
;--
;HAVE STATUS SHOW TEMP LINK (IE; FROM A FOREIGN RINGER)
;MAKE EXIT DEMAND HANGUP, ADD QUIT COMMAND?
;CREATE ASSEMBLY FEATURE TESTS FOR NO NETWORK, OR JUST NO DNCONN??
;HANDLE ^L (REFRESH) @LKCTRL
;HAVE UNHOLD COMPLAIN IF NO USERS FOUND ON HOLD
;USER SELECTABLE SWITCH HOOK; QUOTE CHAR?
;READ MONNAM.TXT FOR LOCAL HOST NAME
;KEEP RING BUFFER OF LINES FOR EACH LINK/WINDOW??
;DON'T MOVE CURSOR UNTIL WE TYPE SOMETHING... (KEEP TRACK OF CURSOR!!)
;
;  *** BUGS ***
;AT XTEXT QUEUE PACKETS IF NOT CURRENTLY IN TALK CONTEXT
;DISABLE PAUSE ON END-OF-PAGE (AT LEAST WHILE TALKING (SAME TIME AS ECHO)
;LOCAL RING BLASTS EVERYONE, EVEN PERSON W/ PID!!
;3-WAY PRINTS TRASH, WRONG POS FOR CURSOR???
;SOMEONE DIALING A BUSY PERSON DOES NOT GET A BLOWOFF??? (RI.2???)
;WRAP IN ECHO IS CRUDE -- DO WORD WRAP?
;<LF> CODE IN ECHO IS CRUDE -- USE CURSOR ADDRESSING AND CEOL
;ALL OF ECHO IS CRUDE -- REWRITE
;REWRITE LOOK?
;
;WHAT HAPPENS TO TEXT WHEN YOU ARE AT "COMMAND" LEVEL? (TOSSED?)
;
	TITLE	PHONE -- Video Telephone Conversation Program
	SUBTTL	Robert A. Brown/Philip L. Budne

	SEARCH	MONSYM,MACSYM,CMD,DNCUNV,JOBDAT
	.REQUIRE SYS:CMD
	.REQUIRE DNCONN		;GET DNCONN FROM MS11
	.REQUEST SYS:MACREL
	.REQUIRE HLPR20
	.DIRECTIVE FLBLST
	SALL

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.

;
; This program, along with PHNSRV  is a TOPS-20 implementation of  the
; PHONE protocol as  documented and implemented  by the VAX/VMS  PHONE
; program.
;
; I would like to thank  Robert Brown of CSSE  for the head start  his
; version  gave  me,  and  appologize  for  the  number  of   needless
; changes I have made.
;
; -Phil Budne
; DEC/LCG - SWE
;
	SUBTTL	TABLE OF CONTENTS

;
;			   Section			      Page
;   1. TABLE OF CONTENTS. . . . . . . . . . . . . . . . . . .    2
;   2. DEFINITIONS. . . . . . . . . . . . . . . . . . . . . .    3
;   3. PROTOCOL
;        3.1.   MESSAGE CODES . . . . . . . . . . . . . . . .    4
;        3.2.   STATUS CODES. . . . . . . . . . . . . . . . .    4
;   4. IMPURE STORAGE . . . . . . . . . . . . . . . . . . . .    6
;   5. CONSTANTS. . . . . . . . . . . . . . . . . . . . . . .    7
;   6. MAIN CODE. . . . . . . . . . . . . . . . . . . . . . .    9
;   7. COMMANDS
;        7.1.   EXIT. . . . . . . . . . . . . . . . . . . . .   10
;        7.2.   HANGUP. . . . . . . . . . . . . . . . . . . .   11
;        7.3.   ANSWER. . . . . . . . . . . . . . . . . . . .   12
;        7.4.   REJECT. . . . . . . . . . . . . . . . . . . .   13
;        7.5.   DIAL. . . . . . . . . . . . . . . . . . . . .   14
;        7.6.   PUSH AND MAIL . . . . . . . . . . . . . . . .   15
;        7.7.   DIRECTORY . . . . . . . . . . . . . . . . . .   16
;        7.8.   HOLD. . . . . . . . . . . . . . . . . . . . .   17
;        7.9.   UNHOLD. . . . . . . . . . . . . . . . . . . .   18
;        7.10.  BLANK AND REDRAW TEMPLATE . . . . . . . . . .   19
;        7.11.  STATUS. . . . . . . . . . . . . . . . . . . .   21
;   8. IPCF
;        8.1.   INITIALIZATION. . . . . . . . . . . . . . . .   22
;        8.2.   RECIEVE A PAGE FROM LOCAL OR SLAVE. . . . . .   23
;        8.3.   SEND A PAGE TO A LOCAL USER . . . . . . . . .   23
;        8.4.   RECEIVE A SHORT MESSAGE, BLOCKING (FROM INFO)   23
;        8.5.   SEND A SHORT MESSAGE. . . . . . . . . . . . .   23
;        8.6.   CHECK A PID . . . . . . . . . . . . . . . . .   23
;        8.7.   CREATE A PID. . . . . . . . . . . . . . . . .   23
;        8.8.   FIND PHONE PID (IF ANY) ASSOCIATED WITH A USER NUMBER   24
;        8.9.   FIND PID ASSOCIATED WITH A NAME . . . . . . .   24
;        8.10.  ASSIGN NAME TO OURPID . . . . . . . . . . . .   24
;        8.11.  Send message to <SYSTEM>INFO. . . . . . . . .   24
;   9. Initialization stuff . . . . . . . . . . . . . . . . .   25
;  10. PSI
;       10.1.   TURN PI OFF . . . . . . . . . . . . . . . . .   26
;       10.2.   TURN PI ON. . . . . . . . . . . . . . . . . .   26
;       10.3.   KILL IPCF INTERUPTS . . . . . . . . . . . . .   26
;       10.4.   ACTIVATE IPCF INTERUPTS . . . . . . . . . . .   26
;  11. INTERUPT LEVEL
;       11.1.   IPCF DISPATCH . . . . . . . . . . . . . . . .   27
;       11.2.   RING. . . . . . . . . . . . . . . . . . . . .   28
;       11.3.   HANGUP. . . . . . . . . . . . . . . . . . . .   29
;       11.4.   BUSY SIGNAL . . . . . . . . . . . . . . . . .   30
;       11.5.   ANSWERED. . . . . . . . . . . . . . . . . . .   31
;       11.6.   FORCED LINK . . . . . . . . . . . . . . . . .   32
;       11.7.   REJECT. . . . . . . . . . . . . . . . . . . .   33
;       11.8.   PUT ON HOLD . . . . . . . . . . . . . . . . .   34
;       11.9.   TAKEN OFF HOLD. . . . . . . . . . . . . . . .   35
;       11.10.  CONVERSATION TEXT . . . . . . . . . . . . . .   36
;  12. TTY
;       12.1.   SAVE CCOC WORD. . . . . . . . . . . . . . . .   39
;       12.2.   BLAST CCOC WORD . . . . . . . . . . . . . . .   39
;       12.3.   RESTORE CCOC WORD . . . . . . . . . . . . . .   39
;       12.4.   KILL ECHO . . . . . . . . . . . . . . . . . .   39
;       12.5.   RESTORE ECHO. . . . . . . . . . . . . . . . .   39
;       12.6.   SKIP IF INPUT BUFFER EMPTY. . . . . . . . . .   39
;  13. TEXT CONVERSATION INPUT. . . . . . . . . . . . . . . .   40
;  14. LOOK
;       14.1.   Get character . . . . . . . . . . . . . . . .   40
;       14.2.   Send off OURBUF to all of our windows user's.   40
;       14.3.   User typed something. . . . . . . . . . . . .   40
;       14.4.   Deposit a character to be sent. . . . . . . .   40
;       14.5.   Rubout was typed. . . . . . . . . . . . . . .   40
;       14.6.   Ignore extra rubouts. . . . . . . . . . . . .   40
;       14.7.   Some control character typed. . . . . . . . .   40
;  15. Position self. . . . . . . . . . . . . . . . . . . . .   41
;  16. PHONE ERROR MESSAGES . . . . . . . . . . . . . . . . .   41
;  17. GOTO ERROR LINE. . . . . . . . . . . . . . . . . . . .   41
;  18. GOTO PROMPT LINE . . . . . . . . . . . . . . . . . . .   41
;  19. PARSE
;       19.1.   ROUTE STRING. . . . . . . . . . . . . . . . .   42
;       19.2.   USER ID STRING. . . . . . . . . . . . . . . .   43
;  20. LINKS
;       20.1.   MAKE A CONNECTION . . . . . . . . . . . . . .   44
;       20.2.   MAKE A MESSAGE. . . . . . . . . . . . . . . .   45
;       20.3.   SEND A MESSAGE. . . . . . . . . . . . . . . .   45
;       20.4.   SEND HANGUP AND CLOSE . . . . . . . . . . . .   46
;       20.5.   SEND ANY MESSAGE AND CLOSE. . . . . . . . . .   46
;       20.6.   CREATE NEW LINK BLOCK . . . . . . . . . . . .   47
;       20.7.   CREATE A NEW LINK AND CONNECT IT. . . . . . .   47
;       20.8.   SAVE A LINK IN LINK TABLE . . . . . . . . . .   47
;       20.9.   SEARCH FOR A USER . . . . . . . . . . . . . .   47
;  21. DECNET
;       21.1.   COUNT AND SEND MESSAGE. . . . . . . . . . . .   48
;       21.2.   SEND COUNTED MESSAGE. . . . . . . . . . . . .   48
;       21.3.   GET TEXT WITH TIMEOUT . . . . . . . . . . . .   48
;       21.4.   GET MESSAGE W/O TIMEOUT . . . . . . . . . . .   48
;       21.5.   CONNECT TO REMOTE SLAVE FOR DIRECTORY . . . .   49
;       21.6.   SEND A MESSAGE. . . . . . . . . . . . . . . .   49
;  22. LOCAL
;       22.1.   SEND A MESSAGE. . . . . . . . . . . . . . . .   50
;       22.2.   CHECK FOR USER. . . . . . . . . . . . . . . .   51
;       22.3.   RING. . . . . . . . . . . . . . . . . . . . .   52
;       22.4.   SEND RING TEXT. . . . . . . . . . . . . . . .   53
;       22.5.   DIRECTORY . . . . . . . . . . . . . . . . . .   54
;  23. WINDOWS
;       23.1.   ECHO. . . . . . . . . . . . . . . . . . . . .   55
;       23.2.   FIND A USER . . . . . . . . . . . . . . . . .   56
;       23.3.   ADD A NEW USER. . . . . . . . . . . . . . . .   56
;       23.4.   REDIVIDE. . . . . . . . . . . . . . . . . . .   56
;       23.5.   REMOVE A USER . . . . . . . . . . . . . . . .   57
;       23.6.   SEND TO ALL . . . . . . . . . . . . . . . . .   57
;  24. SPECIAL. . . . . . . . . . . . . . . . . . . . . . . .   58
;  25. CORE ALLOCATOR . . . . . . . . . . . . . . . . . . . .   60
;  26. LUUO HANDLR. . . . . . . . . . . . . . . . . . . . . .   61
;  27. THE END. . . . . . . . . . . . . . . . . . . . . . . .   64
	SUBTTL	DEFINITIONS

;AC definitions
T0==0				;DON'T BLAME ME (IT USED TO BE NAMELESS!)
T1==1
T2==2
T3==3
T4==4
T5==5

.FPAC==6			;FIRST PRESERVED AC
.NPAC==4			;THIS MANY (6..11)

FL==12				;FLAGS
    F$DIAL==1B0			;  DIALING
    F$ANSW==1B1			;  ANSWERING
    F$TEXT==1B2			;  TEXT AVAILABLE TO SEND
    F$REF==1B3			;  REFRESH NEEDED
    F$FAX==1B4			;  IN FAX MODE
    F$DECN==1B5			;  DECNET IS AVAILABLE
    F$SERV==1B6			;  WE RUN THE DECNET SERVER (we may dial out)

W==13				;WINDOW PTR
I==14				;USER (LINK) PTR
;;;15				;USED BY MACREL (TRVAR ...)
.A16==16			;USED BY MACREL (ACVAR, STKVAR)
P==17				;PDL

;Feature tests
LOCALF==1			;TRUE TO ENABLE LOCAL LINKS

;Parameters
SLPTIM==^D80			;TIME FOR INPUT CHECK SLEEP (IN MS.)
PSETIM==^D850			;TIME TO PAUSE AFTER ERROR OUTPUT (IN MS.)
TXTLIN==3			;FIRST LINE OF TEXT IN WINDOW (DASHES, NAME)
OURSIZ==^D<50/5>		;OURBUF SIZE IN WORDS (TYPEIN BUFFER)
BUFSIZ==^D256			;SIZE OF BUFFERS (MAX MESSAGE SIZE IN BYTES)
MAXJOB==^D510			;MAX JOB TO LIST IN DIR...

MAXWND==5			;MAX NUMBER OF WINDOWS
MAXLNK==MAXWND*5		;MAX NUMBER OF ACTIVE LINKS

;Address Space
ENDCOR=477777			;LAST WORD FOR ALLOC

DATPAG==500			;PAGE FOR IPCF DATA RECIEVE
DATADR=DATPAG*1000		;ADDRESS FOR IPCF

SNDPAG==501			;PAGE FOR IPCF SEND
SNDADR=SNDPAG*1000		;ADDRESS

HSTPAG==520			;PAGE FOR LOCAL HOSTS
HSTADR=HSTPAG*1000
HSTTAB=HSTADR+5000

; PAGES 600+ USED BY HLPR20
DEFINE	RETSKP	<JRST	CPOPJ1>
OPDEF	PJRST	[JUMPA	13,]
OPDEF	TTY$	[1B8]		;TTY HACKING LUUO
OPDEF	OUTSTR	[2B8]		;OUTPUT LITTERAL STRING

.JBUUO==:40			;LUUO INSTR
.JB41==:41			;LUUO W/ EA CALC
.JBFF==:121			;LAST USED WORD IN CORE

;REL 6.0 SYMBOLS
IFNDEF .TT125,.TT125==:^D35	;VT125
IFNDEF .TT102,.TT102==:^D37	;VT102
IFNDEF .TTH19,.TTH19==:^D38	;H19 (ANSI)
IFNDEF .TT131,.TT131==:^D39	;VT131
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
	SUBTTL	PROTOCOL --  MESSAGE CODES

; CODES LOWER THAN 7. ARE VAX LOCAL QUEUEING CODES, NEVER SENT OVER THE NET.

MS$CHK==:^D7			;CHECK USER
MS$RNG==:^D8			;RING PHONE
MS$HUP==:^D9			;HANGUP
MS$BSY==:^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
				;16. IS A VAX INTERNAL CODE
MS$3RD==:^D17			;HANDLE FORCED LINK TO THIRD PARTY
MS$HLD==:^D18			;PUT ON HOLD
MS$OFF==:^D19			;TAKEN OFF HOLD

	SUBTTL	PROTOCOL -- 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 (TTY CANNOT USE PHONE?)
ST$LOG==:^D8			;USER HAS LOGGED OFF
ST$OFF==:^D9			;"OFF THE HOOK" /NOBROAD, REFUSE LYNX, TTY GAG

;Control chars
BS==:"H"-100
TAB==:"I"-100
BEL==:"G"-100
CR==:"M"-100
LF==:"J"-100
FF==:"L"-100
DEL==:177
;Macros

;Opcodes for TTY$ LUUO
TT$MOV==:0			;ABS MOVE
TT$JMP==:1			;HOME
TT$JME==:2			;HOME AND ERASE
TT$ERL==:3			;ERASE TO EOL
TT$ERB==:4			;ERASE TO EOS
TT$SCR==:5			;SET SCROLL REGION
TT$NRM==:6			;NORMAL VIDEO
TT$REV==:7			;REVERSE VIDEO
TT$BRI==:10			;BRIGHT VIDEO
TT$IND==:400			;SET FOR INDIRECT ARGS
TT$MVX==:TT$IND+TT$MOV		;INDIRECT MOVE
TT$SCX==:TT$IND+TT$SCR		;INDIRECT SCROLL

DEFINE	TTY	(A,B<0>,C<0>) <
	.%.==10			;;SAVE RADIX
	RADIX	10		;;DECIMAL
	TTY$	[<BYTE (9)TT$'A,B,C>&-1]
	RADIX	.%.		;;RESTORE RADIX
	PURGE	.%.
> ;TTY

DEFINE	TMSG	(STR) <
	OUTSTR	[ASCIZ ~STR~]
> ;TMSG

DEFINE	FATAL	(STR) <
	JRST [	HRROI	T1,[ASCIZ ~STR~]
		JRST	.FATAL ]
> ;FATAL

DEFINE	ERROR	(STR) <
	JRST [	HRROI	T1,[ASCIZ ~?STR~]
		JRST	.ERROR ]
> ;ERROR

; NEW COMMAND MACROS

DEFINE	CONFRM	< JSR .CONF > ;CONFRM

DEFINE	NOISE	(STR) <
	HRROI	T1,[ASCIZ \STR\]
	JSR	.NOISE
> ;NOISE
	
DEFINE	T	(STR,DATA,FLGS<0>) <
 IFE FLGS,<
  IFB <DATA>,< [ASCIZ |STR|],,<.'STR> ;> [ASCIZ |STR|],,DATA
 > ;IFE FLGS
 IFN FLGS,<
  IFB <DATA>,<  [CM%FW!FLGS
		ASCIZ |STR|],,<.'STR> >
  IFNB <DATA>,< [CM%FW!FLGS
		ASCIZ |STR|],,DATA >
 > ;IFN FLGS
> ;T
	SUBTTL	IMPURE STORAGE

	CMDSTG			;CMD STORAGE

;CONNECT BLOCK FOR DNCONN
CONBLK:	DN%SPL			;Flags (WAIT LONGER)
	0			;Host string pointer
	^D29			;Remote object type
	0			;Local obj
	^D8			;Byte size
	0			;Opt data (Route file on .DNINI call)
	0			;Password
	0			;Account
	0			;User-id
	.NULIO			;Desc for ret op data
	0			;Length for above
	.NULIO			;Desc for errors
	.NULIO			;Desc for warnings
	.NULIO			;Desc for information

.CONF:	0			;JSR TO HERE
	MOVEI	T1,[FLDDB. .CMCFM]
	CALL	RFLDE
	 PJRST	ERRPNT
	JRST	@.CONF

.NOISE:	0			;JSR HERE
	MOVEM	T1,NOIFDB+.CMDAT
	MOVEI	T1,NOIFDB
	CALL	RFLDE
	 PJRST	ERRPNT
	JRST	@.NOISE
NOIFDB:	FLDDB.	.CMNOI,,0

SWHOOK:	EXP	"%"		;SWITCH HOOK CHAR
ERRPSE:	EXP	PSETIM		;AMMOUNT OF TIME TO PAUSE AFTER ERROR OUTPUT
OLDMOD:	BLOCK	1		;SAVED TTY MOD WORD
FAXJFN:	BLOCK	1		;FACSIMILE JFN
FAXFIL:	BLOCK	30		;FILE BEING FAX'ED
LSTCOD:	BLOCK	1		;LAST CODE SENT BY MAKMSG
NODBUF:	BLOCK	<NBFLEN==3>	;BUFFER FOR NODE NAME

ZERBEG:!			;START OF AREA TO ZERO ********************
LNKLST:	BLOCK	1		;LIST OF FREE LINK BLOCKS
WNDLST:	BLOCK	1		;LIST OF FREE WINDOW BLOCKS
NUMUSR:	BLOCK	1		;COUNT OF CURRENT USERS
LNKTAB:	BLOCK	MAXLNK		;TABLE OF "ACTIVE" LINKS
WNDTAB:	BLOCK	MAXWND		;TABLE OF WINDOWS (IN ORDER)
MAXHLD:	BLOCK	1		;MAXMUM HOLD LEVEL (NORMALLY -1)

LNKBLK:	PHASE	0		;**** START OF LINK BLOCK ****
LNKJFN:!BLOCK	1		;CONNECTION TO USER (SEE L$TYPE IN LNKFLG)
LNKHLD:!BLOCK	1		;HOLD LEVEL (-1 IS NORMAL, .GE. 0 IS HELD)
LNKFLG:!BLOCK	1		;FLAGS
    L$HELD==1B0			; HAS YOU ON HOLD
    L$TYPE==,,-1		;**MUST BE RIGHT HALF**
				; LINK TYPE    LNKJFN CONTAINS
	LT$DCN==0		;  DECNET	0,,JFN
	LT$LCL==1		;  LOCAL	PID
LNKSND:!BLOCK	BUFSIZ/4+1	;SEND BUFFER
LNKRCV:!BLOCK	BUFSIZ/4+1	;RECIEVE BUFFER
LNKUSR:!BLOCK	10		;USER'S FULL NAME
LNKUNO:!BLOCK	1		;LOCAL USER NUMBER
LNKJOB:!BLOCK	1		;LOCAL JOB ASSOC WITH PID IN LNKJFN
LNKRUT:!BLOCK	12		;ROUTE WE USED
LNKLEN==.-1
	DEPHASE			;**** END OF LINK BLOCK ****
;WINDOW BLOCK DEFN
WNDBLK:	PHASE	0		;**** START OF WINDOW BLOCK
WNDCOL:!BLOCK	1		;CURRENT COLUMN
WNDLIN:!BLOCK	1		;CURRENT LINE
WNDSIZ:!BLOCK	1		;WINDOW LENGTH (SIZE)
WNDORG:!BLOCK	1		;WINDOW ORIGIN
WNDLBP:!BLOCK	1		;LINE BUFFER POINTER
WNDLNK:!BLOCK	1		;CURRENT LINK
WNDLBF:!BLOCK	^D<<80+4>/5>	;LINE BUFFER
WNDLEN==.-1
	DEPHASE			;**** END OF WINDOW BLOCK ****

SCRSIZ:	BLOCK	1		;TERMINAL SCREEN SIZE
OURBUF:	BLOCK	OURSIZ		;OUR TEXT (INPUT BUFFER)
OURCNT:	BLOCK	1		;COUNT OF CHARS IN OURBUF
OURPNT:	BLOCK	1		;BP INTO OURBUF
A0:	BLOCK	1		;BP FOR INTERUPT TEXT

BSYLNK:	BLOCK	1		;LINK WE ARE RINGING/ANSWERING
US:	BLOCK	10		;OUR FULL USER ID STRING
RINGFL:	BLOCK	1		;VALUE OF LAST RING FLAG RCVD
EXCFRK:	BLOCK	1		;FORK HANDLE FOR EXEC
MSFRK:	BLOCK	1		;FORK HANDLE FOR MAILER (MS)
LSTERR:	BLOCK	1		;BP TO LAST ERROR
ZEREND==.-1			;********** END OF ZEROS

JOBNUM:	BLOCK	1		;LAST JOB LISTED IN DIR
GJIBLK:	BLOCK	.JIMAX+1	;BLOCK FOR GETJI
TMPSTR:	BLOCK	20		;BLOCK FOR LOCAL DIR
TEMP2:	BLOCK	20		;BLOCK FOR DIRST...
ERRSTR:	BLOCK	10		;BLOCK FOR LAST ERROR
;;;PTYPAR:	BLOCK	1		;GETAB
OPRUNO:	BLOCK	1		;WHO TO IGNORE

PIDNAM:	BLOCK	5		;BLOCK FOR PID NAME
ISNDBK:	BLOCK	10		;IPCF SEND BUFFER
IRCVBK:	BLOCK	10		;IPCF RCV BUFFER
OURPID:	BLOCK	1		;PROCESS PID
IPSND:	BLOCK	4		;MSEND BLOCK
IPRCV:	BLOCK	4		;MRECV BLOCK
L2SAVE:	BLOCK	17		;INTERUPT AC SAVE
SAVPOS:	BLOCK	1		;SAVED CURSOR POSN DURING IPCF
SAVCOC:	BLOCK	2		;SAVED CCOC FROM DURING IPCF

UUOACS:	BLOCK	17		;SAVED ACS FOR TTYSTF
VT10OT:	BYTE (7) 33,"[",0,0,0	;VT100 MOVE CURSOR
	BYTE (7) ";",0,0,0,"H",0
VT10ST:	BYTE (7) 33,"[",0,0,0	;VT100 SCROLL
	BYTE (7) ";",0,0,0,"r"
CMNOD:	FLDDB.	.CMKEY,CM%SDH,0,<Host name>,<DEF>,CMNOD2 ;FOR PARSING NODE
CMNOD2:	FLDDB.	.CMKEY,CM%SDH,HSTTAB,,,CMNOD3
CMNOD3:	FLDBK.	.CMFLD,CM%SDH,,,,NODBRK

	BRINI. (-1,-1,-1,-1)	;INITIALIZE BREAK MASK
	UNBRK. ("0","9")	;ALLOW DIGITS
	UNBRK. ("A","Z")	;ALLOW UPPER
	UNBRK. ("a","z")	;ALLOW LOWER

NODBRK:	EXP	W0.,W1.,W2.,W3.


OURJOB:	BLOCK	1		;OUR JOB NUMBER
OURNOD:	BLOCK	2		;OUR NODE NAME
OURNAM: BLOCK   15		;OUR USER NAME
OURPTR: BLOCK   1		;SAVED BP
JOBAOB:	BLOCK	1		;AOBJN FOR ALL JOBS
AC1:	BLOCK	1		;CRASH ACS
AC2:	BLOCK	1		;...
AC3:	BLOCK	1		;...
AC4:	BLOCK	1		;...
AREA:	BLOCK	10		;TEMP AREA

TTYTYP:	BLOCK	1		;GTTYP TERMINAL TYPE
TTYCOC:	BLOCK	2		;ORIGINAL TTY CCOC WORDS
PLIST:	BLOCK	<LPLIST==200>	;PDL sweet PDL
P1FLG:	BLOCK	1		;PSI LEVEL 1 PC
P2FLG:	BLOCK	1		;PSI LEVEL 2 PC
P3FLG:	BLOCK	1		;PSI LEVEL 3 PC
	SUBTTL	CONSTANTS

USRBRK:	EXP	USRB0.,USRB1.,USRB2.,USRB3. ;USER NAME BREAK SET

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

CHNTAB:	PHASE	0		;PSI CHANNEL TABLE
IPCCHN:!2,,IPCINT		;IPCF INTERRUPT
	DEPHASE			;END OF STRANGENESS

;Dispatch table for functions
DEFINE	ACTION (CODE,ADDR) <
	BLOCK	CODE-.
	EXP	ADDR
> ;ACTION

DSPTAB:	PHASE	0
	ACTION	MS$RNG,XRUNG	;BEING RUNG
	ACTION	MS$HUP,XHUNG	;SOMEONE HUNG UP
	ACTION	MS$BSY,XBUSY	;TARGET BUSY
	ACTION	MS$ANS,XANSWR	;TARGET ANSWERED
	ACTION	MS$REJ,XREJ	;TARGET REJECTED
	ACTION	MS$TXT,XTEXT	;TEXT FROM REMOTE
	ACTION	MS$3RD,XFORCE	;3RD PARTY JUST JOINED
	ACTION	MS$HLD,XHOLD	;PUT ON HOLD
	ACTION	MS$OFF,XUNHLD	;TAKEN OFF HOLD
DSPMAX==.
	DEPHASE
; Main command dispatch table

COMTAB:	XWD	COML,COML	;Lengths
	T	ANSWER		;ANSWER (last call)
        T	BLANK		;BLANK (screen)
	T	DIAL		;DIAL (user)
	T	DIRECTORY	;DIRECTORY (of users on)
	T	EXIT		;EXIT (to superior)
	T	F,$FACS,CM%INV!CM%ABR
	T	FA,$FACS,CM%INV!CM%ABR
$FACS:	T	FACSIMILE	;FACSIMILE (of file)
	T	FAXSIMILE,$FACS,CM%INV!CM%ABR
	T	HANGUP		;HANGUP (the phone)
	T	HELP		;HELP
	T	HOLD		;HOLD (current call)
	T	LAST		;LAST (error message)
	T	MAIL		;MAIL (using MS)
	T	PUSH		;PUSH (command level)
	T	REJECT		;REJECT (current call)
	T	STATUS		;STATUS (of PHONE)
	T	UNHOLD		;UNHOLD (previous call)
COML==.-COMTAB-1
	SUBTTL	MAIN CODE

EVEC:	JRST	START
	JRST	START
	-1,,377777

START:	RESET			;STOP THE WORLD!
	MOVE	P,[-LPLIST,,PLIST-1] ;GET THEE A PIDDLE
	HLRZ	T1,.JBSA	;GET INITIAL END
	MOVEM	T1,.JBFF	;STORE
	MOVE	T1,[CALL LUUOH]	;LUUO WORD
	MOVEM	T1,.JB41	;STORE
	MOVEI	I,LNKBLK	;POINT TO NORMAL LINK BLOCK
	CALL	INIT		;INITIALIZATION STUFF
	CALL	TPLATE		;PUT UP TEMPLATE
	CALL	PION		;ENABLE PI
	CALL	CMDINI		;INITIALIZE CMD (SET UP SBK)
	MOVSI	T1,(CM%XIF)	;ACCEPT "@"
	IORM	T1,SBK+.CMFLG	;SET IN STATE BLOCK

;Main command loop
MCOM:	CALL	PARSER		;PARSE AND EXECUTE A COMMAND
	SKIPE	NUMUSR		;HAVE A CONVERSATION?
	 CALL	TEXT		; YES, GO DO TEXT
	JRST	MCOM		;"MAY I PLEASE HAVE ANOTHER, SIR!"

;Parse one command
PARSER:	SETZ	W,		;NO CURRENT WINDOW
	CALL	PMTLIN		;ASSUME THE POSITION
	TTY	<ERB>		;ERASE TO EOS <
	PROMPT	(PHONE>)	;PROMPT
	CALL	IPON		;ENSURE PSI TURNED ON
	MOVEI	T1,[FLDDB. .CMKEY,,COMTAB,,,[ ;PARSE KEYWORD
		    FLDDB. .CMCFM]] ;OR SWALLOW CRLF
	CALL	RFLDE		;PARSE, RETURN ERRORS
	 JRST [	CALL	IPOFF	; PROTECT AGAINST IPCF
		PJRST	ERRPNT ] ; GO SCREAM ABOUT ERROR
	TSZ	T3,T3		;KEYWORD?
	JUMPN	T3,CPOPJ	; NO, MUSTA BEEN CONFIRM
	HRRZ	T1,(T2)		;GET RESULTS
	CALL	(T1)		;CALL ACTION ROUTINE
	 TRN			;...
	RET
	SUBTTL	COMMANDS -- EXIT

.EXIT:	NOISE	(to superior)	;EXIT command
	CONFRM			;BE SURE!!!
	TTY	<SCR,1,24>	;RESET SCROLL REGION
	TTY	<JME>		;CLEAR SCREEN
	MOVX	T1,CZ%ABT	;ABORT
	ADDI	T1,.FHSLF	;ALL OUR FILES
	CLZFF
	 ERJMP	.+1
	CALL	RESTTY		;RESTORE TTY SETTINGS
	RESET			;BLAM I/O AND PIDS
	HALTF
	JRST	START		;RESTART
	SUBTTL	COMMANDS -- FACSIMILE

.FACSIMILE:
	NOISE	(of file)
	MOVEI	T1,[FLDDB. .CMIFI]
	CALL	RFLDE
	 PJRST	ERRPNT
	MOVEM	T2,FAXJFN	;SAVE JFN
	CONFRM

	SKIPN	NUMUSR		;ANY TALKERS?
	 JRST [	CALL	RELFAX
		ERROR	(No current call)] ;SORRY
	MOVE	T1,FAXJFN
	MOVE	T2,[FLD(7,OF%BSZ)!OF%RD]
	OPENF
	 JRST [	CALL	RELFAX
		PJRST	ERRPNT ]
	HRROI	T1,FAXFIL	;GET BUFFER
	MOVE	T2,FAXJFN
	SETZ	T3,
	JFNS
	IDPB	T3,T1

	TLO	FL,(F$FAX)	;SET THE FLAG!!
	RET

RELFAX:	MOVE	T2,FAXJFN
	RLJFN
	 TRN
	RET
	SUBTTL	COMMANDS -- HANGUP

.HANGUP:
	ACVAR	<X1,X2>		;LOOP VARS
	NOISE	(on current call)
	CONFRM

	MOVN	X1,NUMUSR	;LOOP FOR ALL WINDOWS
	MOVSI	X1,(X1)		;-N,,0
	CAIN	X1,0		;ZERO?
	 ERROR	(No current call) ;SORRY
	PUSH	P,I		;SAVE LINK
HG.LOP:	MOVE	T1,WNDTAB(X1)	;GET WINDOW
	MOVE	I,WNDLNK(T1)	;GET LINK
	CALL	FREWND		;FREE UP WINDOW
	CALL	CLSHUP		;HANG UP

	MOVSI	X2,-MAXLNK	;FOR ALL LINKS
HG.LP2:	CAME	I,LNKTAB(X2)	;RIGHT LINK?
	 AOBJN	X2,HG.LP2	; NO, LOOP
	CAIGE	X2,0		;FOUND?
	 SETZM	LNKTAB(X2)	; YES, ZAP
	AOBJN	X1,HG.LOP	;LOOP
	SETZM	NUMUSR		;NO MORE USERS
	PJRST	POPIJ
	ENDAV.


	SUBTTL	COMMANDS -- HELP

.HELP:	HRROI	T1,[ASCIZ 'SYS:PHONE.HLP']
	CALL	HLPFIL##
	 PJRST	ERRPNT
	PJRST	TPLATE
	SUBTTL	COMMANDS -- ANSWER

.ANSWER:
	NOISE	(last call)
	CONFRM
	SKIPE	T1,BSYLNK	;GOT A LINK?
	 TLZN	FL,(F$ANSW)	; AND IN ANSWER MODE
	  ERROR	(No one is calling) ;NO
	SETZM	BSYLNK		;CLEAR BUSY LINK
	PUSH	P,I		;SAVE CURRENT LINK
	MOVE	I,T1		;SWITCH TO CALLER
	MOVEI	T1,MS$ANS	;ANSWER MESG
	SETZ	T2,		;NO DATA
	CALL	SNDMSG		;SEND MESS
	 JRST [	CALL SNDERR	; LOSE LOSE
		PJRST POPIJ ]	; RETURN
	MOVE	T1,I		;GET LINK
	CALL	NEWUSR		;ASSIGN THEM A VIEWPORT
	 TRN			; SIGH
	PJRST	POPIJ		;RETURN
	SUBTTL	COMMANDS -- REJECT

.REJECT:
	NOISE	(last call)	;REJECT COMMAND
	CONFRM			;ARE YOU SURE?
	SKIPE	T1,BSYLNK	;GOT A LINK?
	 TLZN	FL,(F$ANSW)	; AND IN ANSWER MODE
	  ERROR	(No one is calling) ;NO
	SETZM	BSYLNK		;CLEAR BUSY LINK
	PUSH	P,I		;SAVE CURRENT LINK
	MOVE	I,T1		;SWITCH TO CALLER
	MOVEI	T1,MS$REJ	;REJECT MESG
	SETZ	T2,		;NO DATA
	CALL	CLSMSG		;SEND MESS & CLOSE
	PJRST	POPIJ		;RETURN
	SUBTTL	COMMANDS -- DIAL

DIAFDB:	FLDDB.	.CMUSR,,,,,DIAFD2
DIAFD2:	FLDBK.	.CMFLD,CM%SDH,,,,USRBRK,DIAAT
DIAAT:	FLDDB.	.CMTOK,CM%SDH,<-1,,[ASCIZ /@/]>,<@<Host name>>,<@>

.DIAL:	STKVAR	<<USRNAM,20>>	;DIAL COMMAND
	NOISE	(user)
	HRROI	T1,OURNOD	;DEFAULT NODE
	MOVEM	T1,CONBLK+DN.HST ;DIAL NODE
	TLNN	FL,(F$SERV)	;NETWORK+SERVER?
	 IFSKP.
		MOVEI	T1,DIAFDB	;GET FDB
		SETZM	ATMBUF		;CLEAR ATOM BUFFER
		CALL	RFLDE		;TRY.. BUT RETURN ON ERROR
		 PJRST	ERRPNT
		HRRZ	T3,T3		;GET WINNING FDB
		CAIN	T3,DIAFD2	;FIELD?
		 JRST	.DIAL1		; YES
		CAIN	T3,DIAAT	;@?
		 JRST	.DIALN		; YES, GET NODE
	 ELSE.
		MOVEI	T1,[FLDDB. .CMUSR]
		CALL	RFLDE
		 PJRST	ERRPNT
	 ENDIF.	
	HRROI	T1,USRNAM	;GOT USER NUMBER
	DIRST			;CONVERT TO STRING
	 FATAL	(DIRST LOSSAGE)
	SETZ	T2,
	IDPB	T2,T1		;TERMINATE
	TLNE	FL,(F$SERV)	;NETWORK+SERVER?
	 JRST	.DIAL2		; YES, NOW PARSE HOST
	CONFRM
	JRST	.DIAL3

.DIAL1:	MOVE	T1,SBK+.CMABP	;FROM ATOM BUF
	HRROI	T2,USRNAM	;TO USER BUF
	CALL	CPYST0		;COPY
.DIAL2:	MOVEI	T1,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /@/]>,<@<Host name>>,<@>,[
		    FLDDB. .CMCFM] ]
	CALL	RFLDE		;PARSE
	 PJRST	ERRPNT
	TSZ	T3,T3		;"@"?
	JUMPN	T3,.DIAL3	;NOPE, WAS CONFIRM
.DIALN:	MOVEI	T1,CMNOD	;NOW PARSE NODE NAME
	CALL	RFLDE		;DO IT
	 PJRST	ERRPNT
	CALL	NODEBP		;GET BP TO NODE...
	MOVEM	T2,CONBLK+DN.HST ;SAVE NODE BP
	CONFRM			;GET CONFIRMATION
.DIAL3:	CALL	IPOFF		;AVOID PSI
	MOVE	T1,CONBLK+DN.HST ;GET NODE
	HRROI	T2,AREA		;TEMP AREA
	CALL	CPYSTR		;COPY NODE
	MOVEI	T1,":"		;GET A COLON
	IDPB	T1,T2		;TO TERMINATE
	IDPB	T1,T2		;NODE NAME
	HRROI	T1,USRNAM	;GET TARGET USER
	CALL	CPYST0		;COPY IN

	CALL	ERRLIN		;GOTO ERROR/STATUS LINE
	TTY	<ERL>		;CLEAR IT
	HRROI	T1,AREA		;GET NAME
	CALL	MAKLNK		;CREATE LINK
	 JRST [	TRNE	T1,-1	; GOT TEXT?
		 PSOUT		;  TELL 'EM
		PJRST	.ERROR]	; SIGH
	MOVEM	T1,BSYLNK	;SAVE DIALING LINK
	MOVE	I,T1		;SET LINK

	MOVSI	T1,(<BYTE(7)1>)	;FIRST RING FLAG
	MOVEM	T1,AREA		;STORE
	TLO	FL,(F$DIAL)	;DIALING OUT

;User exists, now ring them
.DIAL4:	TLNN	FL,(F$DIAL)	;STILL DIALING?
	 RET			;MUST HAVE BEEN ANSWERED/REJECTED
	CALL	ERRLIN		;GOTO ERROR/STATUS LINE
	TMSG	<Ringing user >	;SAY WHAT WE ARE DOING
	OUTSTR	LNKUSR(I)	;USER STRING
	TMSG	< (type any key to cancel)>
	CALL	ENDERR		;CLEAR AND WAIT

	CALL	IPON		;OPEN THE WINDOW
	MOVEI	T1,MS$RNG	;RING CODE
	HRROI	T2,AREA		;DATA
	CALL	SNDMSG		;SEND MESS
	 JRST [	TLZ FL,(F$DIAL)	; ERROR, CLEAR DIAL MODE
		PJRST SNDERR ]	; SHUT DOWN
	TMSG	<>		;BRRRING...
	MOVEI	T4,^D10		;10 SECONDS
.DIAL5:	TLNN	FL,(F$DIAL)	;GET AN ANSWER?
	 RET			; PERHAPS!!
	CALL	$SIBE		;ANYTHING TYPED?
	 JRST	.DIAL6		; YES, ABORT
	TLNN	FL,(F$DIAL)	;WAS A RING PENDING?
	 RET			; YES, DON'T EVEN SLEEP
	MOVEI	T1,^D1000	;NO, WAIT A SECOND AND CHECK AGAIN
	CALL	$HIBER		;SLEEP
	SOJG	T4,.DIAL5	;LOOP 10 TIMES
	SETZM	AREA		;CLEAR RING FLAG
	JRST	.DIAL4		;RING AGAIN

.DIAL6:	TLZ	FL,(F$DIAL)	;ABORTED, CLEAR DIAL MODE
	MOVEI	T1,.PRIIN	;OUR TTY
	CFIBF			;CLEAR INPUT BUFFER
	PJRST	CLSHUP		;HANG UP
	ENDSV.
	SUBTTL	COMMANDS -- PUSH AND MAIL

.PUSH:	NOISE	(command level)
	CONFRM
	SKIPE	NUMUSR		;Talking?
	 ERROR	(Must hold current call first)
	MOVEI   T4,EXCFRK	;Indicate an EXEC is wanted
	SKIPE	T1,EXCFRK	;Do we already have a fork handle?
	 JRST	STFORK		;Go start it
	MOVSI	T1,(GJ%OLD!GJ%SHT)
	HRROI	T2,[ASCIZ 'DEFAULT-EXEC:']
	GTJFN
	 IFJER.
		MOVSI	T1,(GJ%OLD!GJ%SHT)
		HRROI	T2,[ASCIZ "SYSTEM:EXEC.EXE"]
		GTJFN
		 ERJMP	ERRPNT
	 ENDIF.
	JRST	GTFORK		;Go start it

.MAIL:	NOISE	(using DEFAULT-MAILER:)	;I use BABYL.
	CONFRM			;Are you sure??
	SKIPE	NUMUSR		;Talking?
	 ERROR	(Must hold current call first)
	MOVEI	T4,MSFRK	;Say we want a mailer
	SKIPE	T1,MSFRK	;Do we have an old one?
	 JRST	STFORK		; Yes, just start it
	MOVSI	T1,(GJ%SHT!GJ%OLD) ;Get JFN on file
	HRROI	T2,[ASCIZ "DEFAULT-MAILER:"]
	GTJFN
	 IFJER.
		MOVSI	T1,(GJ%OLD!GJ%SHT)
		HRROI	T2,[ASCIZ "SYS:MS.EXE"]
		GTJFN
		 ERJMP	ERRPNT
	 ENDIF.
GTFORK:	STKVAR	<JFN>
	MOVEM	T1,JFN
	MOVSI	T1,(CR%CAP)	;Create fork w/ full caps
	CFORK
	 ERJMP	ERRPNT
        MOVEM   T1,(T4)		;Save fork handle in right place
	MOVSI	T1,(T1)		;Make Fork,,0
	HRR	T1,JFN		;Make Fork,,JFN
	GET			;Load the fork
	 ERJMP	ERRPNT

STFORK:	TTY	<JMP>		;HOME
	TTY	<ERB>		;CLEAR SCREEN
	MOVE	T1,(T4)		;Get handle
	RPCAP			;Get capabilities
	 ERJMP	ERRPNT		;Sigh
	TLZ	T2,(SC%LOG)	;DON'T ALLOW LOGOUT
	TLZ	T3,(SC%LOG)	;DON'T ALLOW LOGOUT
	EPCAP			;SET CAPABILITIES

	SETZ	T2,		;ENTRY 0
	SFRKV			;IN ENTRY VECTOR
	 ERJMP	STFOR2		; SIGH
	WFORK			;WAIT FOR TERMINATION
	 ERJMP	.+1		; HUH?
	CALL	SAVTTY		;SETUP TTY AGAIN
	PJRST	TPLATE		;REFRESH, AND RETURN

STFOR2:	CALL	TPLATE		;FIRST GET TEMPLATE
	PJRST	ERRPNT		;NOW TYPE LAST ERROR
	ENDSV.
	SUBTTL	COMMANDS -- DIRECTORY

.DIRECTORY:
	ACVAR	<X1>
	STKVAR	<HOSTBP>
	TLNN	FL,(F$DECN)	;GOT DECNET?
	 IFSKP.
		NOISE	(of users on) ;BE NOISY
		MOVEI	T1,CMNOD ;PARSE A NODE
		CALL	RFLDE
		 PJRST	ERRPNT	;ERROR IN PARSING
		CALL	NODEBP	;GET BP TO NODE
		MOVEM	T2,HOSTBP ;SAVE
	 ELSE.
		NOISE	(of users)
	 ENDIF.
	CONFRM
	MOVEI	I,LNKBLK	;GET STATIC LINK BLOCK
	CALL	IPOFF
	MOVEI	T1,LT$DCN
	HRRM	T1,LNKFLG(I)

IFN LOCALF,<
	TLNN	FL,(F$DECN)	;HAVE NETWORK?
	 JRST	LCLDIR		; NOPE
	HRROI	T1,OURNOD	;LOCAL
	MOVE	T2,HOSTBP	;TARGET
	CALL	CMPSTR
	 JRST	REMDIR		; NO MATCH
LCLDIR:	MOVEI	T1,LT$LCL	;LINK TYPE
	HRRM	T1,LNKFLG(I)	;LOCAL!!
	SETZM	JOBNUM		;STARTING LOCAL JOB
	JRST	DIR.AA
> ;LOCALF

REMDIR:	CALL	ERRLIN
	TTY	<ERL>
	MOVE	T1,HOSTBP	;GET HOST
	CALL	OPNCON		;OPEN DECNET CONNECTION
	 JRST [	TRNN	T1,-1	; GOT TEXT?
		 HRROI	T1,[ASCIZ 'Some error occured']
		PJRST	.ERROR ]
	TMSG	<Directory of >
	MOVE	T1,HOSTBP
	PSOUT
	CALL	ENDERR

DIR.AA:	CALL	PMTLIN		;PROMPT..
	TMSG	<Press any key to cancel>
	TTY	<ERB>		;ERASE TO EOS
	TTY	<MOV,5,1>
TMSG	<Process Name	User Name	Terminal	Phone Status
>
	SETZ	X1,		;CLEAR COUNTER

DIRLOP:	CALL	$SIBE		;SEE IF USER TYPED SOMETHING
	 JRST	DIRABT		;ABORT
	CALL	GETDIR		;GET NEXT LINE
	JUMPE	T3,DIRDON	;NULL TEXT? (LENGTH = 0)
	CAIE	X1,0		;ANY PRINTED YET?
	 TRNE	X1,17		;MULT OF SIXTEEN?
	  JRST	DIRTYP		; NO
	TMSG	<
--Type any character to continue--> ;YES
	PBIN			;WAIT
	CAIN	T1,CR		;CR?
	 PBIN			; SNARF LF
	TTY	<MOV,6,1>
DIRTYP:	TTY	<ERL>
	MOVE	T1,T2		;POINT TO BUFFER
	PSOUT			;TYPE IT OUT
	CALL	CRLF		;GO TO NEXT LINE
	TTY	<ERL>		;CLEAR IT
	AOJA	X1,DIRLOP	;LOOP

DIRDON:	TTY	<ERB>
	CALL	CRLF
	JUMPE	X1,[
		TMSG	<No users>
		JRST	DIRWAT ]
	MOVEI	T2,(X1)		;USER COUNT
	CALL	TDEC		;TYPE IT
	TMSG	< user>
	MOVEI	T1,"s"
	CAIE	X1,1		;MORE THAN ONE?
	 CALL	PUTC		; MAKE PLURAL

DIRWAT:	TMSG	< (--Type any character to continue--)>
	PBIN			;WAIT FOR A CHARACTER

DIRABT:	CALL	$CLRBFI		;CLEAR INPUT BUFFER
	CALL	TPLATE		;PUT UP FRESH TEMPLATE
	JRST	CLSDON		;CLOSE DOWN CONNECTION
	ENDAV.
	ENDSV.
;GET NEXT DIR LINE
GETDIR:	HRRZ	T1,LNKFLG(I)	;GET LINK TYPE
	PJRST @[NDIR		;  DECNET CONNECTION
		LDIR ](T1)	;  LOCAL CONNECTION (IPCF)

NDIR:	MOVEI	T1,MS$DIR	;ASK FOR DIRECTORY
	SETZ	T2,		;NO DATA
	CALL	MAKMSG		;CREATE MESSAGE
	CALL	DECOUT		;SEND IT OUT
	CALL	DECINW		;GET RESP. NO TIMEOUTS
	 TRN			; IGNORE STATUS
	RET
	SUBTTL	COMMANDS -- HOLD

.HOLD:	NOISE	(current call)
	CONFRM			;BE SURE...
	SKIPN	NUMUSR		;ANY USERS?
	 ERROR	(No current call)

DOHOLD:	ACVAR	<X1>		;LOOP VAR
	MOVSI	X1,-MAXLNK	;FOR ALL LINKS
HD.LOP:	SKIPN	I,LNKTAB(X1)	;GET LINK
	 JRST	HD.BOT		; NONE
	SKIPL	LNKHLD(I)	;CURRENT?
	 JRST	HD.AOS		; NO
	CALL	KILUSR		;YES, REMOVE FROM SCREEN
	MOVEI	T1,MS$HLD	;SEND HOLD MESS
	SETZ	T2,		;NO DATA
	CALL	SNDMSG		;SEND OFF
	 TRN			; IGNORE ERROR
HD.AOS:	AOS	LNKHLD(I)	;SEND DEEPER INTO HOLD
HD.BOT:	AOBJN	X1,HD.LOP	;..LOOP
	AOS	MAXHLD		;BUMP MAX HOLD LEVEL
	RET
	ENDAV.

	SUBTTL	COMMANDS -- LAST
.LAST:	NOISE	(error text)
	CONFRM
	SKIPN	T1,LSTERR
	 HRROI	T1,[ASCIZ "No errors yet!"]
	PJRST	.ERROR
	SUBTTL	COMMANDS -- UNHOLD

.UNHOLD:NOISE	(previous call)
	CONFRM

	SKIPE	NUMUSR		;ANY USERS?
	 ERROR	(Please hang up first) ;BE RUDE FOR NOW

UNHOLD:	ACVAR	<X1>		;LOOP VAR
	MOVSI	X1,-MAXLNK	;FOR ALL LINKS
UH.LOP:	SKIPN	I,LNKTAB(X1)	;GOT A LINK?
	 JRST	UH.BOT		; NOPE
	SOSL	LNKHLD(I)	;DECREMENT HOLD LEVEL
	 JRST	UH.BOT		; NOT READY YET

	MOVEI	T1,MS$OFF	;TAKE OFF HOLD
	SETZ	T2,		;NO MORE DATA
	CALL	SNDMSG		;SEND OFF
	 JRST	UH.BOT		; LOOOSER
	MOVE	T1,I		;GET LINK
	CALL	NEWUSR		;ADD TO SCREEN
	 TRN			; IT FIT LAST TIME!!

UH.BOT:	AOBJN	X1,UH.LOP	;LOOP...
	SOSGE	MAXHLD		;UP A LEVEL
	 SETOM	MAXHLD		;NOT TOO FAR!!
	CALL	IPON		;LET THE SUN SHINE
	MOVEI	T1,^D100	;PAUSE SO WE GET UNHELD!!
	CALL	$HIBER		;SLEEP
	RET
	ENDAV.
	SUBTTL	COMMANDS -- BLANK AND REDRAW TEMPLATE

.BLANK:	NOISE	(screen)
	CONFRM
TPLATE:	TTY	<JME>		;CLEAR SCREEN
	TTY	<MOV,1,28>	;HEADER LINE
	TTY	<REV>		;REVERSE VIDEO
	TMSG	<TOPS-20 Phone utility>	;TITLE
	TTY	<NRM>		;NORMAL VIDEO

	TTY	<MOV,1,67>
	MOVE	T1,SWHOOK	;SWITCH HOOK CHAR
	CALL	PUTC		;TYPE

	TTY	<MOV,1,70>
	MOVEI	T1,.PRIOU	;TO TTY
	SETO	T2,		;NOW
	MOVX	T3,OT%NTM	;JUST DATE
	ODTIM
	 ERJMP	.+1
	RET
BOXES:	ACVAR	<X1>
	PUSH	P,W		;SAVE WINDOW
	TTY	<MOV,3,1>
	TTY	<ERB>		;CLEAR TO EOS
	MOVEI	W,WNDBLK	;OUR WINDOW BLOCK
	MOVEI	T5,LNKBLK	;OUR LINK BLOCK
	CALL	DOBOX

	MOVN	X1,NUMUSR	;GET USER COUNT
	HRLZ	X1,X1		;AS -N,,0
BOXLOP:	MOVE	W,WNDTAB(X1)	;GET WINDOW
	MOVE	T5,WNDLNK(W)	;GET LINK
	CALL	DOBOX
BOXBOT:	AOBJN	X1,BOXLOP
	POP	P,W		;RESTORE WINDOW
	TLZ	FL,(F$REF)	;SAY WE ARE UP TO DATE
	RET
	ENDAV.

; W/	WINDOW
; T5/	LINK
DOBOX:	ACVAR	<X1>		;BP
	MOVE	T2,WNDORG(W)	;GET ORIGIN
	MOVEI	T3,1		;FIRST COL
	TTY	<MVX,T2,T3>	;GO THERE
	OUTSTR	TP		;GET DASHES

	AOJ	T2,		;NEXT LINE
	MOVEI	T3,^D33		;'MIDDLE'
	TTY	<MVX,T2,T3>	;GO THERE
	TTY	<BRI>		;BRIGHT VIDEO
	OUTSTR	LNKUSR(T5)	;GET USER
	TTY	<NRM>		;NORMAL VIDEO

	MOVE	T3,LNKFLG(T5)	;GET LINK FLAGS
	TLNN	T3,(L$HELD)	;HOLDING US?
	 JRST	BOX2		;NO
	MOVEI	T3,^D70		;GO NEAR END OF LINE
	TTY	<MVX,T2,T3>	;GO THERE
	TMSG	<On Hold>

BOX2:	CALL	CRLF
	MOVEI	T1,TXTLIN	;TOP OF TEXT
	MOVEM	T1,WNDLIN(W)	;STORE
	MOVEI	T1,1		;FIRST COLM
	MOVEM	T1,WNDCOL(W)	;STORE
	SETZ	T0,		;GET NULL
	MOVE	T1,WNDLBP(W)	;GET LINE BP
	IDPB	T0,T1		;STORE NULL
	MOVEI	X1,WNDLBF(W)	;GET LINE BUF
	HRLI	X1,(POINT 7,)	;GET BP
BOX3:	ILDB	T1,X1		;GET BYTE
	JUMPE	T1,CPOPJ	;DONE
	CALL	PUTC		;***** HACKLUDGEHACKLUDGEHACKLUDGEHACKLUDGE
	AOS	WNDCOL(W)	;***** HACKLUDGEHACKLUDGEHACKLUDGEHACKLUDGE
	JRST	BOX3		;LOOP
	ENDAV.

;WAS CAUSING WRAP PROBLEMS.. SHORTENED
TP:	ASCIZ/------------------------------------------------------------------------/
	SUBTTL	COMMANDS -- STATUS

.STATUS:
	ACVAR	<X1>		;CALL LEVEL
	NOISE	(of PHONE)
	CONFRM
	TTY	<MOV,5,1>
	TTY	<ERB>		;ERASE TO EOS
	TMSG	<Status of PHONE:>
	CALL	CRLF
	CALL	CRLF
	TMSG	<User: >
	OUTSTR	US
	CALL	CRLF

	TMSG	<Switch-hook: >
	MOVE	T1,SWHOOK	;SWITCH HOOK CHAR
	CALL	PUTC
	CALL	CRLF

	TLNN	FL,(F$SERV)	;SERVER AVAIL?
	 IFSKP.
	  TMSG	<System has PHONE server -- you may dial out>
	 ELSE.
	  TLNN	FL,(F$DECN)	;DECNET AVAIL?
	   IFSKP.
	    TMSG <System has DECnet, but no server -- you cannot dial out>
	   ELSE.
	    TMSG <System has no DECnet.>
	   ENDIF.
	 ENDIF.
	CALL	CRLF

	SKIPN	NUMUSR		;ANY LUSERS?
	 IFSKP.
	  TMSG	<Current calls:>
	  CALL	CRLF
	  SETO	T1,		;GET LEVEL
	  CALL	DMPLVL		;DUMP IT
	 ENDIF.
	SETZ	X1,
	DO.
	 CAMLE	X1,MAXHLD	;ANY PEOPLE HERE?
	  EXIT.
	 CALL	CRLF
	 TMSG	<Hold level >
	 MOVEI	T2,(X1)		;GET LEVEL
	 CALL	TDEC		;TYPE IT
	 MOVEI	T1,":"
	 CALL	PUTC
	 CALL	CRLF
	 MOVE	T1,X1		;GET LEVEL
	 CALL	DMPLVL
	 AOJA	X1,TOP.		;GET NEXT LEVEL
	OD.

	SKIPN	T4,BSYLNK	;TEMP LINK?
	 IFSKP.
	  TMSG	<Temp link to:>
	  CALL	CRLF
	  CALL	DMPLNK
	 ENDIF.

	CALL	CRLF
	CALL	CRLF
	TMSG	<--Type any char to continue-->
	PBIN
	CAIN	T1,"M"-100
	 PBIN
	RET
	ENDAV.
DMPLVL:	ACVAR	<X1>
	MOVEM	T1,X1		;SAVE LEVEL
	MOVSI	T5,-MAXLNK	;GET LOOP INDEX
DMPLOP:	SKIPE	T4,LNKTAB(T5)	;GET LINK IF ANY
	 CAME	X1,LNKHLD(T4)	; GOT ONE, ON RIGHT LEVEL?
	  JRST	DMPBOT		;  NOPE
	CALL	DMPLNK		;DUMP THIS LINK
DMPBOT:	AOBJN	T5,DMPLOP
	RET
	ENDAV.

; T4/	POINTER TO LINK
DMPLNK:	OUTSTR	LNKRUT(T4)	;GET ROUTE
	OUTSTR	LNKUSR(T4)	;GET USER
	HRRZ	T2,LNKFLG(T4)	;ANY FLAGS SET?
	TMSG	<	(via >
	OUTSTR	@[ [ASCIZ 'DECnet)']
		   [ASCIZ 'Local IPCF)'] ](T2)
	PJRST	CRLF
	SUBTTL	IPCF -- INITIALIZATION

IPCINI:	MOVEI	T1,.FHSLF	;CREATE FORK WIDE PID
	CALL	CREPID		;PID
	 RET			; MUMBLE
	MOVEM	T1,OURPID	;USE THIS ONE FOR NOW

	MOVE	T1,[POINT 7,PIDNAM]
	MOVEI	T2,"<"		;>START PID NAME
	IDPB	T2,T1		;STORE
	HRROI	T2,OURNAM	;USER
	CALL	CPYTXT		;<
	HRROI	T2,[ASCIZ ">PHONE"]
	CALL	CPYTXT
	SETZ	T2,
	IDPB	T2,T1		;TERMINATE

	HRROI	T1,PIDNAM	;NAVE TO GIVE PID
	CALL	NAMPID		;TRY TO ASSIGN
	 TRNA			; LOSE, FIND OWNER
	  JRST	IPCIN2		;  WIN, GO ADD PSI

	HRROI	T1,PIDNAM	;GET NAME
	CALL	FNDPID		;TRY TO LOOK UP
	 FATAL	(Could not get or find your PID)
	CALL	CHKPID		;GET OWNER
	 FATAL (Could not get your PID's owner)
	CAMN	T1,OURJOB	;THIS JOB??
	 FATAL	(Your job already has an active phone)
	FATAL	(Some other job of yours is using the phone)

IPCIN2:	MOVEI	T1,3		;LENGTH
	MOVEI	T2,T3		;ADDRESS
	MOVEI	T3,.MUPIC	;IPCF/PI FUNCTION
	MOVE	T4,OURPID	;PID
	MOVEI	T5,IPCCHN	;CHANNEL
	MUTIL
	 RET
	RETSKP
	SUBTTL	IPCF -- RECIEVE A PAGE FROM LOCAL OR SLAVE

RIPCF:	MOVE	T1,OURPID	;GET OUR PID
	MOVEM	T1,IPRCV+.IPCFR	;STORE RECIEVER
	MOVX	T1,IP%CFB!IP%CFV ;ONE PAGE, DO NOT BLOCK
	MOVEM	T1,IPRCV+.IPCFL	;STORE FLAGS
	MOVE	T1,[1000,,DATPAG] ;MESSAGE PAGE
	MOVEM	T1,IPRCV+.IPCFP	;STORE POINTER
	MOVEI	T1,4		;LENGTH OF BLOCK
	MOVEI	T2,IPRCV	;ADDR OF BLOCK
	MRECV			;GET PACKET
	 ERJMP	CPOPJ
	RETSKP

	SUBTTL	IPCF -- SEND A PAGE TO A LOCAL USER

; T1/	Target PID
;	CALL	SIPCF
;	<ok>
SIPCF:	MOVEM	T1,IPSND+.IPCFR	;STORE RECIEVER'S PID
	MOVX	T1,IP%CFV	;ONE PAGE
	MOVEM	T1,IPSND+.IPCFL	;STORE FLAGS
	MOVE	T1,OURPID	;GET OUR PID
	MOVEM	T1,IPSND+.IPCFS	;STORE SENDER'S PID
	MOVE	T1,[1000,,SNDPAG] ;POINT TO DATA
	MOVEM	T1,IPSND+.IPCFP	;STORE
	MOVEI	T1,4		;BLOCK LENGTH
	MOVEI	T2,IPSND	;BLOCK ADDRESS
	MSEND
	 ERJMP	CPOPJ
	RETSKP
	SUBTTL	IPCF -- RECEIVE A SHORT MESSAGE, BLOCKING (FROM INFO)

RIPCFS:	MOVX	T1,IP%TTL	;TRUNCATE
	MOVEM	T1,IPRCV+.IPCFL	;STORE FLAGS
	MOVE	T1,OURPID	;GET OUR PID
	MOVEM	T1,IPRCV+.IPCFR	;STORE RECIEVER
	MOVE	T1,[10,,IRCVBK] ;MESSAGE AREA
	MOVEM	T1,IPRCV+.IPCFP	;STORE POINTER
	MOVEI	T1,4		;LENGTH OF BLOCK
	MOVEI	T2,IPRCV	;ADDR OF BLOCK
	MRECV			;GET PACKET
	 ERJMP	CPOPJ
	RETSKP

	SUBTTL	IPCF -- SEND A SHORT MESSAGE

; T1/	Target PID
;	CALL	SIPCFS
;	 <lose>
;	<ok>
SIPCFS:	MOVEM	T1,IPSND+.IPCFR	;STORE RECIEVER'S PID
	SETZM	IPSND+.IPCFL	;CLEAR FLAGS
	MOVE	T1,OURPID	;GET OUR PID
	MOVEM	T1,IPSND+.IPCFS	;STORE SENDER'S PID
	MOVE	T1,[10,,ISNDBK] ;POINT TO DATA
	MOVEM	T1,IPSND+.IPCFP	;STORE
	MOVEI	T1,4		;BLOCK LENGTH
	MOVEI	T2,IPSND	;BLOCK ADDRESS
	MSEND
	 ERJMP	CPOPJ
	RETSKP
	SUBTTL	IPCF -- CHECK A PID

; T1/	PID
;	CALL	CHKPID
;	 <invalid>
;	<valid>
; T1/	owning job
CHKPID:	MOVEM	T1,T4		;STORE PID
	MOVEI	T3,.MUFOJ	;FUNCTION
	DMOVE	T1,[EXP 3,T3]	;LEN & ADDR
	MUTIL			;FIND THE PID'S JOB
	 ERJMP	CPOPJ		;RETURN ERROR
	MOVE	T1,T5		;GET JOB NUMBER
	RETSKP			;RETURN HAPPY


	SUBTTL	IPCF -- CREATE A PID

; T1/	Flags,,Fork
;	CALL	CREPID
;	 <lose>
;	<win>
; T1/	PID
CREPID:	MOVE	T4,T1		;PUT FLAGS IN PLACE
	DMOVE	T1,[EXP 3,T3]	;LEN & ADDR
	MOVEI	T3,.MUCRE	;CREATE PID
	MUTIL			;DOIT
	 ERJMP	CPOPJ		;RETURN ERROR
	MOVE	T1,T5		;GET PID
	RETSKP			;RETURN HAPPY
	SUBTTL	IPCF -- FIND PHONE PID (IF ANY) ASSOCIATED WITH A USER NUMBER

; (THIS IS FNDUSR IN PHNSRV)
;	CALL	FNDUNO
;	 <NO>
;	<YES>
; T1/	PID
FNDUNO:	STKVAR	<<BUFFER,^D9>>
	MOVEI	T1,BUFFER	;GET LOCAL BUFFER ADDR
	HRLI	T1,(POINT 7,)	;MAKE INTO BP
	MOVEI	T2,"<"		;> GET START OF PID NAME
	IDPB	T2,T1		;STORE IT
	MOVE	T2,LNKUNO(I)	;GET USER NUMBER
	DIRST			;GET USER STRING
	 RET			; SIGH <
	HRROI	T2,[ASCIZ '>PHONE'] ;TERMINATE PID NAME
	CALL	CPYTXT		;FILL IT OUT
	CALL	IPOFF		;SUPRESS IPCF PSI (MUST READ RESP)
	HRROI	T1,BUFFER	;GET PID NAME ADDR
	CALL	FNDPID		;LOOKUP THE PID
	 TRNA
	  AOS	(P)		;GIVE SKIP
	MOVEM	T1,BUFFER
	CALL	IPON		;RETURN W/ IPCF ENABLED
	MOVE	T1,BUFFER
	RET

	SUBTTL	IPCF -- FIND PID ASSOCIATED WITH A NAME
; T1/	BP TO NAME
;	CALL	FNDPID
;	 <NOPE>
;	<YEP>
; T1/	PID
FNDPID:	HRROI	T2,ISNDBK+.IPCI2 ;NAME OF PID
	CALL	CPYST0		;COPY PID NAME
	MOVEI	T1,.IPCIW	;LOOK FOR PID
	MOVEM	T1,ISNDBK+.IPCI0 ;STORE FUNCTION
	SETZM	ISNDBK+.IPCI1	;SEND RESULTS TO ME ONLY
	CALL	IPCSYS		;INTERACT W/ SYSINF
	 RET			; GRR
	MOVE	T1,IRCVBK+.IPCI1 ;GET PHNSRV PID
	RETSKP

	SUBTTL	IPCF -- ASSIGN NAME TO OURPID
; T1/	BP to name
;	CALL	NAMPID
;	 <loss>
;	<ok>
NAMPID:	HRROI	T2,ISNDBK+.IPCI2 ;NAME OF PID
	CALL	CPYST0		;COPY
	MOVEI	T1,.IPCII	;CREATE NAME
	MOVEM	T1,ISNDBK+.IPCI0 ;STORE FUNCTION
	SETZM	ISNDBK+.IPCI1	;RESULTS TO ME ONLY

	SUBTTL	IPCF -- Send message to <SYSTEM>INFO
IPCSYS:	SETZ	T1,		;PID FOR SYSINF
	CALL	SIPCFS		;SEND MESSAGE TO SYSINF
	 RET			; SIGH

	CALL	RIPCFS		;RECEIVE SHORT MESSAGE FROM SYSINF
	 RET			; MUMBLE..
	LDB	T1,[POINTR IPRCV,IP%CFC] ;GET PRIV FIELD
	CAIE	T1,.IPCCF	;FROM SYSTEM-WIDE <SYSTEM>INFO?
	 CAIN	T1,.IPCCP	; OR FROM MY <SYSTEM>INFO?
	  TRNA			;  YES!!
	   JRST	IPCSYS		;   NO, WAIT FOR IT THEN
	LDB	T2,[POINTR IPRCV,IP%CFE] ;GET SYSINF RETURN CODE
	JUMPN	T2,CPOPJ	;SOME ERROR?
	RETSKP			;NOPE.
	SUBTTL	Initialization stuff

INIT:	SETZB	FL,ZERBEG	;ZERO
	MOVE	T1,[ZERBEG,,ZERBEG+1]
	BLT	T1,ZEREND	;SMEAR

	CALL	CHKNET		;SET NETWORK FLAGS
	TLNN	FL,(F$DECN)	;DECNET?
	 JRST	INIT2		; NOPE
	CALL	GETLCL		;GET LOCAL NODES
	SKIPE	CMNOD+.CMDAT	;ALREADY READ NODE TABLE?
	 JRST	INIT2		;  YES, IGNORE
	MOVEI	T1,CONBLK	;GET CONNECT BLOCK
	CALL	.DNINI##	;INITIALIZE DNCONN
	 MOVEI	T1,[0,,0]	; GET PTR TO EMPTY TABLE
	MOVEM	T1,CMNOD+.CMDAT	;STORE TABLE OF NAMES

INIT2:	SETOM	MAXHLD		;SET UP MAX HOLD LEVEL

	MOVE	T1,['JOBTTY']
	SYSGT
	HLLZM	T2,JOBAOB	;SAVE JOB AOBJN WORD

;;;	MOVE	T1,['PTYPAR']
;;;	SYSGT
;;;	HRRZM	T1,PTYPAR	;STORE FIRST PTY

	MOVSI	T1,(RC%EMO)	;GET EXACT MATCH
	HRROI	T2,[ASCIZ 'OPERATOR']
	SETZ	T3,
	RCUSR			;GET OPERATOR USER NUMBER
	MOVEM	T3,OPRUNO	;SAVE

	CALL	SAVTTY		;SET TERMINAL CCOC WORDS
	MOVEI	T1,.PRIOU	;OUR TTY
	GTTYP			;GET TERMINAL TYPE
	 ERCAL	ERRHLT
	SKIPN	VTXDSP(T2)	;KNOWN?
       FATAL	(Unknown Terminal type)	;ONLY THE BEST TUNA....
	MOVEM	T2,TTYTYP	;SAVE

	MOVEI	T1,.PRIOU	;OUR TTY
	MOVEI	T2,.MORLL	;READ PAGE LEN
	MTOPR			;DO DEV OP
	CAIGE	T3,1		;LOOK REASONABLE?
	 MOVEI	T3,^D24		; NO, GET DEFAULT
	MOVEM	T3,SCRSIZ	;STORE
;Get our name and location
	HRROI	T1,[ASCIZ 'TOPS20'] ;DEFAULT NODE NAME (PERHAPS MONNAM.TXT?)
	HRROI	T2,OURNOD	;DEST
	CALL	CPYST0

	MOVEI	T1,.NDGLN	;GET NODE NAME FUCNTION
	MOVEI	T2,T3		;ARGBLOCK ADDR
	HRROI	T3,OURNOD	;STORE HERE
	MOVEM	T3,CMNOD+.CMDEF	;MAKE DEFAULT NODE NAME
	NODE			;GET NODE NAME
	 ERJMP	QQSV		;ON THE OTHER HAND..
	SETZ	T0,		;GET NULL
	IDPB	T0,T3		;TERMINATE

QQSV:	GJINF			;RANDOM JOB INFO
	MOVEM	T3,OURJOB	;SAVE JOB NUMBER
	MOVE	T2,T1		;PUT UID INTO T2
	HRROI	T1,OURNAM	;GET USER BUFFER
	DIRST			;MAKE USER STRING
	 FATAL	(BAD USER NUMBER)
	IDPB	T0,T1		;TERMINATE

;Get in form NODE::USER
	HRROI	T1,US		;POINT TO BUFFER
	HRROI	T2,OURNOD	;FROM OUR NODE
	CALL	CPYTXT		;COPY IT
	MOVEI	T2,":"		;TERMINATE NODE WITH ::
	IDPB	T2,T1
	IDPB	T2,T1
	HRROI	T2,OURNAM	;COPY FROM OUR NODE
	CALL	CPYTXT		;COPY

	HRROI	T1,LNKBLK+LNKUSR ;GET OUR LINK
	HRROI	T2,US		;GET OUR NAME
	CALL	CPYTXT		;COPY IN

	MOVE	T1,[POINT 7,WNDBLK+WNDLBF] ;GET BP TO OUR LINE BUFFER
	MOVEM	T1,WNDBLK+WNDLBP ;STORE

	MOVEI	T1,.FHSLF	;CURRENT PROCESS
	MOVE	T2,[LEVTAB,,CHNTAB] ;PI TABLES
	SIR			;SET UP TABLES
	MOVSI	T2,(1B<IPCCHN>) ;CHANNEL MASK
	AIC			;ACTIVATE

	CALL	IPCINI		;INITIALIZE IPCF
	 CALL	ERRHLT		;LEAVE A TRAIL
	RET
	SUBTTL	INIT -- GET LOCAL HOSTS

GETLCL:	SETZM	HSTTAB		;No Locals
	MOVEI	T1,5000		;5 pages
	MOVEM	T1,HSTADR	;Store count
	MOVEI	T2,HSTADR	;Get dest
	MOVEI	T1,.NDGNT	;Get node table
	NODE			;Load up table
	 ErJmp Cpopj		; Sigh
	Hlrz 1,HstAdr		;Get number returned
	Movem 1,HstTab		;Store as table max

	Movn 1,1		;Get  -count
	Hrlz 4,1		;-count,,0
	Hrri 4,HstAdr+.NDBK1	;Get start of blocks
GetHs1:	Movei 1,HstTab		;Get table addr
	Move 2,(4)		;Get addr of node block
	Hrlz 2,.NDNAM(2)	;Get addr of node name,,0
	Hlr 2,2			;Get name,,name
	TBADD			;Insert into table
	 ErJmp .+1		; Sigh
	Aobjn 4,GetHs1		;Loop for all hosts
	Ret
	SUBTTL	INIT -- CHECK FOR DECNET

CHKNET:	STKVAR	<TSTJFN>
	MOVSI	T1,(GJ%SHT)
	HRROI	T2,[ASCIZ 'DCN:-29.']
	GTJFN
	 RET
	MOVEM	T1,TSTJFN
	MOVE	T2,[FLD(10,OF%BSZ)!OF%RD!OF%WR]
	OPENF
	 IFJER.			;BAD DEVICE?
		MOVE	T1,TSTJFN
		RLJFN
		 TRN
		RET
	 ENDIF.			;BAD DEVICE?
	DVCHR
	HLRZ	T2,T2
	ANDI	T2,(DV%TYP)
	CAIE	T2,.DVDCN	;RIGHT DEVICE?
	 JRST	CLSTST		; NOPE

; NOW WE ARE SURE WE HAVE DECNET!!
; LOOK FOR THE SERVER.
	TLO	FL,(F$DECN)

	CALL	$UPTIME		;Get current uptime
	MOVE	T4,T1		;Copy
	ADDI	T4,^D<1000*5>	;Allow 5 seconds for connect
TSTLOP:	MOVE	T1,TSTJFN
	MOVEI	T2,.MORLS	;Read link status function
	MTOPR
	 ERJMP	CLSTST
	TLNE	T3,(MO%CON)	;Connected?
	 TLOA	FL,(F$SERV)	; Yes!!
	  TLNE	T3,(MO%ABT!MO%SYN) ;No, connect been rejected?
	   JRST	CLSTST		; Yes, close down
	CALL	$UPTIME		;Get uptime now
	CAML	T1,T4		;Time left?
	 JRST	CLSTST		; No, timed out
	MOVEI	T1,^D500	;Yes, sleep for 1/2 sec
	CALL	$HIBER		;Zzz
	JRST	TSTLOP		;Try again

CLSTST:	MOVE	T1,TSTJFN
	CLOSF
	 TRN
	RET
	ENDSV.

; HERE AFTER PARSING WITH CMNOD.

NODEBP:	HRRZ	T3,T3		;GET WINNER
	HLRO	T2,(T2)		;GET NODE STRING BP (IF TABLE)
	CAIE	T3,CMNOD3	;DID FIELD WIN?
	 RET			; NO, RETURN TABLE ENTRY
	HRROI	T1,NODBUF	;PLACE FOR NODE
	HRROI	T2,ATMBUF	;SOURCE
	MOVNI	T3,NBFLEN*5-1	;MAX LEN
	SETZ	T4,		;OR NULL
	SOUT
	HRROI	T2,NODBUF
	RET
	SUBTTL	PSI -- TURN PI OFF

PIOFF:
;;;	SETZM	PILVL		;SAY WE ARE OFF
.PIOFF:	MOVEI	T1,.FHSLF	;THIS FORK
	DIR			;DISABLE INTERUPTS
	RET

	SUBTTL	PSI -- TURN PI ON
PION:
;;;	SETOM	PILVL		;SAY WE ARE ON
.PION:	MOVEI	T1,.FHSLF	;THIS FORK
	EIR			;ENABLE INTERUPTS
	RET

	SUBTTL	PSI -- KILL IPCF INTERUPTS
IPOFF:	JRST	PIOFF
	MOVEI	T1,.FHSLF	;OUR FORK
	MOVSI	T2,(1B<IPCCHN>)	;IPCF CHAN
	DIC
	RET

	SUBTTL	PSI -- ACTIVATE IPCF INTERUPTS
IPON:	JRST	PION
	MOVEI	T1,.FHSLF	;OUR FORK
	MOVSI	T2,(1B<IPCCHN>)	;IPCF CHAN
	AIC
	RET
	SUBTTL	INTERUPT LEVEL -- IPCF DISPATCH

IPCINT:	MOVEM	16,L2SAVE+16	;STORE AC16
	MOVEI	16,L2SAVE	;SAVE AC0..15
	BLT	16,L2SAVE+15
	MOVEI	T1,.PRIOU	;OUR TTY
	RFPOS			;GET CURSOR POS
	MOVEM	T2,SAVPOS	;SAVE
	RFCOC
	DMOVEM	T2,SAVCOC
	CALL	SETTTY		;RE-BLAST CCOC (COMND PLAYS W/ IT!!)
	CALL	DOIPCF
IINT.3:	MOVEM	FL,L2SAVE+FL	;SATORE FLAGS BACK
	HRRZ	T1,SAVPOS	;GET COLM
	HLRZ	T2,SAVPOS	;GET LINE
	ADDI	T1,1		;MAKE ONE BASED
	ADDI	T2,3		;...
	SKIPE	L2SAVE+W	;HAVE A WINDOW?
	 JRST	IINT.4		; YES, DON'T WORRY
	TTY	<MVX,T2,T1>	;NO, RESTORE TO COMND% LINE
IINT.4:	MOVEI	T1,.PRIOU	;OUR TTY
	MOVE	T2,SAVPOS	;GET SAVED POSN
	SFPOS			;SET CURSOR POS
	DMOVE	T2,SAVCOC	;RESTORE CCOC
	SFCOC
	MOVSI	16,L2SAVE	;RESTORE ACS
	BLT	16,16		;0..16
	DEBRK

DOIPCF:	CALL	RIPCF		;GET MESSAGE (PAGE)
	 RET			; NO MORE
	LDB	T1,[POINT 8,DATADR,7] ;GET CODE
	CAIG	T1,DSPMAX	;IN RANGE?
	 SKIPN	T1,DSPTAB(T1)	; ANY ROUTINE?
	  TRNA			;  NO.
	   CALL	(T1)		;   GO TO ROUTINE
	    TRN			;    BE CAREFULL
	JRST	DOIPCF		;GET ANOTHER
	SUBTTL	INTERUPT LEVEL -- RING

XRUNG:	MOVE	T1,[POINT 8,DATADR,7] ;GET PEST
	HRROI	T2,US		;AND US
	CALL	CMPSTR		;ONE AND THE SAME?
	 JRST	RI.OTH		; NOPE, BE NORMAL

	SKIPN	I,BSYLNK	;USE SAME LINK TO ANSWER!!
	 RET			; YOU LOSE
	MOVEI	T1,MS$ANS	;ANSWER..
	SETZ	T2,		;NO DATA
	CALL	SNDMSG		;SEND MESSAGE
	 PJRST	CLSDON		; SIGH
	TLO	FL,(F$ANSW)	;PUT INTO ANSWER MODE
	RET			;GO HOME

;Here with a ring from someone who is not us
RI.OTH:	TLNE	FL,(F$DIAL)	;IN DIAL MODE?
	 PJRST	TMPBSY		; IF YES, RETURN BUSY

	MOVE	T2,[POINT 8,DATADR,7] ;GET SENDER
RI.LOP:	ILDB	T1,T2		;GET BYTE
	JUMPN	T1,RI.LOP	;TILL EOS
	ILDB	T1,T2		;GET RING FLAG
	MOVEM	T1,RINGFL	;SAVE

	TLNE	FL,(F$ANSW)	;ANSWERING ALREADY?
	 SKIPN	RINGFL		; AND THIS IS FIRST RING?
	  TRNA			;  NO.
	   PJRST TMPBSY		;   YES, SEND BACK BUSY

	TLNN	FL,(F$ANSW)	;ANSWERING?
	 SKIPN	RINGFL		; OR NOT FIRST RING?
	  JRST	RI.2		;  YES, HANDLE SUBSEQUENT RING.

; Here with first ring when not currently answering, and user is not
; us.  Silently establish link back to them, and set "answer mode".

	MOVE	T1,[POINT 8,DATADR,7] ;NO, NEW USER!!
	CALL	MAKLNK		;MAKE LINK BACK TO THEM
	 RET			; SIGH
				;NOTE: WE QUIT NOW SO THE USER DOESN'T
				;KNOW THIS B.S. WENT ON (OTHER THAN THE
				;DELAY) AS OPPOSED TO CRUFTY VAX VERSION

	PUSH	P,I		;SAVE LINK
	MOVE	I,T1		;SET LINK TO NEW ONE
	TLO	FL,(F$ANSW)	;PUT INTO ANSWER MODE
	MOVEM	I,BSYLNK	;SAVE BUSY LINK
	POP	P,I		;RESTORE LINK
	JRST	RI.MES		;GIVE "RING", NOW THAT BSYLNK IS SET UP!
; Answer mode, or not first ring

RI.2:	SKIPE	T1,BSYLNK	;HAVE A LINK?
	 TLNN	FL,(F$ANSW)	; AND IN ANSWER MODE?
	  RET			;  NO PUNT THE POOR LUSER (SEND TMPBSY?)
	HRROI	T1,LNKUSR(T1)	;GET OLD RINGER
	MOVE	T2,[POINT 8,DATADR,7] ;GET NEW RINGER
	SKIPN	RINGFL		;SUBSEQUENT RING
	 CALL	CMPSTR		; AND FROM SAME PERSON?
	  RET			;  YOU LOSE
	
RI.MES:	MOVE	T1,[POINT 8,DATADR,7] ;GET USER
	HRROI	T2,US		;GET US
	CALL	CMPSTR		;ONE AND THE SAME?
	 TRNA			;NO, KEEP TRUCK'N
	  RET			; YES, DON'T WAST BREATH
	CALL	ERRLIN		;GO TO MESSAGE LINE
	CALL	SAVTTY		;***********
	MOVE	T1,[POINT 8,DATADR,7] ;TELL THEM WHO
	PSOUT			;TYPE IT
	TMSG	< is ringing you!> ;BRRRING..
	PJRST	ENDERR

;Tell someone we are busy (called from RING interrupt)
TMPBSY:	PUSH	P,I		;SAVE CURRENT LINK
	MOVE	T1,[POINT 8,DATADR,7] ;THEIR NAME
	CALL	MAKLNK		;MAKE LINK
	 JRST	POPIJ		; FAILED
	MOVE	I,T1		;SWITCH TO NEW LINK
	MOVEI	T1,MS$BSY	;BUSY
	SETZ	T2,		;NO DATA
	CALL	SNDMSG		;SEND MESS
	 TRN			; IGNORE ERROR
	CALL	CLSDON		;SHUT DOWN THE LINK
POPIJ:	POP	P,I		;RESTORE LINK
	RET
	SUBTTL	INTERUPT LEVEL -- HANGUP

XHUNG:	ACVAR	<X1>		;LOOP VAR
	SKIPN	T1,BSYLNK	;GOT A BUSY LINK
	 JRST	HU.FND		; NOPE
	HRROI	T1,LNKUSR(T1)	;GET BUSY USER
	MOVE	T2,[POINT 8,DATADR,7] ;GET USER WHO HUNGUP
	CALL	CMPSTR		;SAME?
	 JRST	HU.FND		; NOPE
	TLNE	FL,(F$DIAL)	;ARE WE CALLING THEM?
	 JRST [	CALL BRKCAL	; YES, BREAK IT THEN
		JRST HU.MES ]	; GO GIVE MESS
	TLZN	FL,(F$ANSW)	;WERE THEY CALLING US?
	 JRST	HU.FND		; NO?????
	MOVE	I,BSYLNK	;YES
	SETZM	BSYLNK		;CLEAR LINK
	CALL	CLSHUP		;HANG UP & SHUT DOWN THE LINK
	JRST	HU.MES		;TELL THEM

HU.FND:	MOVSI	X1,-MAXLNK	;SEARCH *ALL* LINKS
HU.LOP:	SKIPN	I,LNKTAB(X1)	;GET LINK, IF ANY
	 JRST	HU.BOT		; NO LINK
	HRROI	T1,LNKUSR(I)	;GET USER
	MOVE	T2,[POINT 8,DATADR,7] ;GET REMOTE
	CALL	CMPSTR		;MATCH?
	 JRST	HU.BOT		; NO
	CALL	KILUSR		;KILL FROM SCREEN
	SETZM	LNKTAB(X1)	;FREE LINK SLOT
	CALL	CLSHUP		;SAY GOODBYE, KILL LINK BLOCK
HU.BOT:	AOBJN	X1,HU.LOP	;LOOP
	CALL	REFRSH		;RE-SPLIT SCREEN
	 TRN			; NEVER MIND...
HU.MES:	CALL	ERRLIN		;PUT ON ERROR LINE
	MOVE	T1,[POINT 8,DATADR,7] ;GET USER
	PSOUT			;TYPE THEM
	TMSG	< hung up>	;TELL WHAT THEY DID
	PJRST	ENDERR
	ENDAV.
	SUBTTL	INTERUPT LEVEL -- BUSY SIGNAL

XBUSY:	SKIPN	T1,BSYLNK	;CALLER/EE?
	 RET			; NOPE
	HRROI	T1,LNKUSR(T1)	;GET USER
	MOVE	T2,[POINT 8,DATADR,7] ;GET REMOTE
	CALL	CMPSTR		;RIGHT PERSON?
	 RET			; PHONEY PHONE CALL
	TLNN	FL,(F$DIAL)	;IN DIAL MODE?
	 JRST	XBUS.1		; NO, CHECK IF BEING RUNG
	CALL	BRKCAL		;BREAK THE CALL
	CALL	ERRLIN		;GO TO ERR LINE
	TMSG	<User is busy>	;SAY WHAT WE MEAN
	PJRST	ENDERR

XBUS.1:	TLZN	FL,(F$ANSW)	;IN ANSWER MODE?
	 RET			; NOPE, TOTAL LOSER
	MOVEI	T1,MS$BSY	;THAT'L SHOW UM!
	SETZ	T2,		;NO DATA
;Close BSYLNK
; T1/	MESSAGE
CLSBSY:	PUSH	P,I		;SAVE LINK
	MOVE	I,BSYLNK	;SET TO BUSY LINK
	SETZM	BSYLNK		;DESTROY BSYLNK
	CALL	CLSMSG		;SEND IT
	PJRST	POPIJ

;Break current call
BRKCAL:	TLZ	FL,(F$DIAL)	;CLEAR DIAL MODE
	MOVEI	T1,MS$HUP	;SAY WE HUNG UP
	SETZ	T2,		;NO DATA
	PJRST	CLSBSY		;CLOSE BUSYLINK
	SUBTTL	INTERUPT LEVEL -- ANSWERED

XANSWR:	ACVAR	<X1,X2>		;NEW LINK, LOOP VAR
	STKVAR	<<FULNAM,20>,<OLDNAM,20>> ;FULL ROUTE TO NEW PERSON, OLD PERSON
	TLNE	FL,(F$DIAL)	;IN DIAL MODE?
	 SKIPN	X1,BSYLNK	;HACKING A LINK?
	  RET			; NO, SPURIOUS
	HRROI	T1,LNKUSR(X1)	;GET TARGET USER
	MOVE	T2,[POINT 8,DATADR,7] ;GET REMOTE
	CALL	CMPSTR		;COMPARE
	 RET			; NOT WHO WE WANT
	TLZ	FL,(F$DIAL)	;GOT AN ANSWER!!
	MOVE	T1,BSYLNK	;GET LINK
	CALL	NEWUSR		;GET WINDOW, SAVE LINK
	 PJRST	BRKCAL		; ABANDON SHIP!!
	SETZM	BSYLNK		;CLEAR LINK (BRKCAL NEEDS IT)
	CALL	ERRLIN		;REPORT ON ERROR LINE
	MOVE	T1,[POINT 8,DATADR,7] ;GET USER
	PSOUT			;TYPE
	TMSG	< ANSWERed!>	;OH BLISS
	CALL	ENDERR

;; HERE TO FORCE LINKS TO NEW PERSON ETC..
	HRROI	T1,FULNAM	;PLACE FOR FULL USER NAME
	HRROI	T2,LNKRUT(X1)	;GET FULL ROUTE
	CALL	CPYTXT		;COPY IF ANY
	HRROI	T2,LNKUSR(X1)	;COPY NAME TOO

; LOOP FOR ALL ACTIVE WINDOWS
	MOVN	X2,NUMUSR	;GET USER COUNT
	HRLZ	X2,X2		;AS -N,,0
FRCLOP:	MOVE	T1,WNDTAB(X2)	;GET WINDOW
	MOVE	I,WNDLNK(T1)	;GET LINK
	CAMN	I,X1		;IS THIS THE NEW USER?
	 JRST	FRCBOT		; YES, DON'T SEND

;TELL OLDPERSON ABOUT NEWPERSON
	MOVEI	T1,MS$3RD	;GET MESSAGE TYPE
	MOVE	T3,LNKFLG(I)	;GET LINK FLAGS
	TLNN	T3,(L$HELD)	;HOLDING US?
	 CALL	SNDMSG		; NO, SEND
	  TRN			;  IGNORE ERRORS
;TELL NEWPERSON ABOUT OLDPERSON
	HRROI	T1,OLDNAM	;GET PLACE FOR FULL OLD NAME
	HRROI	T2,LNKRUT(I)	;GET OLDPERSON ROUTE
	CALL	CPYTXT		;COPY IN
	HRROI	T2,LNKUSR(I)	;GET OLDPERSON NAME
	CALL	CPYTXT		;COPY
	MOVE	I,X1		;SET LINK TO BE NEW PERSON
	MOVEI	T1,MS$3RD	;GET MESS TYPE
	HRROI	T2,OLDNAM	;GET ADDR OF OLD PERSON
	MOVE	T3,LNKFLG(I)	;GET FLAGS FOR NEW PERSON
	TLNN	T3,(L$HELD)	;HOLDING US? (ON THE FIRST DATE?) (SO SOON??)
	 CALL	SNDMSG		;SEND TO NEW PERSON
	  TRN			; SIGH
FRCBOT:	AOBJN	X1,FRCLOP	;LOOP FOR ALL WINDOWS
	RET			;WE SHOULD NOW BE IN TALK MODE
	ENDAV.
	SUBTTL	INTERUPT LEVEL -- FORCED LINK

XFORCE:	ACVAR	<X1>		;LOOP VAR
	STKVAR	<UID>		;BP TO USER ID.
	MOVE	T1,[POINT 8,DATADR,7] ;GET SOURCE USER
XFRC.1:	ILDB	T2,T1		;GET A BYTE
	JUMPN	T2,XFRC.1	;UNTIL END OF NAME
	CALL	GETUSR		;PARSE TARGET OF FORCE
	 RET			; FAILURE!!
	MOVEM	T3,UID		;SAVE BP TO NODE::USER

; SEARCH ALL LINKS FOR THIS USER
	MOVSI	X1,-MAXLNK	;SEARCH *ALL* LINKS
XFRC.L:	SKIPN	I,LNKTAB(X1)	;GET LINK, IF ANY
	 JRST	XFRC.B		; NO LINK
	HRROI	T1,LNKUSR(I)	;GET USER
	MOVE	T2,UID		;GET NEWPERSON
	CALL	CMPSTR		;MATCH?
	 TRNA			; NO, KEEP LOOKING
	  RET			;  YES, CANNOT CREATE NEW LINK
XFRC.B:	AOBJN	X1,XFRC.L	;LOOP
	MOVE	T1,UID		;GET NEW PERSON
	CALL	MAKLNK		;CREATE LINK
	 RET			; SIGH.
	MOVE	I,T1		;SAVE LINK
	CALL	NEWUSR		;ADD HIR
	 PJRST	CLSHUP		; NO!! HANGUP, AND CLOSE LINK!!

	CALL	ERRLIN		;RIGHT PLACE
	TMSG	<>		;BEEP!
	MOVE	T1,[POINT 8,DATADR,7] ;GET REMOTE
	PSOUT			;SAY WHO
	MOVE	X1,T1		;SAVE BP
	TMSG	< has set up a conference call with >
	MOVE	T1,X1		;GET BP BACK
	PSOUT
	RET
	ENDAV.
	ENDSV.
	SUBTTL	INTERUPT LEVEL -- REJECT

XREJ:	TLNE	FL,(F$DIAL)	;IN DIAL MODE?
	 SKIPN	T1,BSYLNK	;HACKING A LINK?
	  RET			; NO, SPURIOUS
	HRROI	T1,LNKUSR(T1)	;GET TARGET USER
	MOVE	T2,[POINT 8,DATADR,7] ;GET REMOTE
	CALL	CMPSTR		;COMPARE
	 RET			; NOT WHO WE WANT
	CALL	ERRLIN		;REPORT ON ERROR LINE
	MOVE	T1,[POINT 8,DATADR,7] ;GET USER
	PSOUT			;TYPE
	TMSG	< REJECTed!>	;OH BLISS
	CALL	ENDERR
	PJRST	BRKCAL		;CREAK THE CALL
	SUBTTL	INTERUPT LEVEL -- PUT ON HOLD

XHOLD:	MOVE	T1,[POINT 8,DATADR,7] ;GET USER
	CALL	FNDLNK		;FIND ANY LINK
	 RET			; NO SUCH ZONE
	MOVSI	T2,(L$HELD)	;GET HELD FLAG
	IORM	T2,LNKFLG(T1)	;SET FLAG IN LINK
	SKIPL	LNKHLD(T1)	;DO WE HAVE THEM ON HOLD?
	 RET			; YES, NO SCREEN CHANGE
	JUMPE	W,CPOPJ		;IF NOT IN A WINDOW, PUNT
	MOVE	T1,[POINT 8,DATADR,7] ;FIND USER
	CALL	FNDUSR		;GET WINDOW
	 RET			; HUH?
	MOVE	T2,WNDLIN(T1)	;GET ORIGIN
	ADDI	T2,1		;STATUS LINE
	MOVEI	T3,^D70		;COLUMN
	TTY	<MVX,T2,T3>	;GO THERE
	TMSG	<(Has you on hold)>	;MESS
	PJRST	POSION		;RESTORE POSION
	SUBTTL	INTERUPT LEVEL -- TAKEN OFF HOLD

XUNHLD:	MOVE	T1,[POINT 8,DATADR,7] ;GET USER
	CALL	FNDLNK		;FIND LINK BLOCK
	 RET			; ??
	MOVSI	T2,(L$HELD)	;GET FLAG
	ANDCAM	T2,LNKFLG(T1)	;CLEAR IN LINK
	JUMPE	W,CPOPJ		;IF NO WINDOW, PUNT
	SKIPL	LNKHLD(T1)	;WE HAVE THEM ON HOLD?
	 RET			; YES, NO SCREEN CHANGE (NOT ON SCREEN)
	MOVE	T1,[POINT 8,DATADR,7] ;FIND USER
	CALL	FNDUSR		;GET WINDOW
	 RET			; HUH?
	MOVE	T2,WNDLIN(T1)	;GET ORIGIN
	ADDI	T2,1		;STATUS LINE
	MOVEI	T3,^D70		;COLUMN
	TTY	<MVX,T2,T3>	;GO THERE
	TTY	<ERL>		;CLEAR TO END OF LINE
	TMSG	<>		;OH BOY!!
	PJRST	POSION		;RESTORE POSION
	SUBTTL	INTERUPT LEVEL -- CONVERSATION TEXT

XTEXT:	JUMPE	W,CPOPJ		;NO CURRENT WINDOW? PUNT!
	MOVE	T1,[POINT 8,DATADR,7] ;GET USER BP
	CALL	FNDUSR		;SEARCH ACTIVE USERS FOR A MATCH
	 RET			;SIGH
	PUSH	P,W		;SAVE WINDOW
	MOVE	W,T1		;SET WINDOW
	CALL	POSION		;POSITION CURSOR

	MOVE	T1,[POINT 8,DATADR,7] ;POINT TO USER
XTEXT0:	ILDB	T0,T1		;GET NEXT
	JUMPN	T0,XTEXT0	;UNTIL END
	MOVEM	T1,A0		;STORE BP

XTEXT1:	ILDB	T1,A0		;GET CHARACTER
	JUMPE	T1,XTEXT2	; EOS?
	CALL	ECHO		;ECHO IT
	JRST	XTEXT1		;LOOP

XTEXT2:	POP	P,W		;RESTORE WINDOW
	PJRST	POSION		;AND POSITION
	SUBTTL	STRINGS -- COPY FROM T1 TO T2 W/ NULL
CPYST0:	CALL	CPYSTR		;COPY
	SETZ	T0,		;GET NULL
	IDPB	T0,T2		;TERMINATE
	RET

	SUBTTL	STRINGS -- COPY FROM T1 TO T2 W/O NULL
CPYSTR:	CALL	CHKBPS
CPYST2:	ILDB	T0,T1
	JUMPE	T0,CPOPJ
	IDPB	T0,T2
	JRST	CPYST2

	SUBTTL	STRINGS -- COPY FROM T2 TO T1; BACKUP OVER NULL
CPYTXT:	CALL	CHKBPS
CPYTX2:	ILDB	T0,T2
	JUMPE	T0,CPYTX3
	IDPB	T0,T1
	JRST	CPYTX2
CPYTX3:	PUSH	P,T1		;SAVE DEST
	IDPB	T0,T1		;STORE ZERO BYTE
	POP	P,T1		;RESTORE BP
	RET

	SUBTTL	STRINGS -- COMPARE STRINGS FOR EQUALITY ONLY (IGNORE CASE)
; T1/	bp1
; T2/	bp2
;	CALL	CMPSTR
;	 <neq>
;	<eql>
CMPSTR:	CALL	CHKBPS
CMPST2:	ILDB	T3,T1
	TRZ	T3,40
	ILDB	T4,T2
	TRZ	T4,40
	CAIE	T3,(T4)		;EQUAL?
	 RET			; YOU LOSE
	JUMPN	T3,CMPST2	;AT END?
	RETSKP

	SUBTTL	STRINGS -- CHECK BYTE POINTERS
CHKBPS:	MOVEI	T4,T2		;CHECK T2
	CALL	CHKBYT		;DOIT
CHKBT1:	MOVEI	T4,T1		;CHECK T1
CHKBYT:	HLRZ	T0,(T4)		;GET BYTE POINTER
	CAIE	T0,0		;JUST AN ADDRESS
	 CAIN	T0,-1		; OR FROM HRROI?
	  MOVEI	T0,(POINT 7,)	;  YES, MAKE REAL BYTE POINTER
	HRLM	T0,(T4)		;PUT BACK
	RET
	SUBTTL	TYPE JSYS ERROR

ERRPNT:	CALL	ERRLIN		;GO TO ERROR LINE
	HRROI	T1,ERRSTR	;TYPE ON TTY
	MOVEI	T2,"?"		;A QUESTION MARK
	BOUT			;OUTPUT IT
	HRLOI	T2,.FHSLF	;THIS FORK, LAST ERROR
	SETZ	T3,		;NO LIMIT
	ERSTR			;TYPE ERROR
	 TRNA			; SIGH
	  TRN			;  SIGH
	SETZ	T2,
	IDPB	T2,T1
	HRROI	T1,ERRSTR

	SUBTTL	SUPPORT FOR ERROR MACRO
.ERROR:	CALL	CHKBT1		;MAKE INTO REAL BP
	MOVEM	T1,LSTERR	;(ERROR macro always adds a "?")
	ILDB	T2,T1		;CHECK FOR LEADING CRLF (FROM DNCONN)
	CAIE	T2,CR		; WAS CR?
	 JRST	.ERR1		;NOPE
	ILDB	T2,T1		;GET NEXT
	CAIN	T2,LF		;IS LF?
	 MOVEM	T1,LSTERR	; YES, SAVE WITHOUT CRUD
.ERR1:	CALL	ERRLIN
	MOVE	T1,LSTERR
	PSOUT
	PJRST	ENDERR

	SUBTTL	SUPPORT FOR FATAL MACRO
.FATAL:	ESOUT			;TYPE ERROR
	CALL	CRLF		;TYPE CRLF
	JRST	DOEXIT

	SUBTTL	JSYS ERROR AND DEATH
ERRHLT:	DMOVEM	T1,AC1
	DMOVEM	T3,AC3
	CALL	ERRPNT
DOEXIT:	HALTF
	JRST	DOEXIT
	SUBTTL	TTY -- SAVE CCOC WORD

SAVTTY:	MOVEI	T1,.PRIOU	;OUR TTY
	RFCOC			;GET CCOC WORD
	DMOVEM	T2,TTYCOC	;SAVE IT

	SUBTTL	TTY -- BLAST CCOC WORD

SETTTY:	MOVEI	T1,.PRIOU	;OUR TTY
	DMOVE	T2,[EXP 052532555125,252525452400] ;MAKE ^H, ^G, ^L, ESC
	SFCOC			;ECHO AS SELF
	RET

	SUBTTL	TTY -- RESTORE CCOC WORD
RESTTY:	MOVEI	T1,.PRIOU	;OUR TTY
	DMOVE	T2,TTYCOC	;GET OLD BITS
	SFCOC
	RET

	SUBTTL	TTY -- KILL ECHO
NOECHO:	MOVEI	T1,.PRIIN	;OUR TTY
	RFMOD			;GET MODE WORD
	TRZ	T2,TT%ECO	;CLEAR ECHO BIT
	SFMOD			;SET MODES
	RET

	SUBTTL	TTY -- RESTORE ECHO
YSECHO:	MOVEI	T1,.PRIIN	;OUR TTY
	RFMOD			;GET MODE WORD
	TRO	T2,TT%ECO	;SET ECHO BIT
	SFMOD			;SET MODES
	RET

	SUBTTL	TTY -- SKIP IF INPUT BUFFER EMPTY
$SIBE:	MOVEI	T1,.PRIIN	;CHECK OUR TTY
	SIBE			;INPUT BUFFER EMPTY
	 TRNA			; EMPTY
CPOPJ1:	  AOS	(P)
CPOPJ:	RET

$HIBER:	DISMS			;SLEEP
	RET

$UPTIME: TIME			;GET SYSTEM UPTIME IN MS.
	RET

$CLRBFI: MOVEI	T1,.PRIIN	;TTY
	CFIBF			;CLEAR INPUT BUFFER
	RET

PUTC:	PBOUT			;TYPE A CHAR
	RET

CRLF:	TMSG	<
>
	RET

; TYPE DECIMAL NUMBER IN T2
TDEC:	MOVEI	T1,.PRIOU	;TERMINAL
	MOVEI	T3,^D10		;DECIMAL
	NOUT			;TYPE NUMBER
	 ERJMP	.+1		;DISREGARD..
	RET
	SUBTTL	TEXT CONVERSATION INPUT

TEXT:	MOVEI	W,WNDBLK	;OUR WINDOW
	CALL	EC.RES		;RESET OUR LINE BUFFER
	MOVEI	T1,TXTLIN	;GOTO TOP OF WINDOW
	MOVEM	T1,WNDLIN(W)	;STORE
	MOVEI	T1,1		;AND FIRST COL
	MOVEM	T1,WNDCOL(W)	;STORE
	MOVE	T1,[POINT 7,OURBUF] ;TEXT BUFFER
	MOVEM	T1,OURPNT	;STORE
	MOVEI	T1,OURSIZ*5-1	;COUNT
	MOVEM	T1,OURCNT	;STORE
	CALL	IPOFF		;KILL INTERUPTS
	CALL	ERRLIN		;GOTO ERROR LINE
	TTY	<ERB>		;BLAST SCREEN
	CALL	BOXES		;SET UP BOXES FOR CONVERSATION
	CALL	NOECHO		;CLEAR TTY ECHO
	CALL	POSION		;SET CURSOR POSN
	CALL	DOLOOK		;GOTO INPUT LOOP
	CALL	YSECHO		;RESTORE ECHO
	RET

	SUBTTL	LOOK -- Get character
DOLOOK:	ACVAR	<X1>		;PERM AC
LOOK:	SKIPN	NUMUSR		;ANY MORE USERS?
	 RET			; NOPE
	TLNE	FL,(F$REF)	;REFRESH NEEDED?
	 CALL	BOXES		; YES, SET UP NEW BOXES
	TLNE	FL,(F$FAX)	;FACSIMILE?
	 JRST	LKFAX		; YES, HANDLE IT
	CALL	$SIBE		;CHECK FOR INPUT
	 JRST	LKGET		; YES! GO GET IT
	TLNE	FL,(F$TEXT)	;ANY TEXT TO SEND?
	 JRST	LOOK0		; YES, SEND IT
	CALL	IPON		;NO, INTERUPTS OK AGAIN
LKHANG:	PBIN			;WAIT FOR A CHAR
	PUSH	P,T1		;SAVE CHAR
	CALL	IPOFF		;PROHIBIT INTERUPTS AGAIN
	POP	P,T1		;RESTORE CHAR
	JRST	LKGOT		;PRINT IT

LOOK0:	CALL	LKSEND		;SEND BUFFER
	TLZ	FL,(F$TEXT)	;CLEAR TEXT FLAG
	JRST	LOOK		;CONTINUE

	SUBTTL	LOOK -- Send off OURBUF to all of our windows user's
LKSEND:	MOVE	T1,OURCNT	;GET COUNT
	SUBI	T1,OURSIZ*5-1	;GET CHARS PERSENT
	JUMPE	T1,CPOPJ	;IGNORE IF EMPTY
	SETZ	T0,		;NULL
	IDPB	T0,OURPNT	;TERMINATE TEXT
	MOVEI	T1,MS$TXT	;CONVERSATION TEXT
	HRROI	T2,OURBUF	;BUFFER
	CALL	SNDALL		;SEND TO ALL WINDOWS
	MOVE	T1,[POINT 7,OURBUF] ;TEXT BUFFER
	MOVEM	T1,OURPNT	;STORE
	MOVEI	T1,OURSIZ*5-1	;COUNT
	MOVEM	T1,OURCNT
	RET

	SUBTTL	LOOK -- Get a FAX character
LKFAX:	HRROI	T1,[ASCIZ '
**** Facsimile of ']
	CALL	FAXSTR
	TLNN	FL,(F$SERV)	;COULD THIS BE A DECNET CALL?
	 IFSKP.
	  HRROI	T1,OURNOD
	  CALL	FAXSTR
	  MOVEI	T1,":"
	  CALL	ECHO
	  MOVEI	T1,":"
	  CALL	ECHO
	 ENDIF.
	HRROI	T1,FAXFIL
	CALL	FAXSTR
	HRROI	T1,[ASCIZ ' ****
']
	CALL	FAXSTR
LKFAX0:	CALL	IPOFF		;KILL INTERUPTS
LKFAX1:	CALL	GETFAX		;GET A CHAR
	 JRST	FAXEOF		; EOF
	CAIN	T1,LF		;END OF LINE?
	 JRST	LKFAX2		; YES, SEND LINE, TOSS LF
	PUSH	P,T1		;SAVE IT
	CALL	ECHO		;ECHO IT
	POP	P,T1		;RESTORE THE CHAR
	CALL	LKPUT		;SEND IT
	JRST	LKFAX1		;LOOP

LKFAX2:	CALL	IPON		;BREATHE
	CALL	LKSEND		;SEND THE BUFFER
	CALL	$SIBE		;INPUT BUFFER EMPTY?
	 JRST	FAXCAN		; NO, CANCELED
	JRST	LKFAX0		;START AGAIN

FAXCAN:	HRROI	T1,[ASCIZ '
******************* FACSIMILE CANCELED *******************
']
	JRST	FAXDON

FAXEOF:	HRROI	T1,[ASCIZ '
******************* END OF FACSIMILE *******************
']

FAXDON:	CALL	FAXSTR
	CALL	IPON		;RESET IPCF INTERUPTS
	TLZ	FL,(F$FAX)	;CLEAR FAX MODE
	MOVE	T1,FAXJFN	;GET JFN
	CLOSF			;CLOSE IT
	 TRN			; SHHH
	JRST	LOOK		;START ANEW

; T1/	BP
FAXSTR:	CALL	CHKBT1		;CHECK FOR HRROI OR MOVEI
	MOVE	X1,T1		;SAVE BP
FXSTR1:	ILDB	T1,X1		;GET CHAR
	JUMPE	T1,LKSEND
	PUSH	P,T1		;SAVE THE CHAR
	CALL	ECHO
	POP	P,T1
	CALL	LKPUT
	JRST	FXSTR1

GETFAX:	MOVE	T1,FAXJFN	;GET FAXJFN
	BIN			;READ A CHAR (SLOWLY)
	 ERJMP	CPOPJ		; MUST BE END OF FILE!
	MOVE	T1,T2		;GET CHAR IN T1
	RETSKP			;HAPPY RETURN

	SUBTTL	LOOK -- User typed something
LKGET:	CALL	IPOFF		;KILL INTERUPTS
LKGET2:	PBIN			;GET CHARACTER
LKGOT:	CAIGE	T1," "		;PRINTABLE CHARACTER?
	 JRST	LKCTRL		; NO
	CAIN	T1,DEL		;RUBOUT?
	 JRST	LKDEL		; YES
	CAMN	T1,SWHOOK	;SWITCH-HOOK CHAR?
	 RET			; YES, RETURN
	PUSH	P,T1		;SAVE CHAR
	CALL	ECHO		;TYPE
	POP	P,T1		;RESTORE CHAR
	CALL	LKPUT		;AND STORE
LKGOT2:	CALL	$SIBE		;ANY MORE INPUT?
	 JRST	LKGET2		; YES
IFN SLPTIM,<
	MOVEI	T1,SLPTIM	;NO, SLEEP A LITTLE
	CALL	$HIBER		;ZZZ
	CALL	$SIBE		;ANY NOW?
	 JRST	LKGET2		;YES!
> ;IFN SLPTIM
	JRST	LOOK		;NO

	SUBTTL	LOOK -- Deposit a character to be sent
LKPUT:	TLO	FL,(F$TEXT)	;GOT SOME!!
	SOSGE	OURCNT		;KEEP COUNT
	 JRST [	PUSH  P,T1	;  SAVE CHAR
		CALL  LKSEND	;  SEND STUFF
		POP   P,T1	;  RESTORE
		JRST  LKPUT ]	;  TRY AGAIN
	IDPB	T1,OURPNT	;PUT IN BUFFER
	RET

	SUBTTL	LOOK -- Rubout was typed
LKDEL:	MOVE	T2,WNDCOL(W)	;GET COLM
	CAIG	T2,1		;NOT FIRST?
	 JRST	LKDINK		; IF TOO FAR, DINK THEM
	CALL	LKPUT		;SEND
	MOVEI	T1,DEL		;GET A NEW ONE
	CALL	ECHO		;TYPE IT
	JRST	LKGOT2

	SUBTTL	LOOK -- Ignore extra rubouts
LKDINK:	MOVEI	T1,1		;COLMN 1
	MOVEM	T1,WNDCOL(W)	;STORE
	MOVEI	T1,BEL
	CALL	PUTC		;DINK!
	JRST	LKGOT2		;CONTINUE

	SUBTTL	LOOK -- Some control character typed
; CONTROL-L SHOULD BE HANDLED HERE
LKCTRL:	CAIE	T1,CR		;CR?
	 IFSKP.
		PBIN		;YES, STEAL LF
		MOVEI	T1,CR	;GET A CR TO SEND
		JRST	LKCTR1	;DO STUFF
	 ENDIF.
	CAIE	T1,TAB
	 IFSKP.
		MOVE	X1,WNDCOL(W) ;GET COLM
		ADDI	X1,^D8	;ADD TAB
		TRZ	X1,7	;MODULO
		SUB	X1,WNDCOL(W) ;GET AMOUNT TO MOVE
		MOVEI	T1," "	;GET A SPACE
		DO.
			CALL	LKPECH
			SOJGE	X1,TOP.
		ENDDO.
		JRST	LOOK	;START ALL OVER
	 ENDIF.
	CAIN	T1,"W"-100	;^W ??
	 MOVEI	T1,LF		; SEND <LF> INSTEAD
; PERHAPS DUMP UNWANTED CHARACTERS HERE (IE; ^E ....)
LKCTR1:	CALL	LKPECH		;PUT AND ECHO
	JRST	LOOK

LKPECH:	PUSH	P,T1
	CALL	LKPUT
	POP	P,T1
	PJRST	ECHO
	ENDAV.			;{X1}
	SUBTTL	Position self

POSION:	ACVAR	<X1,X2>
	MOVE	X1,WNDLIN(W)	;GET LINE
	ADD	X1,WNDORG(W)	;ADD WINDOW ORIGIN
	SUBI	X1,1		;MAKE 1 BASED
	MOVE	X2,WNDCOL(W)	;AND COLM
	TTY	<MVX,X1,X2>	;MOVE, INDIRECT
	RET
	ENDAV.

	SUBTTL	PHONE ERROR MESSAGES

; T1/	PROTOCOL ERROR CODE
;	CALL	ERRPHN
;	<ALWAYS>

ERRPHN:	PUSH	P,T1		;SAVE CODE
	CALL	ERRLIN		;GOTO ERROR LINE
	POP	P,T2		;RESTORE CODE
	HRRO	T1,PHNTAB(T2)	;GET MESSAGE
	MOVEM	T1,LSTERR	;SAVE
	TRNE	T1,-1		;ANY MESSAGE?
	 PSOUT			; YES, TYPEIT

; MAKE CALL TO HERE AFTER DISPLAY OF ERROR
ENDERR:	TTY	<ERL>		;CLEAR REST OF LINE
	MOVE	T1,ERRPSE	;PAUSE INTERVAL
	CALL	$HIBER
	RET

	SUBTTL	GOTO ERROR LINE
ERRLIN:	TTY	<MOV,2,1>
	RET

	SUBTTL	GOTO PROMPT LINE
PMTLIN:	TTY	<MOV,3,1>
	RET

PHNTAB:	[ASCIZ '?Some error occured']
	[0]
	[ASCIZ '?User identification syntactically invalid']
	[ASCIZ '?Slave error']
	[ASCIZ '?Missing user name']
	[ASCIZ '?Slave is not privileged']
	[ASCIZ '?User does not exist']
	[ASCIZ '?User is not at a PHONE']
	[ASCIZ '?User has logged off']
	[ASCIZ "?User's PHONE is off the hook"]
	EXP	UNK,UNK,UNK

UNK:	ASCIZ	'?Illegal status code returned'
	SUBTTL	PARSE -- ROUTE STRING

;Take a route to a host, and fix so it looks like our route for it
;Assumes data of form {[_]NODE::}
; ie; converts	A::B::C::
; to		B::A::
;  C:: is dropped since it will be the target node of the link.
; T1/	BP to dest
; T2/	BP to source
REVRUT:	CALL	CHKBPS		;CONVERT -1,,N TO BP
	CALL	REVRU2
	 TRN
	SETZ	T3,
	IDPB	T3,T1
	RET

; Recursive helper
REVRU2:	STKVAR	<<BUF,5>>
	MOVEI	T4,BUF
	HRLI	T4,(POINT 7,)
	SETZM	BUF
	ILDB	T3,T2		;GET FIRST
	CAIN	T3,"_"		;VAX QUOTE CHAR?
REV.1:	 ILDB	T3,T2		; YES, GET NEXT CHAR
	JUMPE	T3,CPOPJ	;END OF STRING???
	CAIN	T3,":"		;END OF NODE?
	 JRST	REV.2
	IDPB	T3,T4
	JRST	REV.1
REV.2:	ILDB	T3,T2		;GET NEXT BYTE (SECOND COLON)
	SETZ	T3,
	IDPB	T3,T4		;TIE OFF BUFFER
	CALL	REVRU2		;PARSE NEXT NODE
	 RETSKP			; GOT EOS?
	SKIPN	BUF		;GOT A NODE?
	 RET			; NOPE.
	HRROI	T2,BUF		;GET PTR TO STRING
	CALL	CPYTXT		;COPY IN
	MOVEI	T2,":"
	IDPB	T2,T1
	IDPB	T2,T1
	RETSKP
	ENDAV.
	SUBTTL	PARSE -- USER ID STRING

;Parse user id string from another user
;Assumes data of form {[_]NODE::}[_]OURNODE::LUSER
; T1/	bp to user id
;	CALL	GETUSR
;	 <failed to parse>
;	<ok>
; T2/	BP to USER
; T3/	BP to last NODE::
; T4/	flag,,count
GETUSR:	CALL	CHKBT1		;CHECK BP IN T1
	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?
	  RET			;  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

GU.3:	TLNN	T4,1		;LAST FIELD HAVE AN "_" ?
	 CAMN	T2,T3		; NO, PARSE ANYTHING?
	  RET			;  NOTHING PARSED OR USER BEGAN WITH "_"
	TRNN	T4,-1		;EMPTY FIELD?
	 RET			; YES. (FOO::)
	RETSKP
	SUBTTL	LINKS -- MAKE A CONNECTION

;Make a connection on current link
; T1/	user id
; I/	link ptr
;	CALL	MAKCON
;	 <lose, error string in T1>
;	<win, type and 'JFN' set up>
MAKCON:	STKVAR	<<TARGET,10>,SAVCON,SAVUSR,SAVUNO>; BUFFER, DN.HST, BP, USRBP
	MOVEM	T1,SAVUSR	;SAVE USER
	CALL	GETUSR		;PARSE
	 JRST	MK.BD		; BAD
	MOVEM	T2,SAVUNO	;SAVE BP TO USER
	MOVE	T1,[POINT 7,TARGET] ;TARGET NODE
MK.L:	ILDB	T0,T3		;GET BYTE
	CAIN	T0,":"		;END OF NODE
	 JRST	MK.E		; YES
	IDPB	T0,T1		;COPY
	JUMPN	T0,MK.L		;LOOP UNTIL EOS
MK.BD:	HRROI	T1,[ASCIZ "Bad user string"]
	RET			;ERROR

MK.E:	SETZ	T0,		;NULL
	IDPB	T0,T1

IFN LOCALF,<
	HRROI	T1,TARGET	;GET BP
	HRROI	T2,OURNOD	;OUR NODE
	CALL	CMPSTR		;MAKE LOCAL CONNECTION?
	 JRST	MK.DCN		; NO

	MOVSI	T1,(RC%EMO)	;GET EXACT MATCH
	MOVE	T2,SAVUNO	;GET BP
	SETZ	T3,
	RCUSR			;GET OPERATOR USER NUMBER
	 ERJMP	MK.UNK		; UNKNOWN
	JUMPE	T3,MK.UNK	;DITTO
	MOVEM	T3,LNKUNO(I)	;SAVE USER NUMBER

	MOVEI	T1,LT$LCL	;LINK TYPE
	HRRM	T1,LNKFLG(I)	;STORE
	SETZM	LNKJFN(I)	;NO PID AS YET
	RETSKP

MK.UNK: HRROI	T1,[ASCIZ 'User does not exist']
	RET
> ;IFN LOCALF

MK.DCN:	MOVEI	T1,LT$DCN	;DECNET
	HRRM	T1,LNKFLG(I)	;STORE
	HRROI	T1,TARGET
	PJRST	OPNCON
	ENDAV.
	SUBTTL	LINKS -- OPEN A DECNET CONNECTION
; T1/	BP TO HOST
; I/	PTR TO LINK
;	CALL	OPNCON
;	 <ERROR, BP IN T1>
;	<AOK, LINK JFN AND ROUTE SET UP>
;
OPNCON:	STKVAR	<HOSTBP,SAVEBP>	;HOST BP, SAVED HOST
	MOVEM	T1,HOSTBP	;SAVE BP

; Here to create DECnet link.  Node is in TARGET.
OP.DCN:	MOVE	T1,CONBLK+DN.HST ;SAVE OLD HOST PTR
	MOVEM	T1,SAVEBP	;SAVE
	MOVE	T1,HOSTBP	;GET TARGET NODE
	MOVEM	T1,CONBLK+DN.HST ;STORE FOR DNCONN
	MOVEI	T1,CONBLK	;GET CONNECT BLOCK
	SETZ	T2,
	CALL	.DNCON##	;TRY TO CONNECT
	 JRST [	MOVE	T2,SAVEBP ;GET OLD HOST
		MOVEM	T2,CONBLK+DN.HST ;RESTORE
		RET ]		;RETURN ERROR (STRING IN T1)

	MOVEM	T1,LNKJFN(I)	;SAVE JFN
	HRROI	T1,LNKRUT(I)	;WHERE TO STORE RETURN ROUTE
	CAIN	T2,0		;GET A ROUTE?
	 SKIPA	T2,[-1,,[0]]	;GET BOGUS ROUTE
	  HRROI	T2,2(T2)	;GET BP TO ROUTE

	CALL	REVRUT		;STORE INVERSE ROUTE
	MOVE	T2,SAVEBP	;GET OLD HOST
	MOVEM	T2,CONBLK+DN.HST ;RESTORE CONNECT BLOCK
	RETSKP
	ENDSV.
	SUBTTL	LINKS -- MAKE A MESSAGE

; T1/	Message code
; T2/	BP to data or 0
; I/	Link
;	CALL	MAKMSG
MAKMSG:	ACVAR	<COD>		;SAVE CODE
	MOVEM	T1,LSTCOD	;STORE LAST CODE SENT
	MOVE	COD,T1		;SAVE LAST CODE
	PUSH	P,T2		;SAVE DATA
	HRRZ	T2,LNKFLG(I)	;GET LINK TYPE
	MOVE	T2,[POINT 8,LNKSND(I) ;BP FOR DECNET
		    POINT 8,SNDADR    ;BP FOR IPCF
		   ](T2)	;GET BP
	IDPB	COD,T2		;STORE CODE

	HRROI	T1,LNKRUT(I)	;GET ROUTE BACK TO US
	CALL	CPYSTR		;COPY IT IN
	HRROI	T1,US		;STRING FOR US
	CALL	CPYST0		;COPY IN
	POP	P,T1		;RESTORE DATA, IF ANY
	JUMPE	T1,CPOPJ	;NONE? DONE!
	CAIE	COD,MS$RNG	;RING MESSAGE?
	 PJRST	CPYSTR		; NO, BE SLOPPY
	CALL	CHKBT1		;MAKE SURE WE HAVE A BP
	ILDB	T1,T1		;GET JUST ONE BYTE
	IDPB	T1,T2		;STORE IS MESSAGE
	RET			;DONE!
	ENDAV.			;{COD}

	SUBTTL	LINKS -- SEND A MESSAGE, W/ STATUS

;Send a message
; T1/	Code
; T2/	BP to data
; I/	Link
;	CALL	SNDMSG
;	 <error>
;	<ok>
; T1/	Status
; T2/	BP to data
; T3/	Count
SNDMSG:	PUSH	P,T1		;SAVE CODE
	CALL	MAKMSG		;CREATE MESS
	PUSH	P,T2		;SAVE BP
	CALL	IPOFF		;PROTECT AGAINST PI
	POP	P,T2
	POP	P,T1		;RESTORE CODE
	HRRZ	T5,LNKFLG(I)	;GET LINK TYPE
	CALL @[	SM.DCN		;  DECNET CONNECTION
		SM.LCL ](T5)	;  LOCAL CONNECTION (IPCF)
	PUSH	P,T1		;SAVE STATUE
	PUSH	P,T2		;SAVE BP
	CALL	IPON
	POP	P,T2
	POP	P,T1
	CAIN	T1,ST$AOK	;OK?
	 RETSKP
	RET
	SUBTTL	LINKS -- SEND HANGUP AND CLOSE

;Send hangup and Close link
; no args
CLSHUP:	MOVEI	T1,MS$HUP	;HANG UP
	SETZ	T2,		;NO DATA

	SUBTTL	LINKS -- SEND ANY MESSAGE AND CLOSE
;Close link with final message
; T1/	CODE
; T2/	DATA
CLSMSG:	PUSH	P,T1		;SAVE MESS
	CALL	SNDMSG		;SEND FINAL MESSAGE
	 TRN
	POP	P,T1		;RESTORE MESS
	CAIN	T1,MS$DON	; DONE?
	 PJRST	CLSDON		;YES, SO ARE WE
	MOVEI	T1,MS$DON	;SEND DONE
	SETZ	T2,		;NO DATA
	CALL	SNDMSG		;SHOVE IT OFF
	 TRN			; IGNORE
	TRNA
SNDERR:	 CALL	ERRPHN		;NO, TYPE ERROR
CLSDON:	HRRZ	T1,LNKFLG(I)	;GET LINK TYPE
	CAIE	T1,LT$DCN	;DECNET LINK?
	 JRST	CLS.1		; NO, JUST FREE THE BLOCK
	MOVE	T1,LNKJFN(I)	;GET LINK JFN
	TLO	T1,(CZ%ABT)	;ABORT LINK
	CLOSF
	 ERJMP	.+1

CLS.1:	SETZM	LNKJFN(I)	;CLEAR JFN / PID
	MOVE	T1,I
	PJRST	FRELNK
	SUBTTL	LINKS -- CREATE NEW LINK BLOCK

;Create a new Link block
; T1/	BP to user
;	CALL	NEWLNK
NEWLNK:	PUSH	P,T1		;SAVE USER
	CALL	GETLNK

	HRROI	T2,LNKUSR(T1)	;GET ADDR FOR USER
	EXCH	T1,(P)		;GET USER NAME
	CAIE	T1,0		;NULL?
	CALL	CPYST0		; NO, COPY IN
	POP	P,T1		;RESTORE LINK

	SETOM	LNKHLD(T1)	;CLEAR HOLD LEVEL
	RET

	SUBTTL	LINKS -- CREATE A NEW LINK AND CONNECT IT

;Create new link & connect to it
; T1/	BP to user
;	CALL	MAKLNK
;	 <nope>
;	<yep>
; T1/	^LINK
MAKLNK:	STKVAR	<USR,LNK>
	MOVEM	T1,USR		;SAVE USER NAME
	MOVEM	I,LNK		;SAVE CURRENT LINK
	CALL	NEWLNK		;MAKE LINK
	MOVE	I,T1		;GET NEW LINK
	MOVE	T1,USR		;GET USER
	CALL	MAKCON		;MAKE CONNECTION
	 JRST	MKL.ER		; SIGH
	MOVEI	T1,MS$CHK	;CHECK USER
	MOVE	T2,USR		;GET USER
	CALL	SNDMSG		;SEND IT OFF
	 JRST [	HRRO T1,PHNTAB(T1) ;GET ERROR
		JRST MKL.ER ]
	AOS	(P)		;HAPPY RETURN
	MOVE	T1,I		;RETURN LINK
	TRNA
MKL.ER:	 MOVEM	T1,LSTERR	;SAVE ERROR BP
	MOVE	I,LNK		;RESTORE LINK
	RET
	ENDSV.
	SUBTTL	LINKS -- SAVE A LINK IN LINK TABLE

; T1/	LINK
SAVLNK:	MOVSI	T2,-MAXLNK	;SEARCH ALL LINKS
SV.LP1:	SKIPE	T3,LNKTAB(T2)	;EMPTY?
	 CAME	T1,T3		; ALREADY EXISTS?
	  AOBJN	T2,SV.LP1	;KEEP LOOKING
	JUMPL	T2,SV.SKP	;FOUND!

	MOVSI	T2,-MAXLNK	;SEARCH ALL LINKS
SV.LOP:	SKIPE	LNKTAB(T2)	;EMPTY?
	 AOBJN	T2,SV.LOP	; NO
	JUMPGE	T2,CPOPJ	;NO FREE SLOTS
	MOVEM	T1,LNKTAB(T2)	;STORE
SV.SKP:	RETSKP

	SUBTTL	LINKS -- SEARCH FOR A USER

; T1/	user
FNDLNK:	ACVAR	<X1,X2>
	MOVE	X2,T1		;SAVE USER
	MOVSI	X1,-MAXLNK	;FOR ALL LINKS
FL.LOP:	SKIPN	T1,LNKTAB(X1)	;GET LINK, IF ANY
	 JRST	FL.BOT		; NONE
	HRROI	T1,LNKUSR(T1)	;GET USER
	MOVE	T2,X2		;GET TARGET
	CALL	CMPSTR		;NO, COMPARE
	 TRNA			; NO MATCH
	  JRST	FL.WIN		;  A WINNER!
FL.BOT:	AOBJN	X1,FL.LOP	;NO, GUESS AGAIN
	RET			;YOU LOSE
FL.WIN:	MOVE	T1,LNKTAB(X1)	;RETURN LINK
	RETSKP
	ENDAV.
	SUBTTL	DECNET -- COUNT AND SEND MESSAGE

;Output text in LNKSND(I) to DECnet
; T2/	updated BP
; I/	link index
;	CALL	DECOUT

DECOUT:	MOVEI	T1,@T2		;GET THE ADDRESS PART OF NEW BP
	SUBI	T1,LNKSND(I)	;GET THE DIFFERENCE
	ASH	T1,2		;MAKE IT INTO 8 BIT BYTE COUNT
	MOVE	T4,T2		;PRESERVE THE BYTE POINTER

	LDB	T2,[POINT 6,T4,6+5] ;GET S FIELD OF BYTE POINTER
	CAIE	T2,^D8		;IS IT EIGHT BITS?
	 FATAL	(BP not 8 bit)	; YOU LOSE

	LDB	T2,[POINT 6,T4,5] ;GET P FIELD OF BYTE POINTER
	SUBI	T2,4		;P STARTS AT THE RIGHT
	ASH	T2,-3		;DIVIDE BY EIGHT
	SUBI	T2,4		;REVERSE THE ORDER
	SUB	T1,T2		;FIGURE OUT THE FINAL COUNT
	MOVNI	T3,(T1)		;PREPARE FOR SOUT

	SUBTTL	DECNET -- SEND COUNTED MESSAGE

;Send counted text in LNKSND(I) via DECnet
; T3/	-count
; I/	link ptr
DECCNT:	SKIPN	T1,LNKJFN(I)	;DECNET JFN
	 RET			; IGNORE IF NO JFN
	MOVE	T2,[POINT 8,LNKSND(I)] ;SEND BUFFER
	SOUTR			;OUTPUT RECORD
	 ERJMP	.+1
	RET
	SUBTTL	DECNET -- GET TEXT WITH TIMEOUT

;Get text from DECnet
; I/	link
;	CALL	DECIN
; T1/	Status Code
; T2/	BP to data
; T3/	Byte count

WAIT4==^D10			;THIS MANY SECONDS TOTAL
WAITIN==^D100			;IN THIS INCREMENT (IN MS.)

DECIN:	MOVE	T1,LSTCOD	;GET LAST CODE FROM MAKMSG
	CAIE	T1,MS$CHK	;CHECK?
	 CAIN	T1,MS$RNG	; OR RING?
	  TRNA			;  OK
	   RET			;   HUH????
	CALL	$UPTIME		;GET UPTIME IN MS
	MOVE	T4,T1		;COPY
	ADDI	T4,WAIT4*^D1000	;WAIT TILL THEN
DECINC:	SKIPG	T1,LNKJFN(I)	;GET NET JFN
	 JRST	DECIER		; NONE!
	SIBE			;ANY DATA (0 LENGTH RECORD NEVER SEEN!!!)
	 JRST	DECINW		; YES, GOT IT!!
	CALL	$UPTIME		;GET SYSTEM UPTIME
	CAML	T1,T4		;TIME RUN OUT?
	 JRST	DECIER		; YES, TIMEOUT
	MOVEI	T1,WAITIN
	CALL	$HIBER
	JRST	DECINC		;LOOK AGAIN

	SUBTTL	DECNET -- GET MESSAGE W/O TIMEOUT

DECINW:	SKIPG	T1,LNKJFN(I)	;GET NET JFN
	 JRST	DECIER		; NONE!!!
	MOVE	T2,[POINT 8,LNKRCV(I)] ;PUT IN RECIEVE BUFFER
	MOVNI	T3,BUFSIZ	;COUNT
	SINR			;READ A RECORD
	 ERJMP	DECIER		; I/O ERROR
	  JRST	DECIOK

DECIER:	SETZM	LNKRCV(I)	;CLEAR BUFFER
	MOVEI	T1,ST$AOK	;ASSUME OK
	MOVEI	T2,LNKRCV(I)	;GET ADDR
	HRLI	T2,(POINT 8,)	;MAKE INTO BP
	SETZ	T3,		;PRETEND WE READ NADA
	RET

DECIOK:	SETZ	T1,		;GET NULL
	IDPB	T1,T2		;TIE OFF STRING
	MOVEI	T2,LNKRCV(I)	;GET ADDR
	HRLI	T2,(POINT 8,)	;MAKE INTO BP
	ADDI	T3,BUFSIZ	;GET COUNT
	MOVEI	T1,ST$OTH	;OTHER ERROR
	JUMPE	T3,CPOPJ	;RETURN ERROR STATUS
	LDB	T1,[POINT 8,LNKRCV(I),7] ;GET STATUS
	RET
	SUBTTL	DECNET -- SEND A MESSAGE, W/ STATUS

; SEND MESSAGE OVER DECNET
; T1/	MESSAGE CODE
SM.DCN:	PUSH	P,T1		;SAVE CODE
	CALL	DECOUT		;SEND
	POP	P,T1		;RESTORE CODE
	CAIE	T1,MS$CHK	;CHECK USER?
	 CAIN	T1,MS$RNG	; OR RING?
	  PJRST	DECIN		;GET STATUS W/ TIMEOUT???
	MOVEI	T1,ST$AOK	;ELSE RETURN FINE
	RET

	SUBTTL	LOCAL -- SEND A MESSAGE, W/ STATUS

; SEND MESSAGE (AT SNDADR) VIA IPCF
SM.LCL:	LDB	T1,[POINT 8,SNDADR,7] ;GET CODE
	SKIPN	T1,LCLTAB(T1)	;GET ROUTINE
	 PJRST	RETAOK		; RETURN AOK!
	PJRST	(T1)		;HANDLE LOCAL MESSAGE

LCLTAB:	PHASE	0		;*** FUNCTION DISPATCH ***
	ACTION	MS$CHK,LCHECK	;Check out user
	ACTION	MS$RNG,LRING	;Ring phone
	ACTION	MS$HUP,FORWRD	;Remote has hung up
	ACTION	MS$BSY,FORWRD	;Master is busy
	ACTION	MS$ANS,FORWRD	;Phone answered
	ACTION	MS$REJ,FORWRD	;Call rejected
	ACTION	MS$TXT,FORWRD	;Conversation text
	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

; HERE TO SEND DATA IN SNDPAG
FORWRD:	SKIPE	T1,LNKJFN(I)	;GET PID
	 CALL	SIPCF		; SEND IPCF PAGE
RETOTH:	  TDZA	T1,T1		;  "SOME OTHER ERROR"
RETAOK:	   MOVEI T1,ST$AOK	;   "ALL OK"
	RET
	SUBTTL	LOCAL -- CHECK FOR USER

; I/	^LINK W/ USER# FILLED IN
LCHECK:	ACVAR	<X1,X2>		;LOOP VAR, ERROR REASON, IF ANY
	SKIPN	LNKUNO(I)	;CHECK FOR USER NUMBER
	 JRST	RETOTH		; SHOULD NEVER HAPPEN
	MOVE	X1,JOBAOB	;GET JOB AOBJN
	MOVEI	X2,ST$UNE	;DEFAULT REASON: USER DOES NOT EXIST
LCH.1:	MOVEI	T1,(X1)		;GET JOB
	MOVE	T2,[-2,,T4]	;RETURN IN T4, T5
	MOVEI	T3,.JITNO	;RETURN TTY, USER NUMBER
	GETJI			;GET JOB INFO
	 JRST	LCH.B		; NO JOB
	JUMPL	T4,LCH.B	;DETACHED?
	CAME	T5,LNKUNO(I)	;RIGHT STUFF?
	 JRST	LCH.B		; NOPE
	MOVEI	T1,.TTDES(T4)	;GET TTY DESC
	GTTYP			;GET TTY TYPE
	 IFJER.
		MOVEI	X2,ST$SNP ;SLAVE LACKS PRIVS
		JRST	LCH.B	;LOOP
	 ENDIF.
	SKIPE	VTXDSP(T2)	;CHECK IF GOOD TTY TYPE
	 IFSKP.
		MOVEI	X2,ST$TTY ;LOSING TTY TYPE
		JRST	LCH.B	;LOOP
	 ENDIF.
	MOVEI	T1,.TTDES(T4)	;GET TTY DESC
	CALL	CHKLNK		;CHECK IF OFF THE HOOK
	 SKIPA	X2,[ST$OFF]	; YES
	  JRST	LCH.U		;  NO!! WE HAVE A WINNER!
LCH.B:	AOBJN	X1,LCH.1	;LOOP
	MOVE	T1,X2		;GET REASON
	RET			;AND FAIL

; THERE EXISTS AT LEAST ONE GOOD JOB: DOES ONE HAVE THE PID?
LCH.U:	CALL	FNDUNO		;FIND PID
	 TRNA
	  MOVEM	T1,LNKJFN(I)	;FOUND! - SAVE IT (WHAT ABOUT OLD VALUE?)
	MOVEI	T1,ST$AOK
	RET
	ENDAV.
	SUBTTL	LOCAL -- RING

; I/	^LINK
; AREA IS NON-ZERO ON FIRST RING
LRING:	CALL	FNDUNO		;CHECK FOR A PID
	 JRST	RG.MES		; NONE, JUST SEND VIA TTMSG
	PUSH	P,T1		;SAVE NEW PID

	CALL	CHKPID		;FIND OWNER
	 SETO	T1,		; LOSER
	MOVEM	T1,LNKJOB(I)	;SAVE, TO AVOID DOING LOCAL SENDS TO OWNER

	POP	P,T1		;RESTORE PID
	CAMN	T1,LNKJFN(I)	;SAME PID AS LAST TIME?
	 JRST	RG.FWD		; YES, JUST FORWARD

;Here with a new PID
	MOVEM	T1,LNKJFN(I)	;NO, SAVE NEW PID
	SKIPN	T1,AREA		;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
	MOVSI	T1,(<BYTE(7)1>)	;FIRST RING FLAG
	MOVEM	T1,AREA		;STORE

;Here to send an IPCF ring
RG.FWD:	CAIE	T1,0		;WAS THIS RING THE FIRST?
	 CALL	LCLRNG		; YES, DO LOCAL RING FIRST
	  TRN			;  NO+IGNORE ERROR
	MOVEI	T1,MS$RNG	;RING
	HRROI	T2,AREA		;NEW DATA
	CALL	MAKMSG		;CREATE MESS
	CALL	FORWRD		;SEND!
	 TRN
	RET

RG.MES:	CALL	LCLRNG		;DO LOCAL RING
	 TRN
	RET
	SUBTTL	LOCAL -- SEND RING TEXT

;Creates message text in TMPSTR buffer and send to all suitable users
;	CALL	LCLRNG
;	 <LOSS>
;	<AOK>
; T1/	STATUS
LCLRNG:	ACVAR	<X1,X2,X3>
	HRROI	T1,TMPSTR	;POINT TO BUFFER
	HRROI	T2,[BYTE(7)CR,LF,0]
	CALL	CPYTXT
	HRROI	T2,OURNAM	;OUR NAME
	CALL	CPYTXT
	MOVEI	T2,[ASCIZ/ is calling you at /]
	CALL	CPYTXT
	TLNN	FL,(F$DECN)	;HAVE NETWORK?
	 IFSKP.
		MOVEI	T2,OURNOD	;NODE NAME
		CALL	CPYTXT
		MOVEI	T2,[ASCIZ/ on /]
		CALL	CPYTXT
	 ENDIF.
	SETOB	T2,T3		;NOW, FANCY
	ODTIM			;OUTPUT
	 ERJMP	.+1		; FUEY!
	MOVEI	T2,[BYTE(7) BEL,BEL,BEL,CR,LF,0] ;DING**3, CRLF
	CALL	CPYTXT

;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,LNKUNO(I)	;GET USER NUMBER
	CAME	T2,GJIBLK+.JIUNO ;MATCH
	 JRST	LR.BOT		; NO, KEEP LOOKIN

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

	MOVE	T2,LNKJOB(I)	;GET JOB
	CAIN	T2,(X1)		;MATCH?
	 SKIPE	AREA		; FIRST RING?
	  TRNA			;  NO MATCH, OR FIRST RING
	   JRST	LR.BOT		;   MATCH, NOT FIRST RING, DON'T SEND

	MOVE	T1,GJIBLK+.JITNO ;GET TTY AGAIN
	MOVEI	T1,.TTDES(T1)	;MAKE DEVICE
	HRROI	T2,TMPSTR	;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
	MOVEI	T1,ST$AOK	;GET GOOD STS
	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.
	SUBTTL	LOCAL -- DIRECTORY

LDIR:	SETZ	T5,		;COLM
	MOVE	T4,[440700,,TMPSTR]
	AOS	T1,JOBNUM	;GET NEXT JOB NUMBER
	CAILE	T1,MAXJOB	;IN RANGE?
	 JRST [	SETZ	T3,	; ZERO LENGTH
		RET ]		;RETURN
	MOVE	T2,[-.JIBAT-1,,GJIBLK] ;WHAT TO STORE WHERE
	SETZ	T3,		;START AT BEGINING
	GETJI			;GET JOB INFO
	 JRST	LDIR		;NO JOB, GET NEXT
	SKIPE	T1,GJIBLK+.JIUNO ;LOGGED IN?
	 CAMN	T1,OPRUNO	; SKIP <OPERATOR>
	  JRST	LDIR		;  GET ANOTHER
	SKIPN	GJIBLK+.JIBAT	;BATCH?
	 SKIPGE	GJIBLK+.JITNO	; ATTACHED?
	  JRST	LDIR		;  RE-JECT

	MOVE	T2,GJIBLK+.JIPNM ;PROGRAM NAME?
	CALL	SIXTYP		;TYPE "PROCESS NAME"
	MOVEI	T1,"I"-100	;TAB
	CALL	COLTYP		;OUTPUT
	CALL	COLTYP		;AGAIN
	HRROI	T1,TEMP2	;BP
	MOVE	T2,GJIBLK+.JIUNO ;GET USER NUMBER AGAIN
	DIRST			;CONVERT TO STRING
	 ERJMP	LDIR		;SIGH!
	SETZ	T2,		;GET A NULL
	IDPB	T2,T1		;TIE OFF STRING
	MOVEI	T2,TEMP2	;GET NAME
	CALL	STRTYP		;OUTPUT IT
	MOVEI	T1," "		;TERMINATE WITH A SPACE
	CALL	COLTYP		;TA DAH
	MOVEI	T1,"I"-100	;GET A TAB
PADLOP:	CAIGE	T5,^D32		;THERE YET?
	 JRST [ CALL	COLTYP	;PAD WITH TABS
		JRST	PADLOP ] ;CONTINUE

	MOVE	T2,GJIBLK+.JITNO ;GET TERMINAL NUMBER
	MOVEI	T1,.TTDES(T2)	;GET DEVICE DESC
	GTTYP			;GET TYPE
	 ERJMP	UNUSE		; SIGH
	SKIPN	VTXDSP(T2)	;KNOWN?
UNUSE:	 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	STRTYP		;WRITE PREFIX
	MOVE	T2,GJIBLK+.JITNO ;GET TTY NUMBER
;;;	CAML	T2,PTYPAR	;A PTY?
;;;	 SUB	T2,PTYPAR	; YES, REMOVE OFFSET
	CALL	OCTTYP		;OUTPUT NUMBER
	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	STRTYP
DIRR3:	SETZ	T1,
	CALL	COLTYP
	MOVE	T2,[POINT 7,TMPSTR]
	MOVEI	T3,^D69		;RETURN W/ LENGTH
	RET

; T2/	ADDR OF ASCIZ STRING
STRTYP:	HRLI	T2,(POINT 7,)
STRTY2:	ILDB	T1,T2
	JUMPE	T1,CPOPJ
	CALL	COLTYP
	JRST	STRTY2

; T2/	SIXBIT
SIXTYP:	MOVEI	T3,6
SIXTY2:	SETZ	T1,
	LSHC	T1,6
	ADDI	T1," "
	CALL	COLTYP
	SOJG	T3,SIXTY2
	RET

; T2/	OCTAL
OCTTYP:	IDIVI	T2,10
	HRLM	T3,(P)
	CAIE	T2,0
	 CALL	OCTTYP
	HLRZ	T1,(P)
	ADDI	T1,"0"
COLTYP:	IDPB	T1,T4
	CAIE	T1,"I"-100
	 AOJA	T5,COLRET
	ADDI	T5,^D8
	TRZ	T5,^D8-1
COLRET:	RET

; CHECK IF TTY OFF THE HOOK
; T1/	TTY DES
;	CALL	CHKLNK
;	 <OFF THE HOOK>
;	<IN A SOCIABLE MOOD>
CHKLNK:	MOVEI	T2,.MORTF	;NEW FANGLED TERMINAL BITS
	MTOPR			;READ THEM
	 ERJMP	CHKLN2		; OLD MONITOR?
	TRNE	T3,MO%NUM+MO%NTM ;USER MESS/NON-JOB OUTPUT SUPRESS?
	 RET			; YES, THATS FINAL
	JRST	CPOPJ1		;** NO, IGNORE LINKS BIT

CHKLN2:	RFMOD			;GET TERMINAL JFN MODE WORD
	 ERJMP	CPOPJ		;WHOOPS!
	TRNE	T2,TT%ALK	;ALLOW LINKS ?
	 AOS	(P)		;YES.
	RET			;NO.
	SUBTTL	WINDOWS -- ECHO

;Add a character to a window in talk mode
; T1/	char
; W/	^window
;	CALL	ECHO
ECHO:	JUMPE	T1,CPOPJ	;IGNORE NULL
	CAIGE	T1," "		;PRINTABLE?
	 JRST	EC.CTL		; NO
	CAIN	T1,DEL		;RUBOUT?
	 JRST	EC.DEL		; YES
	CALL	PUTC		;NO, TYPE IT
	IDPB	T1,WNDLBP(W)	;STORE IN LINE BUF
	AOS	T2,WNDCOL(W)	;INCR COLMN (WHAT ABOUT EDGE?)
	CAIG	T2,^D75		;BEYOND COLM 75 ****** MAGIC NUMBER ******
	 RET			; NO, DONE
	MOVEI	T1,CR		;GET A <CR>
	JRST	ECHO		;SEND IT!

;Rubout
EC.DEL:	SETZ	T1,		;RETURN NULL
	MOVEI	T2,1
	SOSG	T3,WNDCOL(W)	;DECREMENT
	 MOVEM	T2,WNDCOL(W)	; TOO FAR?
	JUMPLE	T3,CPOPJ	;YEP.

	OUTSTR	[BYTE (7)BS," ",BS] ;ERASE

	LDB	T1,WNDLBP(W)	;GET CHAR DELETED
	SETO	T2,		;GET MINUS 1
	ADJBP	T2,WNDLBP(W)	;BACKUP LINE BP
	MOVEM	T2,WNDLBP(W)	;STORE
	RET			;DONE

;Got control character
EC.CTL:	CAIN	T1,"U"-100	;CONTROL-U?
	 JRST	EC.CTU		; YES.
	CAIN	T1,CR		;CR?
	 JRST	EC.CR		; YES
	CAIN	T1,LF		;LF?
	 JRST	EC.LF		; YES
	CAIN	T1,BEL
	 JRST	EC.BEL
	RET			;LOSER
EC.BEL:	CALL	PUTC		;HERE FOR BELL
	RET

EC.CTU:	MOVEI	T1,1		;CONTROL-U
	MOVEM	T1,WNDCOL(W)	;GO TO START OF LINE
	MOVEI	T1,CR		;GET A CR
	CALL	PUTC		;GO TO START OF LINE
	TTY	<ERL>		;CLEAR TO EOL
EC.RES:	MOVEI	T1,WNDLBF(W)	;GET BUFFER ADDR
	HRLI	T1,(POINT 7,)	;MAKE INTO BP
	MOVEM	T1,WNDLBP(W)	;RESET LINE BUFFER PTR
	RET			;DONE

EC.CR:	CALL	EC.RES		;RESET LINE BUF
	MOVEI	T1,1		;START OF LINE
	MOVEM	T1,WNDCOL(W)	;STORE
	AOS	T1,WNDLIN(W)	;STEP TO NEXT LINE
	CAMLE	T1,WNDSIZ(W)	;STILL IN RANGE?
	 JRST [	MOVEI	T1,TXTLIN ; NO, GET TOP OF TEXT
		MOVEM	T1,WNDLIN(W) ;STORE
		CALL	POSION	;FORCE POSITION
		JRST	EC.CR2 ] ;JOIN THE REST OF HUMANITY
	CALL	CRLF
EC.CR2:	TTY	<ERL>		;ERASE TO END OF NEW TEXT LINE
	MOVE	T1,WNDLIN(W)	;GET LINE AGAIN
	CAME	T1,WNDSIZ(W)	;BOTTOM?
	 JRST [	CALL	CRLF
		TTY	<ERL>	;CLEAR IT
		PJRST	POSION ] ;GOTO RIGHT POSN
	MOVE	T1,WNDORG(W)	;GET WINDOW ORIGIN
	ADDI	T1,2		;GET TOP LINE
	MOVEI	T2,1		;FIRST COLM
	TTY	<MVX,T1,T2>	;GO THERE
	TTY	<ERL>		;CLEAR IT
	PJRST	POSION		;RESTORE CURSOR

; HERE TO KILL A WORD
EC.LF:	LDB	T1,WNDLBP(W)	;GET LAST BYTE
	CAIE	T1," "		;SPACE?
	 JRST	EC.LF1		; NO, GOTO STATE 1
	CALL	EC.DEL		;KILL
	JUMPN	T1,EC.LF	;REPEAT
	RET

EC.LF1:	LDB	T1,WNDLBP(W)	;GET LAST BYTE
	CAIN	T1," "
	 RET			;  DONE!
	CALL	EC.DEL
	JUMPN	T1,EC.LF1
	RET
	SUBTTL	WINDOWS -- FIND A USER

; Find an active (ie; has a window) user.
; T1/	BP to user
;	CALL	FNDUSR
;	 <LOSS>
;	<WIN>
; T1/	^LINK
FNDUSR:	ACVAR	<X1,X2>
	MOVE	X2,T1		;SAVE USER
	MOVN	X1,NUMUSR	;GET NEG USR COUNT
	HRLZ	X1,X1		;GET -N,,0
FU.LOP:	MOVE	T1,WNDTAB(X1)	;GET WINDOW
	MOVE	T1,WNDLNK(T1)	;GET LINK
	HRROI	T1,LNKUSR(T1)	;GET USER
	MOVE	T2,X2		;GET TARGET
	CALL	CMPSTR		;NO, COMPARE
	 TRNA			; NO MATCH
	  JRST	FU.WIN		;  A WINNER!
	AOBJN	X1,FU.LOP	;NO, GUESS AGAIN
	RET			;YOU LOSE
FU.WIN:	MOVE	T1,WNDTAB(X1)	;GET LINK
	PJRST	CPOPJ1		;RETURN HAPPY
	ENDAV.
	SUBTTL	WINDOWS -- ADD A NEW USER
;Put a new user on the screen
; T1/	link
NEWUSR:	STKVAR	<LINK>
	MOVEM	T1,LINK		;SAVE LINK
	MOVE	T1,SCRSIZ	;GET SCREEN SIZE
	SUBI	T1,2		;MINUS TOP LINES
	MOVE	T2,NUMUSR	;GET CURRENT USERS
	IDIVI	T1,2(T2)	;SPLIT AMONG USERS + (US + NEW)
	CAIGE	T1,5		;AT LEAST FIVE LINES?
	 RET			; NOPE.

	MOVE	T1,LINK		;GET LINK
	CALL	SAVLNK		;STORE LINK
	 RET			;FAIL IF NOT

	CALL	GETWND		;ALLOCATE A WINDOW BLOCK
	MOVEI	T2,TXTLIN	;TOP LINE
	MOVEM	T2,WNDLIN(T1)	;STORE
	MOVEI	T2,1		;FIRST COL
	MOVEM	T2,WNDCOL(T1)	;STORE POSN

	MOVEI	T2,WNDLBF(T1)	;GET LINE BUFFER ADDR
	HRLI	T2,(POINT 7,)	;MAKE BP
	MOVEM	T2,WNDLBP(T1)	;STORE

	AOS	T3,NUMUSR	;GET NEW USER COUNT
	MOVEM	T1,WNDTAB-1(T3)	;SAVE IN SLOT
	MOVE	T2,LINK		;GET LINK
	MOVEM	T2,WNDLNK(T1)	;SAVE LINK
	PJRST	REFRSH
	ENDSV.
	SUBTTL	WINDOWS -- REDIVIDE
;No Args
;AC Usage
; T1/	size
; T2/	remainder
; T3/	scratch
; T4/	curr window
; T5/	prev window
REFRSH:	ACVAR	<X1>		;LOOP VAR
	MOVE	T1,SCRSIZ	;GET SCREEN SIZE
	SUBI	T1,2		;MINUS TOP LINES
	MOVE	T2,NUMUSR	;GET CURRENT USERS
	MOVNI	X1,(T2)		;GET NEG USR COUNT
	HRLZ	X1,X1		;GET -N,,0
	IDIVI	T1,1(T2)	;SPLIT AMONG USERS + US
	CAIGE	T1,5		;AT LEAST FIVE LINES?
	 RET			; NOPE.
	MOVEI	T4,WNDBLK	;GET OUR WINDOW
	MOVEI	T3,3		;ORIGIN
	MOVEM	T3,WNDORG(T4)	;FOR US
	MOVEM	T1,WNDSIZ(T4)	;GIVE US SMALLEST
RF.LOP:	MOVE	T5,T4		;SET PREV WINDOW
	MOVE	T4,WNDTAB(X1)	;GET CURR WINDOW
	MOVE	T3,WNDORG(T5)	;GET PREV ORIGIN
	ADD	T3,WNDSIZ(T5)	;ADD PREV SIZE
	MOVEM	T3,WNDORG(T4)	;STORE OUR ORIGIN
	MOVEI	T3,(T1)		;GET STD SIZE
	SOSL	T2		;ANY REMAINDER LEFT?
	 ADDI	T3,1		; YES, GIVE ONE TO US
	MOVEM	T3,WNDSIZ(T4)	;STORE OUR SIZE
	AOBJN	X1,RF.LOP	;LOOP
	TLO	FL,(F$REF)	;NEED REFRESH
	PJRST	CPOPJ1
	ENDAV.
	SUBTTL	WINDOWS -- REMOVE A USER

;Remove a user from screen
; I/	link
KILUSR:	SKIPL	LNKHLD(I)	;ON HOLD?
	 RET			; YES, NOT ON SCREEN
	MOVN	T2,NUMUSR
	MOVSI	T2,(T2)		;GET -N,,0
	JUMPE	T2,CPOPJ	;NO USERS!!
KU.LOP:	MOVE	T1,WNDTAB(T2)	;GET WINDOW
	CAME	I,WNDLNK(T1)	;THE RIGHT LINK?
	 AOBJN	T2,KU.LOP	; NO, LOOP
	JUMPGE	T2,CPOPJ	;NOT FOUND, RETURN
	PUSH	P,T2		;SAVE INDEX
	CALL	FREWND		;FREE WINDOW BLOCK
	POP	P,T2		;RESTORE LOOP INDEX
	JRST	KU.BOT		;MOVE UP THE REST
KU.MOV:	MOVE	T1,WNDTAB(T2)	;GET CURRENT
	MOVEM	T1,WNDTAB-1(T2)	;MOVE BACKWARDS
KU.BOT:	AOBJN	T2,KU.MOV	;LOOP
	SOS	NUMUSR		;ONE LITTLE INDIAN....
	TLO	FL,(F$REF)	;NEEDS REFRESH!!
	RET

	SUBTTL	WINDOWS -- SEND TO ALL
;Send to all active windows
; T1/	code
; T2/	data
SNDALL:	ACVAR	<X1,<X2,2>>
	DMOVE	X2,T1		;SAVE CODE & DATA
	MOVN	X1,NUMUSR	;GET USER COUNT
	HRLZ	X1,X1		;AS -N,,0
	PUSH	P,I		;SAVE LINK
SA.LOP:	MOVE	T1,WNDTAB(X1)	;GET WINDOW
	MOVE	I,WNDLNK(T1)	;GET LINK
	DMOVE	T1,X2		;GET CODE & DATA
	MOVE	T3,LNKFLG(I)	;GET LINK FLAGS
	TLNN	T3,(L$HELD)	;HOLDING US?
	 CALL	SNDMSG		; NO, SEND
	  TRN			;  IGNORE ERRORS
	AOBJN	X1,SA.LOP	;LOOP FOR ALL WINDOWS
	PJRST	POPIJ
	ENDAV.
	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,
	SUBTTL	CORE ALLOCATOR

GETWND:	MOVEI	T2,WNDLEN	;HERE TO ALLOCATE A FRESH WINDOW
	SKIPN	T1,WNDLST	;ANY HANGING OUT?
	 PJRST	GETWDS		; NOPE ALLOCATE ONE
	MOVE	T2,(T1)		;GET NEXT ON LIST
	MOVEM	T2,WNDLST	;SAVE
	MOVEI	T2,WNDLEN
	PJRST	ZERWDS

GETLNK:	MOVEI	T2,LNKLEN	;HERE TO ALLOCATE A FRESH WINDOW
	SKIPN	T1,LNKLST	;ANY HANGING OUT?
	 PJRST	GETWDS		; NOPE ALLOCATE ONE
	MOVE	T2,(T1)		;GET NEXT ON LIST
	MOVEM	T2,LNKLST	;SAVE
	MOVEI	T2,LNKLEN
	PJRST	ZERWDS

; T2/	COUNT
GETWDS:	MOVE	T1,T2		;COPY LENGTH
	ADD	T1,.JBFF	;GET NEW END OF CORE
	CAILE	T1,ENDCOR	;GONE TOO FAR?
	 FATAL	(Out of memory)	; I DON'T KNOW HOW YOU DID IT!
	EXCH	T1,.JBFF	;GET START OF BLOCK
ZERWDS:	ADDI	T2,-1(T1)	;GET LAST WORD
	MOVSI	T3,(T1)		;GET START,,0
	HRRI	T3,1(T1)	;GET START,,START+1
	SETZM	(T1)		;START THE BALL ROLLING
	BLT	T2,(T2)		;SMEAR!
	RET

FREWND:	PUSH	P,T1
	CALL	IPOFF
	POP	P,T1
	MOVE	T2,WNDLST	;GET WINDOW LIST
	MOVEM	T2,(T1)		;STORE IN FIRST WORD OF NEW BLOCK
	MOVEM	T1,WNDLST	;SAVE AS FREE LIST
	PJRST	IPON			;DONE

FRELNK:	PUSH	P,T1
	CALL	IPOFF
	POP	P,T1
	MOVE	T2,LNKLST	;GET LINK LIST
	MOVEM	T2,(T1)		;SAVE IN FIRST WORD OF NEW BLOCK
	MOVEM	T1,LNKLST	;STORE AS FREE LIST
	PJRST	IPON
	SUBTTL	LUUO HANDLR

LUUOH:	MOVEM	16,UUOACS+16	;SAVE AC16
	MOVEI	16,UUOACS	;COPY FROM ACS TO SAVE AREA
	BLT	16,UUOACS+15	;SAVE AC0..15
	LDB	T1,[POINT 9,.JBUUO,8] ;GET INDEX
	CAIG	T1,MAXUUO	;IN RANGE?
	 XCT	LUUTAB(T1)	; DOIT
LUUDON:	MOVSI	16,UUOACS	;COPY FROM SAVE TO ACS
	BLT	16,16
	RET			;GO HOME

LUUTAB:	HALT	.		;LUUO 0
	CALL	TTYSTF		;LUUO 1
	CALL	$OUTSTR		;LUUO 2
MAXUUO==.-LUUTAB-1

;Dependent terminal routines
TTYSTF:	MOVE	T1,@.JBUUO	;GET ARG WORD
	LDB	T3,[POINT 9,T1,8] ;GET CODE
	TRZE	T3,TT$IND	;INDIRECT?
	 CALL	GETIND		; YES, FETCH ARGS
	MOVE	T2,TTYTYP	;GET TTY TYPE
	SKIPN	T2,VTXDSP(T2)	;GET BASE
	 FATAL	<Unknown TTY type>
	ADD	T2,T3		;GET ADDR
	SKIPN	T2,(T2)		;GET ROUTINE
	 RET			; NONE.
	CALL	(T2)		;GO!
	 TRNA
	  PSOUT			;OUTPUT STRING
	MOVEI	T1,.PRIOU	;RESET POSITION COUNTER
	SETZ	T2,		;AVOID "WIDTH 0"
	SFPOS
	 ERJMP	.+1
	RET
VT1TBL:	EXP	MOV10,JMP10,JME10,ERL10,ERB10,SCL10,NRM10,REV10,BRI10
VT5TBL:	EXP	MOV52,JMP52,JME52,ERL52,ERB52,0,NRM62,REV62,0

DEFINE	XX	(NAM,ADDR) <
	BLOCK	.TT'NAM-.
	EXP	ADDR
> ;XX

VTXDSP:	PHASE	0
	XX	V52,VT5TBL	;(15) VT52
	XX	100,VT1TBL	;(16) VT100
	XX	125,VT1TBL	;(35) VT125
	XX	K10,VT1TBL	;(36) VK100 (GIGI IN VT100 COMPAT MODE)
	XX	102,VT1TBL	;(37) VT102
	XX	H19,VT1TBL	;(38) H19 (ANSI)
	XX	131,VT1TBL	;(39) VT131
	DEPHASE
;;;REGIS CLEAR SEQUENCE
;;;[BYTE (7)33,"P","p","s","(","e",")",33,"\"] ;(36) VK100


;Here to fetch indirect args into T1
; T1/	Indirect command word
GETIND:	LDB	T2,[POINT 9,T1,17] ;GET LINE AC
	MOVE	T2,UUOACS(T2)	;GET AC
	DPB	T2,[POINT 9,T1,17] ;STORE VALUE
	LDB	T2,[POINT 9,T1,26] ;GET COLM
	MOVE	T2,UUOACS(T2)	;GET AC
	DPB	T2,[POINT 9,T1,26] ;STORE VALUE
	RET

; Output an escape prefixed character
; T2/	Char
PUTESC:	MOVEI	T1,33
	CALL	PUTC
	MOVE	T1,T2
	CALL	PUTC
	RET
;*Move the cursor for a VT52 type terminal
MOV52:	PUSH	P,T1		;SAVE ARGS
	TLNE	T1,000777
	 TRNN	T1,777000
	  FATAL	<Bad call to MOV52>
	MOVEI	T2,"Y"
	CALL	PUTESC
	LDB	T1,[POINT 9,(P),17] ;Get line number
	ADDI	T1," "-1
	CALL	PUTC		;OUTPUT
	LDB	T1,[POINT 9,(P),26] ;GET COLUMN
	ADDI	T1," "-1
	CALL	PUTC
	POP	P,T1
	RET

;*Jump to home and clear the screen for VT52
JME52:	HRROI	T1,[BYTE (7)33,"H",33,"J",0]
	RETSKP

;*Jump to home
JMP52:	MOVEI	T2,"H"
	PJRST	PUTESC

;*Erase to end of line
ERL52:	MOVEI	T2,"K"
	PJRST	PUTESC

;*Erase to end of screen(page)
ERB52:	MOVEI	T2,"J"
	PJRST	PUTESC

REV62:	MOVEI	T2,"T"
	PJRST	PUTESC

NRM62:	MOVEI	T2,"U"
	PJRST	PUTESC
;****************************************
;* Here are the VT100 specific routines *
;****************************************

;Change to reverse video
REV10:	HRROI	T1,[BYTE (7)33,"[","7","m",0]
	RETSKP

;Change to bold
BRI10:	HRROI	T1,[BYTE (7)33,"[","1","m"]
	RETSKP

NRM10:	HRROI	T1,[BYTE (7)33,"[","0","m"]
	RETSKP

MOV10:	PUSH	P,T1		;SAVE LINE/COL
	MOVE	T1,[POINT 7,VT10OT,13] ;DESTINATION POINTER
	LDB	T2,[POINT 9,(P),17]
	CALL	MOV10A
	MOVEI	T2,";"
	IDPB	T2,T1
	LDB	T2,[POINT 9,(P),26]
	CALL	MOV10A
	MOVEI	T2,"H"
	IDPB	T2,T1
	POP	P,T1
	HRROI	T1,VT10OT	;Point to string
	RETSKP

MOV10A:	MOVE	T3,[NO%LFL!NO%ZRO!NO%OOV!FLD(2,NO%COL)!^D10]
	NOUT
	 TRN
	RET

;Scroll VT100
SCL10:	PUSH	P,T1		;SAVE LINE/COL
	MOVE	T1,[POINT 7,VT10ST,13] ;DESTINATION POINTER
	LDB	T2,[POINT 9,(P),17]
	CALL	MOV10A
	MOVEI	T2,";"
	BOUT
	LDB	T2,[POINT 9,(P),26]
	CALL	MOV10A
	MOVEI	T2,"r"
	BOUT
	POP	P,T1
	HRROI	T1,VT10ST	;Point to string
	RETSKP
;Jump to home
JMP10:	HRROI	T1,[BYTE (7)33,"[","0",";","0","H"]
	RETSKP

;Jump to home and erase the screen
JME10:	HRROI	T1,[BYTE (7)33,"[","0",";","0"
		    BYTE (7)"H",33,"[","2","J"
		    0]
	RETSKP

;Erase line
ERL10:	HRROI	T1,[BYTE (7)33,"[","0","K",0]
	RETSKP

;Erase to end of screen

ERB10:	HRROI	T1,[BYTE (7)33,"[","0","J",0]
	RETSKP

; TOPS-20 OUTSTR LUUO
$OUTSTR: HRROI	T1,@.JBUUO	;GET EA
	PSOUT			;OUTPUT IT
	RET
	SUBTTL	THE END
JUNK:	XLIST
	LIT
	LIST
ENDJNK:

DEFINE	SAY (A,B,C,D,E) <
PRINTX A'B'C'D'E
> ;SAY

IF1 <
SAY	<[END OF PASS1]>
SAY	<JUNK = >,\JUNK
SAY	\<ENDJNK-JUNK>,< WORDS LITTERALS>
> ;IF1

	END	<3,,EVEC>