From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  1-MAR-1991 19:44:15.65
To:	ARISIA::EVERHART
CC:	
Subj:	Re: [NO]USER1

From:	RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP@CRDGW2
To:	Everhart@Arisia@MRGATE

Received:  by crdgw1.ge.com (5.57/GE 1.88)
	 id AA09622; Fri, 1 Mar 91 19:28:40 EST
Received: From DANPOST.UNI-C.DK by CRVAX.SRI.COM with TCP; Thu, 28 FEB 91 11:39:24 PST
Received: from vms2.uni-c.dk by danpost.uni-c.dk (5.65/4.7)
	id AA07096; Thu, 28 Feb 91 19:37:07 GMT
Date: Thu, 28 Feb 91 20:39 +0100
From: ISIS08@ecostat.aau.dk
Subject: Re: [NO]USER1
To: STUBRBEE@EKU.bitnet, INFO-VAX@SRI.COM
Message-Id: <B13B2D32C0FF0292E4@vms2.uni-c.dk>
X-Envelope-To: STUBRBEE@EKU.bitnet, INFO-VAX@SRI.COM
X-Vms-To: UNIL63::IN%"STUBRBEE@EKU.bitnet"
X-Vms-Cc: IN::"INFO-VAX@SRI.COM"

Bryce S. Cunningham posted a correction to a posting of mine:

>>I can not find a way to retrive this kind of information with a DCL lexical
>>function or a RTL-routine.
>
>>The program following can extract the information, but it needs CMKRNL.
>>One should think there was a "correct" way of extracting this information,
>>but I can not find it in the gray wall.
>
>There is a supported method, albeit not a RTL routine or lexical.
>
>Look at the "I/O User's Guide, Part I" (p. 8-55) for the proper item
>codes to pass to the $QIO system service.  The IO$_SENSEMODE function code
>with a modifier of IO$M_BRDCST will return the broadcast class bits set for
>a specific terminal.

Yes - you are rigth (and I were wrong). $QIO function SENSEMODE will do
the job. I knew that you had to use $QIO function SENSEMODE instead of
$GETDVI to get the baud-rate, but I was not aware of, that broadcast clases 
were the same. So I have also learned something today, and that is not so
bad.

So everyone. Here is a corrected version of the program I posted. It will
do exactly the same, but the method is supported by DEC and it do not
need CMKRNL privs - only SYSPRV and SHARE privs. Ok these privs is still
"large", but the risk with programming errors is much smaller with SYSPRV
than CMKRNL.

                                                                  Arne

Arne Vajhxj                             Internet: ISIS08@ECOSTAT.AAU.DK
Institute of Economics and Statistics   PSI:      DATAPAX.23830211371400::ISIS08
Aarhus University
Denmark

--------------------------------------------------------------------------------

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 28-FEB-1991 20:35:54.32   By user ISIS08 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. TST.FOR;1
$!       2. BRKTST2.MAR;1
$!       3. SUPP.MAR;1
$!       4. BUILD.COM;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X      PROGRAM TST
X      INCLUDE '($SSDEF)'
X      INCLUDE '($BRKDEF)'
X      INTEGER*4 STAT,DEVLEN,BRKMSK(2)
X      LOGICAL*4 FAC(0:63)
X      CHARACTER*64 DEVNAM
X      INTEGER*4 NXTTRM
X100   STAT=NXTTRM(DEVNAM,DEVLEN)
X      IF(STAT.EQ.SS$_NORMAL) THEN
X        WRITE(*,*) DEVNAM(1:DEVLEN)
X        CALL BRKTST(DEVNAM(1:DEVLEN),BRKMSK)
X        CALL UNPACK(BRKMSK,FAC)
X        IF(FAC(BRK$C_GENERAL)) WRITE(*,*) 'NOGENERAL'
X        IF(FAC(BRK$C_PHONE)) WRITE(*,*) 'NOPHONE'
X        IF(FAC(BRK$C_MAIL)) WRITE(*,*) 'NOMAIL'
X        IF(FAC(BRK$C_DCL)) WRITE(*,*) 'NODCL'
X        IF(FAC(BRK$C_QUEUE)) WRITE(*,*) 'NOQUEUE'
X        IF(FAC(BRK$C_SHUTDOWN)) WRITE(*,*) 'NOSHUTDOWN'
X        IF(FAC(BRK$C_URGENT)) WRITE(*,*) 'NOURGENT'
X        IF(FAC(BRK$C_USER1)) WRITE(*,*) 'NOUSER1'
X        GOTO 100
X      ENDIF
X      END
$ CALL UNPACK TST.FOR;1 2054061834
$ create 'f'
X        .title  brktst2
X        $DVIDEF
X        $IODEF
X        $SSDEF
X        .psect  $PDATA long,pic,con,lcl,shr,noexe,nowrt
Xdviitm: .word   64
X        .word   DVI$_TT_PHYDEVNAM
X        .address devnam
X        .address devdes
X        .long   0
X        .psect  $LOCAL long,pic,con,lcl,noshr,noexe,wrt
Xdevdes: .blkl   1
X        .address devnam
Xdevnam: .blkb   64
Xchan:   .blkw   1
Xbrkmsk: .blkq   1
X        .psect  $CODE long,pic,con,lcl,shr,exe,nowrt
X        .entry  brktst,`5Em<>
X        pushl   #0
X        pushl   #0
X        pushl   #0
X        pushl   #0
X        pushab  dviitm
X        pushl   4(ap)
X        pushl   #0
X        pushl   #0
X        calls   #8,G`5ESYS$GETDVIW
X        pushl   #0
X        pushl   #0
X        pushaw  chan
X        pushal  devdes
X        calls   #4,G`5ESYS$ASSIGN
X        pushl   chan
X        pushl   #0
X        pushl   #0
X        pushl   #0
X        pushl   #0
X        pushl   #8
X        pushal  brkmsk
X        pushl   #0
X        pushl   #0
X        pushl   #0
X        pushl   #IO$_SENSEMODE!IO$M_BRDCST
X        pushl   chan
X        pushl   #0
X        calls   #12,G`5ESYS$QIOW
X        pushl   chan
X        calls   #1,G`5ESYS$DASSGN
X        movq    brkmsk,@8(ap)
X        ret
X        .end
$ CALL UNPACK BRKTST2.MAR;1 706888337
$ create 'f'
X        .title  supp
XFALSE=0
XTRUE=-1
X        $DVSDEF
X        $DCDEF
X        .psect  $PDATA long,pic,con,lcl,shr,noexe,nowrt
Xdvsitm: .word   4
X        .word   DVS$_DEVCLASS
X        .address term
X        .long   0
X        .long   0
Xterm:   .long   DC$_TERM
X        .psect  $LOCAL long,pic,con,lcl,noshr,noexe,wrt
Xcontxt: .blkq   1
X        .psect  $CODE long,pic,con,lcl,shr,exe,nowrt
X        .entry  nxttrm,`5Em<iv>
X        pushaq  contxt
X        pushab  dvsitm
X        pushl   #0
X        pushl   8(ap)
X        pushl   4(ap)
X        calls   #5,G`5ESYS$DEVICE_SCAN
X        ret
X        .entry  unpack,`5Em<iv,r2,r3>
X        movq    @4(ap),r0
X        movl    8(ap),r2
X        movl    #63,r3
X100$:   movl    #FALSE,(r2)
X        blbc    r0,200$
X        movl    #TRUE,(r2)
X200$:   addl2   #4,r2
X        ashq    #-1,r0,r0
X        decl    r3
X        tstl    r3
X        bgeq    100$
X        ret
X        .end
$ CALL UNPACK SUPP.MAR;1 1679299535
$ create 'f'
X$ fortran tst
X$ macro brktst2
X$ macro supp
X$ link tst+brktst2+supp
X$ exit
$ CALL UNPACK BUILD.COM;1 2116433591
$ v=f$verify(v)
$ EXIT

