SUBROUTINE SETTRM ( luntrm, trmnam, lentrm, trmnme, trmunt, + priv ) C+ C SUBROUTINE SETTRM C C Environment: System Utility DEF C Env. Vsn: 01.00 C C Subroutine/Function Description: C C This routine opens the default terminal TI: as an unknown file on C LUNTRM, and then issues the executive directive GETLUN to obtain C information on the local terminal. This nets me the default terminal C name and number. C C The SF.GMC QIO function will return the privilege status of the local C terminal. C C Parameter List: C Name Type I/O Purpose C -------------------------- ------------- ------ ------------------------ C C luntrm Integer*2 I LUN for terminal C trmnam Character*6 O Terminal name C lentrm Integer*2 O Length of TRMNAM C trmnme Integer*2 O Terminal mnemonic C trmunt Integer*2 O Terminal unit # C priv Logical O Privilege flag C C Data Structures: C COMMON Blocks: NONE C C C Side effects: Leaves LUNTRM open to TI:. C C C------------------------------------------------------------------------- C Environmental Requirements C C Re-compile Procedure: See MOVEBLD.CMD C Compile Command: F4P SETTRM=SETTRM C Library: MOVE.OLB C Modules called: GETLUN ( Executive ) C WTQIO ( Executive ) C GETADR ( Executive ) C C Test Procedures: C Test Data Files: NONE C Test Scripts: NONE C Documents: NONE C C Module Documentation: C Help File: NONE C Document File: [tbs} C C Required Logicals: NONE C C Required Files: NONE C C C Written By: Robert Hays C KMS Fusion, Inc. C P.O. Box 1567 C Ann Arbor, Mich. 48106 C C Ident: RLH001 C Date: September 29, 1986 C C C Change Log: C Date Initials Ident Description C [dd-mmm-yy] [tbs] [tbs] [tbs......] C---------------------------------------------------------------------------- C- C IDENT /01.00/ C CHARACTER*6 trmnam ! Terminal name. C BYTE buf(4) ! Characteristics return. C LOGICAL priv ! Privilege flag. C INTEGER*2 luntrm ! Terminal LUN. INTEGER*2 lentrm ! Length of TRMNAM. INTEGER*2 trmnme ! Terminal mnemonic. INTEGER*2 trmunt ! Terminal unit number. INTEGER*2 dat(6) ! Data buffer for GETLUN. INTEGER*2 sfgmc ! Get Multiple Characteristics ! function value. INTEGER*2 parm(6) ! Parameter buffer for QIO. INTEGER*2 iosb(2) ! IO status block for QIO. INTEGER*2 size ! Length of BUF in bytes. C DATA sfgmc/'2560'O/ ! See Drivers manual, p.B-13. DATA buf(1)/'51'O/, buf(2)/0/! See Drivers manual, p.2-54. DATA size/2/ ! Length of BUF to use. C C Executable begins here. C OPEN ( UNIT = luntrm, ! Open terminal for messages. + NAME = 'TI:', ! + STATUS = 'unknown' ) ! C CALL GETLUN ( luntrm, dat, ids ) ! DAT(1) = terminal name, ! DAT(2) = terminal number. dat(2) = IAND( dat(2), '377'O ) ! Low byte only. IF ( dat(2) .GE. 100 ) THEN ! Get length to convert. ilen = 3 ! Three digits. ELSE IF ( dat(2) .GE. 10 ) THEN ! ilen = 2 ! Two digits. ELSE ! ilen = 1 ! One digit. END IF ! WRITE ( trmnam(1:ilen+3), 25 ) dat(1), ! Convert number and name. + dat(2) ! 25 FORMAT ( A2,I,':' ) ! trmnme = dat(1) ! Save mnemonic and trmunt = dat(2) ! unit number. lentrm = ilen + 3 ! Length of default term. C CALL GETADR ( parm(1), buf(1) ) ! Get address for data buffer. parm(2) = size ! Load size, too. CALL WTQIO ( sfgmc, luntrm, 1, , iosb, ! Issue WTQIO for get multiple + parm, ids ) ! characteristics. IF ( buf(2) .EQ. 1 ) THEN ! Terminal is privileged. priv = .TRUE. ! ELSE ! No, its not privileged. priv = .FALSE. ! END IF ! C RETURN END