.TITLE	TERCHA
	.IDENT	/020000/
	.PSECT	TERCHA,RO,I
	.LIST	TTM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;								;;
;; ABSTRACT: TERCHA						;;
;; 	GET THE CURRENT TERMINAL TYPE, WIDTH, LENGTH, 		;;
;; 	AND COMPUTER TRANSMIT SPEED.				;;
;;  								;;
;; CALLING SEQUENCE:						;;
;; 	CALL TERCHA (TYPE,WIDTH,LENGTH,SPEED)			;;
;;  								;;
;; ARGUMENTS:							;;
;;  								;;
;; 	TYPE FIXED BINARY(15)					;;
;; 		OUTPUT: CONTAINS A NUMBER FOR TERMINAL TYPE :	;;
;; 		0= ERROR OR UNKNOWN				;;
;; 		1=ASR33	2=KSR33	3=ASR35	4=LA30S	5=LA30P		;;
;; 		6=LA36	7=VT05	8=VT50		9=VT52		;;
;; 		10=VT55	11=VT61	12=LA180	13=VT100	;;
;; 		14=LA120 15=SCRIPT LINE	16=USR0	17=USR1		;;
;;		18=USR2	 19=USR3	20=USR4	21=USR5		;;
;;		22=ADM1	 23=ADM31	24=ADM3A  25=MINIBEE	;;
;;		26=SUPERBEE 27=DIABLO   28=GE30	  29=ACT4	;;
;;		30=TEKTRONIX 4006	31=MICRO + TEK		;;
;;  								;;
;; 	WIDTH FIXED BINARY (15)					;;
;; 		OUTPUT: WIDTH OF THE TERMINAL IN CHARACTERS	;;
;;  								;;
;; 	LENGTH FIXED BINARY (15)				;;
;; 		OUTPUT: LENGTH OF THE TERMINAL IN LINES		;;
;;  								;;
;; 	SPEED FIXED BINARY (15)					;;
;; 		OUTPUT: COMPUTER TRANSMIT SPEED IN BAUD		;;
;;  								;;
;; LIBRARIES: [30,1]PLIUTL					;;
;;  								;;
;; ERRORS: SEE RETURNS ABOVE					;;
;;  								;;
;; SUBROUTINES:							;;
;; 	ILNAR$	SIGNAL ERROR CONDITION FOR TOO FEW ARGS.	;;
;; 	SAVRG$	SAVE REGISTERS FOR PLIUTL			;;
;;  								;;
;; LIMITATIONS: ROUTINE IS SYSTEM DEPENDENT TO RSX-11D V6.2,	;;
;; 		RSX-11M V3.2 AND IAS V3.0			;;
;;  								;;
;; WRITTEN: 13-FEB-79  -1.0.0-  DAVE PARKER			;;
;;  								;;
;; Modified: 07-Apr-81, -2.0.0-, Bruce C. Wright		;;
;;	Changes for VAX/VMS environment				;;
;;  								;;
;; Verified:							;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	.mcall	dir$
;
;
	.SBTTL	OFFSETS AND TABLES
;
; PLI STACK OFFSETS
;
NARGS	=	16				;ARGUMENTS
TYPE	=	NARGS+2
WIDTH	=	NARGS+4
LENGTH	=	NARGS+6
SPEED	=	NARGS+10
;
; TABLE OF SPEEDS AS RETURNED BY TT HANDLER
;
STBL:	.WORD	0.
	.WORD	50.
	.WORD	75.
	.WORD	100.
	.WORD	110.
	.WORD	134.
	.WORD	150.
	.WORD	200.
	.WORD	300.
	.WORD	600.
	.WORD	1200.
	.WORD	1800.
	.WORD	2000.
	.WORD	2400.
	.WORD	3600.
	.WORD	4800.
	.WORD	7200.
	.WORD	9600.
	.WORD	0.		;EXTERNAL A
	.WORD	0.		;EXTERNAL B

	.SBTTL	SUBROUTINE CODE
;
TERCHA:: JSR	R0,SAVRG$	;SAVE REGISTERS
	CMP	NARGS(SP),#4	;FOUR PARMS?
	BEQ	1$		;YES
	JSR	R5,ILNAR$	;NO
;
1$:	dir$	#exfc		; Execute directive.
	CLR	@TYPE(SP)	;CLEAR TYPE FIELD
	MOVB	BUF+1,@TYPE(SP)	;AND INSERT TYPE
;
	CLR	@WIDTH(SP)	;CLEAR WIDTH
	MOVB	BUF+3,@WIDTH(SP) ;AND INSERT WIDTH
;
	CLR	@LENGTH(SP)	;CLEAR LENGTH
	MOVB	BUF+5,@LENGTH(SP) ;AND INSERT IT
;
	CLR	@SPEED(SP)	;CLEAR SPEED
	MOVB	BUF+7,R2	;GET SPEED CODE TO R2
	ASL	R2		;CONVERT TO WORD
	MOV	STBL-2(R2),@SPEED(SP) ;AND INSERT SPEED
;
	RTS	PC		;AND EXIT

	.SBTTL	READ/WRITE DATA AREA
;
	.PSECT	$TERCH,RW,D,CON
exfc:	.byte	145.,8.		; Directive code for elephant directive
	.word	4		; Subfunction code - call native image
	.word	secnam		; Section name to call
	.word	seclen		; Length of section name
;
; Arguments to NATVMODE
;
	.word	4		; Function code - terminal handler
	.word	buf		; Address of buffer.
	.word	buflen		; Length of buffer
iost:	.word	0,0,0,0		; VMS I/O status block
BUF:					;BUFFER FOR CHARACTERISTICS
	.BYTE	TC.TTP,0
	.BYTE	TC.WID,0
	.BYTE	TC.LPP,0
	.BYTE	TC.XSP,0
BUFLEN	=	.-BUF
;
; Global section name
;
	.psect	$merli,ro,d,ovr
secnam:	.ascii	/_DBA0:[PLIUTL]NATVMODE.EXE/
seclen	=	.-secnam
;
	.EVEN
;
	.END