.TITLE	SAY	- interactive message program
	.IDENT	/V01-015/
	.LIBRARY	/SYS$LIBRARY:LIB/

;
;**************************************************************************
;*									  *
;*   THIS SOFTWARE MAY BE COPIED FOR USE ON SYSTEMS OTHER THAN  THE  ONE  *
;*   TO  WHICH  IT WAS DISTRIBUTED ONLY IF IT IS TRANSFERRED INTACT WITH  *
;*   THIS HEADER AND ALL OTHER  ASSOCIATED  DOCUMENTATION  AND  REVISION  *
;*   HISTORY INFORMATION.						  *
;*									  *
;*   THE INFORMATION IN THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE  WITHOUT  *
;*   NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY THE AUTHOR.	  *
;*									  *
;*   THE AUTHOR ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  *
;*   THIS SOFTWARE IN A MANNER FOR WHICH IT WAS NOT INTENDED.		  *
;*									  *
;**************************************************************************

;++
; FACILITY:
;	SAY	- interactive message utility
;
; ABSTRACT:
;
;	This utility obtains a username and a message from the terminal and
;	sends that message to all terminals logged in under the specified
;	username.  It removes all non-printable characters from the message
;	and compresses all white-space to a single blank.
;
; ENVIRONMENT:
;	Native mode, user mode
;	Requires CMKRNL, GROUP, WORLD, OPER and SYSLCK privileges
;
; AUTHOR:
;	Richard W. Critz, Jr.
;
; MODIFIED BY:
;
;	V01-015	RWC0015		Richard W. Critz, Jr.	3-JAN-1983
;		Add /QUERY qualifier.
;
;	V01-014	RWC0014		Richard W. Critz, Jr.	3-JAN-1983
;		Correct problem in SET_PREVIOUS that caused PID to be
;		used as return code.
;
;	V01-013	RWC0013		Richard W. Critz, Jr.	31-DEC-1982
;		Replace all mutex usage with VAX/VMS lock manager.
;		Note that /INITIALIZE=STARTUP is no longer valid but is
;		still accepted in the interest of compatibility.
;
;	V01-012	RWC0012		Richard W. Critz, Jr.	29-DEC-1982
;		Add support for "SAY *" to send to last recipient.
;
;	V01-011	RWC0011		Richard W. Critz, Jr.	14-DEC-1982
;		Correct changes made in ECO01 so that CTRL/Z in a prompt 
;		is handled in a manner consistent with other DCL commands
;		(i.e., processing is terminated immediately without error)
;
;	V01-010	RWC0010		Richard W. Critz, Jr.	14-DEC-1982
;		Expand buffer sizes to 132 bytes.
;
;	V01-009	RWC0009		Richard W. Critz, Jr.	14-DEC-1982
;		Modify translation so that lowercase is NOT translated
;		to uppercase.
;
;	V01-008	RWC0008		Richard W. Critz, Jr.	17-AUG-1982
;		Convert to V3.0 by changing all references to external
;		locations to be GENERAL addressing mode (G^).
;
;	V01-007	RWC0007		Richard W. Critz, Jr.	15-FEB-1982
;		Allow /INITIALIZE=STARTUP for non-system users with
;		SYSPRV.
;
;	V01-006	RWC0006		Richard W. Critz, Jr.	18-JAN-1982
;		Add /SILENT option.
;
;	V01-005	RWC0005		Richard W. Critz, Jr.	18-JAN-1982
;		Change system group comparisons to system global symbol
;		(EXE$GL_SYSUIC) instead of hard-coded constant.
;
;	V01-004	RWC0004		Richard W. Critz, Jr.	16-OCT-1981
;		Correct documentation to show proper elevated privileges.
;
;	V01-003	RWC0003		Richard W. Critz, Jr.	16-OCT-1981
;		Plug security hole that allowed all users to initialize
;		the global section mutex.
;
;	V01-002	RWC0002		Richard W. Critz, Jr.	15-OCT-1981
;		Add capability to enable and disable messages for a
;		process.
;
;	V01-001	RWC0001		Richard W. Critz, Jr.	15-OCT-1981
;		Correct handling of EOF condition in input action
;		routines to prevent premature termination.
;--
	.PAGE
	.SBTTL	DECLARATIONS
;
; INCLUDE FILES:
;
	$IPLDEF
	$JPIDEF
	$LCKDEF
	$PCBDEF
	$PRVDEF
	$TPADEF

;
; MACROS:
;
	.MACRO	ON_ERROR	ERR=,?L1
	BLBS	R0,L1
	BRW	ERR
L1:
	.ENDM	ON_ERROR

;
; EQUATED SYMBOLS:
;
BELL = 7
BLANK = 32

;
; OWN STORAGE:
;

	.PSECT	STATIC	RD,NOWRT,NOEXE,BYTE
TO_WHOM:
	.ASCID	/$_To:		/
WHAT:	.ASCID	/$_Message:	/
TRANTAB:				; lowercase to uppercase and
	.BYTE	32[16]			; non-printing to blanks.
	.BYTE	32[16]
	.BYTE	32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47
	.BYTE	48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63
	.BYTE	64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79
	.BYTE	80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95
	.BYTE	96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
	.BYTE	112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,32
	.BYTE	32[128]
IDENT:	.WORD	12,JPI$_USERNAME	; identify caller
	.LONG	MY_NAME,0
	.LONG	0
ITEMS:	.WORD	12,JPI$_USERNAME	; search for recipients
	.LONG	UNAME,0
	.WORD	7,JPI$_TERMINAL
	.LONG	TERMINAL,TERM_DESC
	.WORD	4,JPI$_PID
	.LONG	PID,0
	.LONG	0
TIME_DESC:				; message dispatch time
	.LONG	23,TIME
LOCK_NAME:				; resource name for lock manager
	.ASCID	/SAY_LOCK/

	.PAGE
	.PSECT	DATA	RD,WRT,NOEXE,BYTE
BUFF1:	.BLKB	132			; input work buffer
BUFF2:	.BLKB	132			; input work buffer
BD1:	.LONG	132,BUFF1		; descriptor for above
BD2:	.LONG	132,BUFF2		; descriptor for above
NAME_DESC:				; descriptor for recipient's username
	.BLKQ	1
MSG_DESC:				; descriptor for message
	.BLKQ	1
TPA_PARMS:				; TPARSE parameter block
	.LONG	TPA$K_COUNT0
	.LONG	0
	.BLKB	<TPA$K_LENGTH0-8>
SCANPID:				; PID for wildcard $GETJPI search
	.LONG	-1
PID:	.BLKL	1			; PID of caller and each candidate
UNAME:	.BLKB	12			; area for candidate username
TERMINAL:				; buffer for recipient's terminal name
	.BLKB	7
TERM_DESC:				; descriptor for above
	.LONG	7,TERMINAL
HEADER:	.BYTE	7			; message header and buffer
	.ASCII	/From:  /
MY_NAME:
	.BLKB	12
	.BYTE	32[5]
TIME:	.BLKB	23
	.BYTE	13,10
HEADER_LEN = .-HEADER
MSGBUF:	.BLKB	133
MSGVEC:	.LONG	4			; error message vector
	.LONG	SAY$_NOTALLSENT
	.LONG	2
	.BLKL	2
FOUND_OPT:
	.BYTE	0
SILENT:	.LONG	0
USE_PREVIOUS:
	.LONG	0
LKSB:	.BLKQ	1

	.PAGE
	.SBTTL	STATE TABLE

	$INIT_STATE	SAY_STATE,SAY_KEY
	$STATE
	$TRAN	TPA$_EOS,NAME,GET_NAME
	$TRAN	'/',OPTIONS,SET_ABBREV
	$TRAN	'TO'
	$TRAN	TPA$_LAMBDA
	$STATE	NAME
	$TRAN	TPA$_EOS,NAME,GET_NAME
	$TRAN	'*',,,1,USE_PREVIOUS
	$TRAN	TPA$_SYMBOL,,,,NAME_DESC
	$STATE
	$TRAN	TPA$_LAMBDA,,SET_BLANKS
	$STATE	MSG
	$TRAN	TPA$_EOS,MSG,GET_MSG
	$TRAN	TPA$_BLANK,MSG
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,SET_MSG
	$STATE	OPTIONS
	$TRAN	'DISABLE',TPA$_EXIT,SAY_OFF
	$TRAN	'ENABLE',TPA$_EXIT,SAY_ON
	$TRAN	'INITIALIZE'
	$TRAN	'QUERY',TPA$_EXIT,QUERY
	$TRAN	'SILENT',NO_BELLS,CLR_ABBREV,1,SILENT
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,BADOPT
	$STATE
	$TRAN	'='
	$TRAN	TPA$_EOS,TPA$_EXIT,INIT
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,BADOPT
	$STATE
	$TRAN	'STARTUP',TPA$_EXIT,INIT
	$TRAN	TPA$_LAMBDA,TPA$_EXIT,BADOPT
	$STATE	NO_BELLS
	$TRAN	'/',TPA$_EXIT,BADOPT
	$TRAN	TPA$_EOS,NAME,GET_NAME
	$TRAN	'TO',NAME
	$TRAN	TPA$_LAMBDA,NAME
	$END_STATE

	.PAGE
	.SBTTL	MAIN PROCEDURE
	.PSECT	CODE	RD,NOWRT,EXE,BYTE

;++
;
; FUNCTIONAL DESCRIPTION:
;
;	Obtain command line, call TPARSE to evaluate and partition command
;	line and/or prompt for missing pieces, and remove all non-whitespace,
;	non-printing characters, compress whitespace to single blanks and
;	remove trailing whitespace, complete formation of message by inserting
;	sender's username and the system absolute time, the send to all
;	terminals associated with the specified username
;	
; CALLING SEQUENCE:
;
;	none
;
; INPUTS:
;
;	Recipient's username, message to be sent
;
; IMPLICIT INPUTS:
;
;	All PCBs and JIBs
;
; OUTPUTS:
;
;	none
;
; IMPLICIT OUTPUTS:
;
;	none
;
; ROUTINE VALUE:
;
;	none
;
; SIDE EFFECTS:
;
;	message sent to other user's terminals
;--

START::	.WORD
	PUSHAW	BD1			; Set up argument list for
	PUSHL	#0			;    LIB$GET_FOREIGN to obtain
	PUSHAQ	BD1			;    command line
	CALLS	#3,G^LIB$GET_FOREIGN
	ON_ERROR EXIT			; Check for error
	MOVZWL	BD1,-			; Set up TPARSE parameter block
		TPA_PARMS+TPA$L_STRINGCNT
	MOVL	BD1+4,-
		TPA_PARMS+TPA$L_STRINGPTR
	PUSHAB	SAY_KEY			; Set up argument list for TPARSE
	PUSHAB	SAY_STATE
	PUSHAL	TPA_PARMS
	CALLS	#3,G^LIB$TPARSE		; Call TPARSE to process input and
					;    obtain omitted input
	ON_ERROR EXIT			; Check for error
	BLBC	FOUND_OPT,1$		; See if option specified
	BRW	EXIT			; Yes, processing is finished
1$:	BLBC	USE_PREVIOUS,5$		; If no *, then save the name specified
	BSBW	GET_PREVIOUS		; Obtain name of recipient from records
5$:	MOVL	SP,R6			; Save stack pointer
	SUBL2	MSG_DESC,SP		; Allocate buffer on stack
	MOVTC	MSG_DESC,@MSG_DESC+4,-	; Do translation: lower- to upper-case,
		#BLANK,TRANTAB,-	;    non-printables to blanks
		MSG_DESC,(SP)
10$:	CMPB	#BLANK,-(R6)		; Strip trailing blanks
	BEQL	10$
	INCL	R6			; Restore last character
	SUBL2	SP,R6			; Calculate length of trimmed message
	MOVAB	MSGBUF,R3		; Init pointer to set up message
	CLRL	R4			; Init last_char_blank flag
	CLRL	R5			; Init message length counter
20$:	CMPB	#BLANK,(SP)+		; See if char is blank
	BNEQ	30$			; No, clear flag and transfer byte
	BLBS	R4,20$			; Ignore if last char was blank
	BISB2	#1,R4			; Set last_char_blank flag
	BRB	40$			; Go transfer blank
30$:	CLRL	R4			; Clear last_char_blank flag
40$:	MOVB	-1(SP),(R3)+		; Transfer byte to buffer
	INCL	R5			; Increment message length
	SOBGTR	R6,20$			; Go back for next char if more left
	MOVB	#BELL,(R3)		; Append bell to message
	INCL	R5			; Put bell in length count
	ADDL3	#HEADER_LEN,R5,MSG_DESC	; Calulate and store final message len
	MOVAB	HEADER,MSG_DESC+4	; Put message address in descriptor
	BLBC	SILENT,45$		; If user specified /SILENT
	SUBW2	#2,MSG_DESC		;    then remove bells from message
	INCL	MSG_DESC+4
45$:	$GETJPI_S -
		ITMLST=IDENT		; Place caller's username in message
	$ASCTIM_S -
		TIMBUF=TIME_DESC	; Place current system time in message
	CLRQ	R6			; Init message sent counters
50$:	$GETJPI_S -			; Search for specified user
		EFN=#1,-
		ITMLST=ITEMS,-
		PIDADR=SCANPID
	BLBS	R0,70$			; Branch if no error
	CMPL	#SS$_NOMOREPROC,R0	; See if end of list
	BEQL	55$			; Branch if so
	BRW	EXIT			; Error abort
55$:	MOVZBL	#SS$_NORMAL,R0		; Assume normal termination
	TSTL	R6			; See if send(s) attempted
	BNEQ	60$			; Yes, go check further
	TSTL	R7
	BNEQ	62$
	MOVL	#SAY$_BADPROC,R0	; Bad process, bomb out
	BRW	EXIT
60$:	TSTL	R7			; See if any sends failed
	BEQL	65$			; No, successful exit
62$:	MOVL	R6,MSGVEC+12		; Print warning message
	ADDL3	R6,R7,MSGVEC+16
	$PUTMSG_S MSGVEC
65$:	BLBS	USE_PREVIOUS,67$	; See if should save recipient's name
	BSBW	SET_PREVIOUS		; Yes .. go do it
67$:	BRW	EXIT			; Finished
70$:	$WAITFR_S -			; Wait for $GETJPI to complete
		EFN=#1
	ON_ERROR EXIT			; Check for error
	TSTW	TERM_DESC		; See if process has terminal
	BNEQ	72$			; No, try again
	BRW	50$
72$:	CMPC5	NAME_DESC,@NAME_DESC+4,-; See if username matches
		#^X20,#12,UNAME
	BEQL	75$			; No, try again
	BRW	50$
75$:	BSBW	VALIDATE		; See if user has disabled messages
	TSTL	PID			; Will be 0 if messages disabled
	BEQL	80$
	$BRDCST_S -			; Got user, send message
		MSGBUF=MSG_DESC,-
		DEVNAM=TERM_DESC
	BLBS	R0,90$			; Branch if no error
	CMPL	#SS$_DEVOFFLINE,R0	; See if terminal not listening
	BEQL	80$			; That's the case, not an error
	BRW	EXIT			; Some fatal error occured
80$:	INCL	R7			; Increment failed_to_send counter
	BRW	50$			; Try again
90$:	INCL	R6			; Increment sent_successfully counter
	BRW	50$
EXIT:	$EXIT_S	R0			; Quit for good

	.PAGE
	.SBTTL	VALIDATE	- check for message disable

;++
;
; FUNCTIONAL DESCRIPTION:
;
;	This routine synchronizes access with the status global section by
;	obtaining a protected read lock on it and checks to see if the
;	sequence number in the section matches the one for the currently
;	elligible process.  If so, the process has disabled messages and the
;	PID field is cleared to telegraph this to the calling routine.
;	
; CALLING SEQUENCE:
;
;	JSB/BSB
;
; INPUTS:
;
;	none
;
; IMPLICIT INPUTS:
;
;	SAYSWITCH global section
;	SAY_LOCK mutex
;	PCB of calling process
;
; OUTPUTS:
;
;	none
;
; IMPLICIT OUTPUTS:
;
;	none
;
; ROUTINE VALUE:
;
;	none
;
; SIDE EFFECTS:
;
;	none
;--

VALIDATE:
	CMPW	PID,G^MAXPIX		; Validate PID index
	BGTRU	20$			; Too big -- complain
	PUSHL	R6			; Save R6 so can use it
	MOVZWL	PID,R6			; Pick up PID index
	$ENQW_S	LKMODE=#LCK$K_PRMODE,-	; Obtain "protected read" lock
		LKSB=LKSB,-
		FLAGS=#LCK$M_SYSTEM,-
		RESNAM=LOCK_NAME
	ON_ERROR EXIT			; Check for error
	CMPW	PID+2,G^STATS[R6]	; See if sequence number matches
	BNEQU	10$			; No .. just return
	CLRL	PID			; Yes, messages are disabled
10$:	$DEQ_S	LKID=LKSB+4		; Release lock
	ON_ERROR EXIT			; Check for error
	MOVL	(SP)+,R6		; Restore R6
	RSB
20$:	MOVL	#SAY$_BADPID,R0		; Set "internal error" code
	BRW	EXIT			; Terminate execution

	.PAGE
	.SBTTL	TPARSE action routines

;++
;
; FUNCTIONAL DESCRIPTION:
;
;	All TPARSE action routines have simple, self-explanatory purposes.
;	
; CALLING SEQUENCE:
;
;	CALLS/CALLG
;
; INPUTS:
;
;	Username and message
;
; IMPLICIT INPUTS:
;
;	TPARSE parameter block, SAYSWITCH global section
;
; OUTPUTS:
;
;	Prompts
;
; IMPLICIT OUTPUTS:
;
;	TPARSE parameter block, SAYSWITCH global section
;
; ROUTINE VALUE:
;
;	none
;
; SIDE EFFECTS:
;
;	T.B.S.
;--

GET_NAME:
	.WORD
	MOVZBL	#132,BD1		; Reset buffer length
	PUSHAW	BD1			; Set up arg list for LIB$GET_INPUT
	PUSHAQ	TO_WHOM
	PUSHAQ	BD1
	CALLS	#3,G^LIB$GET_INPUT	; Get username from SYS$INPUT
	CMPL	#RMS$_EOF,R0		; See if CTRL/Z entered
	BNEQ	5$			; Nope .. continue
	MOVZBL	#SS$_NORMAL,R0		; Set normal exit status
	BRW	EXIT			; And terminate processing
5$:	ON_ERROR EXIT			; Check for other errors
	MOVZWL	BD1,-			; Reset TPARSE parameter block
		TPA_PARMS+TPA$L_STRINGCNT
	MOVL	BD1+4,-
		TPA_PARMS+TPA$L_STRINGPTR
	PUSHAQ	BD1			; Translate to uppercase
	PUSHAQ	BD1
	CALLS	#2,G^STR$UPCASE
	ON_ERROR EXIT			; Check for error
10$:	RET				; Finished

GET_MSG:
	.WORD
	MOVZBL	#132,BD2		; Reset buffer length
	PUSHAW	BD2			; Set up arg list for LIB$GET_INPUT
	PUSHAQ	WHAT
	PUSHAQ	BD2
	CALLS	#3,G^LIB$GET_INPUT	; Get message from SYS$INPUT
	CMPL	#RMS$_EOF,R0		; See if CTRL/Z entered
	BNEQ	5$			; Nope .. continue
	MOVZBL	#SS$_NORMAL,R0		; Set normal exit status
	BRW	EXIT			; And terminate processing
5$:	ON_ERROR EXIT			; Check for other errors
	MOVZWL	BD2,-			; Reset TPARSE parameter block
		TPA_PARMS+TPA$L_STRINGCNT
	MOVL	BD2+4,-
		TPA_PARMS+TPA$L_STRINGPTR
	RET				; Finished

SET_MSG:
	.WORD	^M<R2>
	MOVL	TPA_PARMS+TPA$L_STRINGCNT,-
		MSG_DESC		; Set up message descriptor
	MOVL	TPA_PARMS+TPA$L_STRINGPTR,-
		MSG_DESC+4
	RET

SET_BLANKS:
	.WORD
	BISL2	#TPA$M_BLANKS,-		; Make blanks significant
		TPA_PARMS+TPA$L_OPTIONS
	RET

SET_ABBREV:
	.WORD
	BISL2	#TPA$M_ABBREV,-		; Make unambiguous abbreviations legal
		TPA_PARMS+TPA$L_OPTIONS
	INCB	FOUND_OPT		; Set flag indicating an option was
					;    specified
	RET

CLR_ABBREV:
	.WORD
	BICL2	#TPA$M_ABBREV,-		; Make all abbreviations illegal again
		TPA_PARMS+TPA$L_OPTIONS
	CLRB	FOUND_OPT		; Clear option flag to allow message
					;    processing
	RET

SAY_OFF:
	.WORD	^M<R5,R6>
	$CMKRNL_S -			; Get PID of this process
		GET_PID
	CMPW	R0,G^MAXPIX		; Validate PID index
	BGTRU	10$			; Too big -- complain
	MOVZWL	R0,R6			; Pick up PID index
	ASHL	#-16,R0,R5		; Isolate PID sequence
	$ENQW_S	LKMODE=#LCK$K_EXMODE,-	; Get "exclusive mode" lock
		LKSB=LKSB,-
		FLAGS=#LCK$M_SYSTEM,-
		RESNAM=LOCK_NAME
	ON_ERROR EXIT			; Check for error
	MOVW	R5,G^STATS[R6]		; Store PID sequence
	$DEQ_S	LKID=LKSB+4		; Release lock
	ON_ERROR EXIT			; Check for error
	RET
10$:	MOVL	#SAY$_BADPID,R0		; Set "internal error" code
	BRW	EXIT			; Terminate execution

SAY_ON:	.WORD	^M<R5,R6>
	$CMKRNL_S -			; Get PID of this process
		GET_PID
	CMPW	R0,G^MAXPIX		; Validate PID index
	BGTRU	10$			; Too big -- complain
	MOVZWL	R0,R6			; Pick up PID index
	ASHL	#-16,R0,R5		; Isolate PID sequence
	$ENQW_S	LKMODE=#LCK$K_EXMODE,-	; Get "exclusive mode" lock
		LKSB=LKSB,-
		FLAGS=#LCK$M_SYSTEM,-
		RESNAM=LOCK_NAME
	ON_ERROR EXIT			; Check for error
	CLRW	G^STATS[R6]		; Clear PID sequence
	$DEQ_S	LKID=LKSB+4		; Release lock
	ON_ERROR EXIT			; Check for error
	RET
10$:	MOVL	#SAY$_BADPID,R0		; Set "internal error" code
	BRW	EXIT			; Terminate execution

INIT:	.WORD	^M<R2,R3,R4,R5,R6>
	$CMKRNL_S -			; Verify that process is authorized
		10$			;    to do an INITIALIZE
	ON_ERROR EXIT			; Check for error
	MULW3	#2,G^MAXPIX,R6		; Calculate length of sequence arrays
	MOVC5	#0,(R0),#0,R6,-		; Clear the sequence array for "SAY *"
		G^PREV_SEQ
	$ENQW_S	LKMODE=#LCK$K_EXMODE,-	; Get "exclusive mode" lock
		LKSB=LKSB,-
		FLAGS=#LCK$M_SYSTEM,-
		RESNAM=LOCK_NAME
	ON_ERROR EXIT			; Check for error
	MOVC5	#0,(R0),#0,R6,G^STATS	; Clear the sequence array for disable
	$DEQ_S	LKID=LKSB+4		; Release the lock
	ON_ERROR EXIT			; Check for error
	RET

10$:	.WORD	^M<R4>
	MOVZBL	#SS$_NORMAL,R0		; Assume that user has necessary privs
	DSBINT	#IPL$_SYNCH		; Raise IPL to SYNCH
	MOVL	G^SCH$GL_CURPCB,R4	; Get address of current PCB
	CMPW	G^EXE$GL_SYSUIC,-	; See if user has system UIC
		PCB$W_GRP(R4)
	BGEQU	20$			; Yes -- allow INIT
	IFPRIV	SYSPRV,20$		; Otherwise, must have SYSPRV
	MOVL	#SS$_NOPRIV,R0		; Can't permit INIT
20$:	ENBINT				; Lower IPL
	RET

BADOPT:	.WORD
	MOVL	#SAY$_BADOPT,R0		; Set "bad option" return code
	RET

QUERY:	.WORD	^M<R5,R6>
	$CMKRNL_S -			; Get PID of this process
		GET_PID
	CMPW	R0,G^MAXPIX		; Validate PID index
	BGTRU	10$			; Too big -- complain
	MOVZWL	R0,R6			; Pick up PID index
	ASHL	#-16,R0,R5		; Isolate PID sequence
	CMPW	R5,G^PREV_SEQ[R6]	; Validate PID sequence
	BNEQU	20$			; No previous "sayee" for this process
	INDEX	R6,#0,G^MAXPIX,#13,-	; Calculate offset into name array
		#0,R6
	MOVZBW	#3,MSGVEC		; Set up message vector to show
	MOVL	#SAY$_PREVNAME,MSGVEC+4	;    username of current correspondent
	DECW	MSGVEC+8
	MOVAB	G^PREV_NAME[R6],-
		MSGVEC+12
	$PUTMSG_S -			; Write message
		MSGVEC
	RET
10$:	MOVL	#SAY$_BADPID,R0		; Set "internal error" code
	BRW	EXIT			; Terminate execution
20$:	MOVZBW	#1,MSGVEC		; Set up message vector to show that
	MOVL	#SAY$_NOPREV,MSGVEC+4	;    there is no current correspondent
	$PUTMSG_S -			; Write message
		MSGVEC
	RET

	.PAGE
	.SBTTL	GET_PID		- obtain PID of this process

;++
;
; FUNCTIONAL DESCRIPTION:
;
;	Copy PID from PCB to local storage.
;	
; CALLING SEQUENCE:
;
;	CALLS/CALLG	($CMKRNL)
;
; INPUTS:
;
;	none
;
; IMPLICIT INPUTS:
;
;	PCB of current process
;
; OUTPUTS:
;
;	none
;
; IMPLICIT OUTPUTS:
;
;	none
;
; ROUTINE VALUE:
;
;	none
;
; SIDE EFFECTS:
;
;	none
;--

GET_PID:
	.WORD	^M<R4>
	DSBINT	#IPL$_SYNCH		; Raise IPL to SYNCH
	MOVL	G^SCH$GL_CURPCB,R4	; Get address of current PCB
	MOVL	PCB$L_PID(R4),R0	; Copy PID to local storage
	ENBINT				; Lower IPL
	RET

	.PAGE
	.SBTTL	GET_PREVIOUS	- fetch name of previous recipient

;++
;
; FUNCTIONAL DESCRIPTION:
;
;	Validate PID of calling process, obtain name of previous recipient
;	from global database
;	
; CALLING SEQUENCE:
;
;	BSB/JSB
;
; INPUTS:
;
;	none
;
; IMPLICIT INPUTS:
;
;	PID of current process, global database
;
; OUTPUTS:
;
;	none
;
; IMPLICIT OUTPUTS:
;
;	username of previous recipient
;
; ROUTINE VALUE:
;
;	none
;
; SIDE EFFECTS:
;
;	terminates execution if error detected
;--

GET_PREVIOUS:
	$CMKRNL_S -			; Get PID of this process
		GET_PID
	MOVL	R0,PID			; Store returned PID
	CMPW	PID,G^MAXPIX		; Validate PID index
	BGTRU	10$			; Too big -- complain
	PUSHL	R6			; Save register to be used
	MOVZWL	PID,R6			; Pick up PID index
	CMPW	PID+2,G^PREV_SEQ[R6]	; Validate PID sequence
	BNEQU	20$			; No previous "sayee" for this process
	INDEX	R6,#0,G^MAXPIX,#13,-	; Calculate offset into name array
		#0,R6
	MOVZBW	G^PREV_NAME[R6],-	; Retrieve length of username
		NAME_DESC
	MOVAB	G^PREV_NAME+1[R6],-	; Set address of username
		NAME_DESC+4
	MOVL	(SP)+,R6		; Restore R6
	RSB
10$:	MOVL	#SAY$_BADPID,R0		; Set "internal error" code
	BRW	EXIT			; Terminate execution
20$:	MOVL	#SAY$_UNDEF,R0		; Set "no previous" code
	BRW	EXIT			; Terminate execution

	.PAGE
	.SBTTL	SET_PREVIOUS	- save name of current recipient

;++
;
; FUNCTIONAL DESCRIPTION:
;
;	Validate PID of caller, store current recipient's username 
;	in ASCIC format in global database
;
; CALLING SEQUENCE:
;
;	BSB/JSB
;
; INPUTS:
;
;	none
;
; IMPLICIT INPUTS:
;
;	PID of current process, global database
;
; OUTPUTS:
;
;	none
;
; IMPLICIT OUTPUTS:
;
;	none
;
; ROUTINE VALUE:
;
;	none
;
; SIDE EFFECTS:
;
;	Will terminate execution if error detected
;--

SET_PREVIOUS:
	PUSHR	#^M<R0,R1,R2,R3,R4,-	; Save registers to be used
		R5,R6>
	$CMKRNL_S -			; Get PID of this process
		GET_PID
	MOVL	R0,PID			; Store returned PID
	CMPW	PID,G^MAXPIX		; Validate PID index
	BGTRU	10$			; Too big -- complain
	MOVZWL	PID,R6			; Pick up PID index
	MOVW	PID+2,G^PREV_SEQ[R6]	; Save current PID sequence
	INDEX	R6,#0,G^MAXPIX,#13,-	; Calculate offset into name array
		#0,R6
	MOVB	NAME_DESC,-		; Store length of current recipient
		G^PREV_NAME[R6]
	MOVC3	NAME_DESC,-		; Store current recipient's username
		@NAME_DESC+4,-
		G^PREV_NAME+1[R6]
	POPR	#^M<R0,R1,R2,R3,R4,-	; Restore registers
		R5,R6>
	RSB
10$:	MOVL	#SAY$_BADPID,R0		; Set "internal error" code
	BRW	EXIT			; Terminate execution

	.END	START