.NLIST	TTM
	.TITLE	DRPTY  - PTY DIRECTIVES
	.SBTTL	DRPTY  - TITLE PAGE
	.IDENT	/V01.01/

	.IF DF	P$$PTY

;
; ************************************************************************
;                                                                        *
; THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY.  DIGITAL  EQUIPMENT *
; COMPUTER USER'S SOCIETY,  DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND *
; THE AUTHOR DISCLAIM  ALL WARRANTIES ON THE PROGRAM,  INCLUDING WITHOUT *
; LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS.      *
;									 *
; FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS  AND TO THE DECUS *
; SPECIAL INTEREST  GROUPS  TO  REPRODUCE,  DISTRIBUTE,  AND PUBLISH AND *
; PERMIT  OTHERS  TO  REPRODUCE  IN  WHOLE  OR  IN PART, IN ANY FORM AND *
; WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO *
;									 *
; ************************************************************************
;
; VERSION:	V01.01
;
; AUTHOR:	RW STAMERJOHN	MAPS	31-AUG-77
;
; THIS MODULE CONTAINS THE PTY DIRECTIVE SERVICE CODE.
;
; ASSEMBLY INTRUCTIONS:
;
;	OBJECT,LISTING=EXEMC/ML,RSXMC/PA:1,DRPTY
;
; MODIFICATON HISTORY:
;
;	V01.01	PJH	05-OCT-78	ACCESS NUMBER OF PTYS ON SYSTEM
;					AS WORD LOCATION IN PTYTB

	.PAGE
	.SBTTL	DRPTY  - GLOBAL DEFINITIONS
;
; SYSTEM MACROS:
;
	.MCALL	HWDDF$,UCBDF$,SCBDF$
;
; GLOBAL DECLARATIONS:
;
	.GLOBL	$DRPTI		;FAKE INPUT  INTERRUPT TO TERMINAL.
	.GLOBL	$DRPTO		;FAKE OUTPUT INTERRUPTS TO TERMINAL.
;
; GLOBAL REFERENCES:
;
	.GLOBL	$PTYNM		;NUMBER OF PTYS ON SYSTEM
	.GLOBL	$PTYTB		;PTY UCB TABLE.
	.GLOBL	$ACHKB		;ADDRESS CHECK BUFFER.

	.IF DF	M$$MGE

	.GLOBL	$RELOC		;MAP INTO BUFFER.

	.ENDC

	.GLOBL	D.RS8		;DIRECTIVE STATUS RETURNS.
	.GLOBL	D.RS92		;
	.GLOBL	D.RS98		;

	.PAGE
	.SBTTL	DRPTY  - DATA DEFINITIONS
;
; LOCAL MACROS:
;
	HWDDF$			;DEFINE HARDWARE SYMBOLS
	UCBDF$			;DEFINE UCB OFFSETS.
	SCBDF$			;DEFINE SCB OFFSETS.
;
; LOCAL SYMBOLS:
;
DLTRPI	= 60			;INPUT  INTERRUPT TRAP VECTOR.
DLTRPO	= 64			;OUTPUT INTERRUPT TRAP VECTOR.
;
; LOCAL DATA STRUCTURES:
;
;	NONE.

	.PAGE
	.SBTTL	$DRPTI * FAKE INPUT  INTERRUPT
;+
;
; THIS DIRECTIVE SUPPLIES A CHARACTER TO A PTY BY FAKING AN
; INPUT INTERRUPT TO THE PTY.
;
; DPB FORMAT:
;
;	WD. 00 -- DPB (85.)	- DPB SIZE (2.)
;	WD. 01 -- PTY NUMBER	- CHARACTER
;
; INPUTS:
;
;	R3 = ADDRESS OF PTY NUMBER IN DPB.
;	R4 = ADDRESS OF HEADER OF THE CURRENT TASK.
;	R5 = ADDRESS OF THE TCB OF THE CURRENT TASK.
;
; OUTPUTS:
;
;	C = 0 IF DIRECTIVE SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF '+1' RETURNED.
;
;	C = 1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS92' IF PTY NUMBER IS INVALID.
;
;		DIRECTIVE STATUS OF 'D.RS8'  IF PTY INPUT INTERRUPT
;			ENABLE IS NOT SET.
;
;-
	.ENABL	LSB

$DRPTI::			;REF. LABEL.
	CALL	GTPTY		;GET UCB OF PTY.
	MOV	U.SCB(R2),R2	;GET SCB OF PTY.
	MOV	S.CSR(R2),R1	;GET CSR OF PTY.
	BIT	#100,(R1)+	;IF PTY INTERRUPTABLE?
	BEQ	90$		; IF EQ - NO, RETURN ERROR.
	MOVB	(R3),(R1)	;PUT CHARACTER IN RECEIVE BUFFER OF PTY.
	MOV	@#177776,-(SP)	;SAVE CURRENT PSW.
	MOVB	S.CON(R2),R2	;CONSTRUCT NEW PSW FOR INTERRUPT.
	ASR	R2		;
	BIS	#PR7,R2		;
	MTPS	R2		;SET NEW PSW.
	CALL	@DLTRPI		;;;FAKE INPUT INTERRUPT.
	RETURN			;ALL'S WELL THAT ENDS WELL.

	.PAGE
	.SBTTL	$DRPTO * FAKE OUTPUT INTERRUPT
;+
;
; THIS DIRECTIVE GETS OUTPUT CHARACTERS FROM A PTY AND
; FAKES OUTPUT INTERRUPTS.
;
; DPB FORMAT:
;
;	WD. 00 -- DPB (87.)	- DPB SIZE (3.)
;	WD. 01 -- PTY NUMBER	- BUFFER SIZE
;	WD. 02 -- BUFFER ADDRESS.
;
; INPUTS:
;
;	R3 = ADDRESS OF PTY NUMBER IN DPB.
;	R4 = ADDRESS OF HEADER OF THE CURRENT TASK.
;	R5 = ADDRESS OF THE TCB OF THE CURRENT TASK.
;
; OUTPUTS:
;
;	C = 0 IF DIRECTIVE SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS SET TO NUMBER OF CHARACTERS PLACED IN BUFFER.
;
;	C = 1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS98' IF BUFFER INVALID.
;
;		DIRECTIVE STATUS OF 'D.RS92' IF PTY NUMBER IS INVALID.
;
;		DIRECTIVE STATUS OF 'D.RS8'  IF NO PTY OUTPUT OUTSTANDING.
;
;-

$DRPTO::			;REF. LABEL.
	CALL	GTPTY		;GET UCB OF PTY.
	MOV	R2,-(SP)	;SAVE FOR LATER USE.
	MOVB	(R3)+,R1	;GET SIZE OF BUFFER.
	BEQ	91$		; IF EQ - ERROR.
	BIC	#177400,R1	;CLEAR ANY SIGN EXTENSION.
	MOV	(R3),R0		;GET BUFFER SIZE.
	MOV	R1,R3		;SAVE BUFFER SIZE FOR LATER USE.
	CALL	$ACHKB		;IS BUFFER LEGAL?
	BCS	91$		; IF CS - ERROR.

	.IF DF	M$$MGE

	CALL	$RELOC		;MAP R2 INTO BUFFER.
	MOV	R1,KISAR6	;

	.IFF

	MOV	R0,R2		;MAP R2 INTO BUFFER.

	.ENDC

20$:	MOV	(SP),R1			;GET UCB ADDRESS.
	BITB	#US.OUT,U.STS(R1)	;HAS AN OUTPUT BEEN DONE?
	BEQ	21$			;IF EQ - NO.
	MOV	U.SCB(R1),R1	;GET SCB ADDRESS.
	MOV	S.CSR(R1),R0	;GET CSR ADDRESS.
	MOVB	6(R0),(R2)+	;STORE CHARACTER IN USER BUFFER.
	MOV	@#177776,-(SP)	;SAVE CURRENT PSW.
	MOVB	S.CON(R1),R0	;CONSTRUCT NEW PSW.
	ASR	R0		;
	BIS	#PR7,R0		;
	MTPS	R0		;SET INTERRUPT PSW.
	CALL	@DLTRPO		;;;FAKE OUTPUT INTERRUPT.
	INC	4(SP)		;COUNT CHARACTER IN BUFFER.
	DEC	R3		;
	BNE	20$		; IF NE - LOOP FOR MORE.
21$:	TST	(SP)+		;REMOVE UCB FROM STACK.
	DEC	2(SP)		;MAKE COUNT TRUE.
	BEQ	90$		; IF EQ - ERROR.
	RETURN			;ALL'S WELL THAT ENDS WELL.

	.PAGE
	.SBTTL	GTPTY  * GET PTY UCB
;
; THIS ROUTINE GETS THE PTY UCB.
;
; INPUTS:
;
;	R3 = ADDRESS OF PTY NUMBER IN LOW BYTE.
;
; OUTPUTS:
;
;	R2 = UCB OF PTY.
;	R3 = R3+1.
;
;		RETURNS DIRECTIVE STATUS OF 'D.RS92' IF PTY NUMBER INVALID.
;

GTPTY:				;REF. LABEL.

	MOVB	(R3)+,R2	;GET PTY NUMBER.
	BLT	92$		; IF LT - ERROR.
	CMP	$PTYNM,R2	;SEE IF PTY NUMBER IN RANGE.
	BLT	92$		; IF LT - ERROR.
	ASL	R2		;MAKE INTO WORD INDEX.
	MOV	$PTYTB(R2),R2	;GET PTY UCB.

	RETURN

;
; ERROR RETURNS.
;
90$:	DRSTS	D.RS8		;RETURN ERROR -8.

91$:	TST	(SP)+		;CLEAN STACK.
	DRSTS	D.RS98		;RETURN ERROR -98.

92$:	TST	(SP)+		;CLEAN STACK.
	DRSTS	D.RS92		;RETURN ERROR -92.

	.DSABL	LSB

	.ENDC

	.END