From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 14-AUG-1989 22:19
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Update to GETBCLASS program

Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Mon, 14 AUG 89 18:45:09 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Mon, 14 Aug 89 18:41:10 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.37)
	id AA05065; Mon, 14 Aug 89 18:35:22 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 14 Aug 89 21:35:16 GMT
From: ecsvax!uncw!session@mcnc.org  (Zack Sessions)
Organization: UNC-Wilmington, Math&CS Dept
Subject: Update to GETBCLASS program
Message-Id: <479@uncw.UUCP>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

Due to some users problems with the previous version of VMS_SHARE,
and one snide comment about my programming technique (grin), here
is a repost of my Get BroadcastClasses Utility. Shared with
V7.1-004 of share.


$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.1-004  3-AUG-1989
$!   On 14-AUG-1989 15:50:38.32   By user SESSIONS (Zack C. Sessions)
$!
$! 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. GETBCLASS.CLD;1
$!       2. GETBCLASS.MAR;14
$!       3. GETBCLASS.README;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 = "!"
$ if f$getsyi("version") .ges. "V4.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/nolog '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/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ 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");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);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 g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
X! getbclass.cld
X! by Zack C. Sessions
X
Xdefine verb getbclass
X
X`009image sys$login:getbclass
X
X`009qualifier`009display
X`009qualifier`009global
$ CALL UNPACK GETBCLASS.CLD;1 722941316
$ create/nolog 'f'
X`009`009.Title getbclass`009; get broadcast class information
X`009`009.Ident`009'V02-000'
X`009`009.sbttl`009Documentation
X;++
X;
X;`009getbclass.mar
X;
X;`009by Zack C. Sessions
X;`009released to the public domain, August 27, 1989
X;
X;`009This program run in the context of a DCL Command from
X;`009your processes current CLI table. It returns the current
X;`009values for the terminal's Broadcast Class Status.
X;`009The default return is in a local symbol BCLASS which
X;`009contains a character string of all of the broadcast
X;`009classes. This string can be used in a subsequent SET
X;`009BROADCAST command to reset the values. Output can
X;`009optionally be a global symbol. Displayed to SYS$OUTPUT
X;`009is also selectable with an optional qualifier. A
X;`009symbol is ALWAYS set, be it local or global.
X;
X;`009Command Syntax:
X;
X;`009$ getbclass`091/display`093`091/global`093
X;
X;`009CLD file:
X;
X;`009define verb getbclass
X;`009`009image sys$system:getbclass
X;`009`009qualifier display
X;`009`009qualifier global
X;
X;`009(of course, the directory mentioned above is whatever
X;`009directory you want to run it out of)
X;
X;--
X`009`009.Page
X`009`009.Sbttl`009Declarations
X`009`009$ssdef
X`009`009$iodef
X`009`009$brkdef
X`009`009$climsgdef
X`009`009$clidef
X`009`009$libclidef
X`009`009.page
X`009`009.sbttl`009Data Storage
X`009`009 .Psect`009$DATA PIC,USR,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,NOVEC,LONG
X
XAuthor:`009`009.ascii`009/Author: Zack C. Sessions/ ; Credit where credit is
V due
Xfunc:`009`009.long`009IO$_SENSEMODE ! IO$M_BRDCST`009; IO function code
Xtermname:`009.ascid`009/SYS$COMMAND:/`009`009`009; device name
Xclass_codes:`009.word`009BRK$C_DCL,BRK$C_GENERAL,BRK$C_MAIL,BRK$C_OPCOM
X`009`009.word`009BRK$C_PHONE`009`009`009; PHONE
X`009`009.word`009BRK$C_QUEUE`009`009`009; QUEUE
X`009`009.word`009BRK$C_SHUTDOWN`009`009`009; SHUTDOWN
X`009`009.word`009BRK$C_URGENT`009`009`009; URGENT
X`009`009.word`009BRK$C_USER1`009`009`009; USER1
X`009`009.word`009BRK$C_USER2`009`009`009; USER2
X`009`009.word`009BRK$C_USER3`009`009`009; USER3
X`009`009.word`009BRK$C_USER4`009`009`009; USER4
X`009`009.word`009BRK$C_USER5`009`009`009; USER5
X`009`009.word`009BRK$C_USER6`009`009`009; USER6
X`009`009.word`009BRK$C_USER7`009`009`009; USER7
X`009`009.word`009BRK$C_USER8`009`009`009; USER8
X`009`009.word`009BRK$C_USER9`009`009`009; USER9
X`009`009.word`009BRK$C_USER10`009`009`009; USER10
X`009`009.word`009BRK$C_USER11`009`009`009; USER11
X`009`009.word`009BRK$C_USER12`009`009`009; USER12
X`009`009.word`009BRK$C_USER13`009`009`009; USER13
X`009`009.word`009BRK$C_USER14`009`009`009; USER14
X`009`009.word`009BRK$C_USER15`009`009`009; USER15
X`009`009.word`009BRK$C_USER16`009`009`009; USER16
Xclass_names:`009.ascii`009/DCL,/`009`009`009; names of classes
X`009`009.ascii`009/GENERAL,/`009`009;
X`009`009.ascii`009/MAIL,/
X`009`009.ascii`009/OPCOM,/
X`009`009.ascii`009/PHONE,/
X`009`009.ascii`009/QUEUE,/
X`009`009.ascii`009/SHUTDOWN,/
X`009`009.ascii`009/URGENT,/
X`009`009.ascii`009/USER1,/
X`009`009.ascii`009/USER2,/
X`009`009.ascii`009/USER3,/
X`009`009.ascii`009/USER4,/
X`009`009.ascii`009/USER5,/
X`009`009.ascii`009/USER6,/
X`009`009.ascii`009/USER7,/
X`009`009.ascii`009/USER8,/
X`009`009.ascii`009/USER9,/
X`009`009.ascii`009/USER10,/
X`009`009.ascii`009/USER11,/
X`009`009.ascii`009/USER12,/
X`009`009.ascii`009/USER13,/
X`009`009.ascii`009/USER14,/
X`009`009.ascii`009/USER15,/
X`009`009.ascii`009/USER16/
Xclass_names_sizes:
X`009`009.word`0094,8,5,6,6,6,9,7,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,6
Xall:`009`009.ascii`009/ALL/`009`009`009; a couple of special
Xnone:`009`009.ascii`009/NONE/`009`009`009; names
Xqname1:`009`009.ascid`009/DISPLAY/`009`009; qualifier 1 name
Xqname2:`009`009.ascid`009/GLOBAL/`009`009; qualifier 2 name
Xsymbol:`009`009.ascid`009/BCLASS/`009`009; name of symbol
Xcounter:`009.blkb`0091`009`009`009; counter
XBuffer:`009`009.blkq`0091`009`009`009; quadword for status mask
Xchan:`009`009.blkw`0091`009`009`009; channel
Xvalue:`009`009.blkb`009210`009`009`009; area to build output
Xgotanyoff:`009.byte`0090`009`009`009; logical on if any were off
Xgotanyon:`009.byte`0090`009`009`009; logical on if any were on
Xsdesc:`009`009`009`009; descriptor for output string
Xslen:`009`009.blkw`0091`009; put it's length here
X`009`009.word`0090
X`009`009.address value
Xdisplay:`009.byte`0090`009; logical on if qualifier present
Xtable:`009`009.blkl`0091`009; table indicator for lib$set_symbol
X
X
X`009`009.Page
X`009`009.Sbttl`009main code
X`009`009.Psect`009$CODE PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC,LONG
X`009`009.Entry`009getbclass,`094M<R6,R7,R8,R9,R10,R11>
X
X`009`009pushaq`009qname1`009`009`009`009; find out if qualifier
X`009`009calls`009#1,G`094cli$present`009`009; 1 is present
X`009`009cmpl`009R0,#CLI$_PRESENT
X`009`009bneq`0092$
X`009`009movb`009#1,display`009`009`009; if so, turn on logical
X2$:
X`009`009movl`009#LIB$K_CLI_LOCAL_SYM,table`009; initialize table indicator t
Vo local table
X`009`009pushaq`009qname2`009`009`009`009; check for presence of qualifer
X`009`009calls`009#1,G`094cli$present`009`009; 2
X`009`009cmpl`009R0,#CLI$_PRESENT
X`009`009bneq`0096$
X`009`009movl`009#LIB$K_CLI_GLOBAL_SYM,table`009; if so, change tabke indicat
Vor to global
X6$:
X`009`009$assign_s devnam=termname,-`009`009; assign a channel to the termina
Vl
X`009`009`009chan=chan
X`009`009blbs`009R0,10$
X`009`009brw`009error
X10$:
X`009`009$qio_s`009chan=chan,-`009`009`009; get the broadcast class status ma
Vsk
X`009`009`009func=func,-
X`009`009`009p1=Buffer,-
X`009`009`009p2=#8
X`009`009blbs`009R0,20$
X`009`009brw`009error
X20$:
X`009`009clrb`009counter`009`009`009`009; clear class  counter
X`009`009movaw`009class_codes,R9`009`009`009; address of codes
X`009`009movab`009class_names,R10`009`009`009; address of names
X`009`009movaw`009class_names_sizes,R11`009`009; address of sizes
X`009`009movab`009value,R7`009`009`009; get address of work area
X`009`009movl`009R7,R8`009`009`009`009; save it
Xget_code:
X`009`009movzwl`009(R9),R6`009`009`009`009; Get Class Code
X`009`009bbc`009R6,Buffer,22$`009`009`009; if bit is clear, class is active;
V set, is inactive
X`009`009movb`009#1,gotanyoff`009`009`009; set logical that at least one is i
Vnactive
X`009`009movc3`009#2,none,(R7)`009`009`009; move "NO", then, first
X`009`009addl`009#2,R7`009`009`009`009; increment index
X`009`009brb`00924$
X22$:
X`009`009movb`009#1,gotanyon`009`009`009; turn on logical that at least one i
Vs active
X24$:
X`009`009movc3`009(R11),(R10),(R7)`009`009; move class name
X`009`009movzwl`009(R11),R6`009`009`009; extend to longword
X`009`009addl`009R6,R7`009`009`009`009; increment output index
X`009`009incb`009counter`009`009`009`009; inc class counter
X`009`009cmpb`009#24,counter`009`009`009; done all yet?
X`009`009beql`009nomore`009`009`009`009; yes, go finish up
X`009`009addl`009R6,R10`009`009`009`009; increment indexes
X`009`009addl`009#2,R11`009`009`009`009;
X`009`009addl`009#2,R9`009`009`009`009;
X`009`009brb`009get_code`009`009`009; go do another one
Xnomore:
X`009`009`009`009`009`009`009; got em all
X`009`009cmpb`009#0,gotanyoff`009`009`009; were any off?
X`009`009bneq`009120$`009`009`009`009; if so, go on
X`009`009movc3`009#3,all,value`009`009`009; none were off, so all must be on
X`009`009movw`009#3,slen`009`009`009`009; move keyword ALL in output
X`009`009brb`009140$`009`009`009`009; go set symbol
X120$:
X`009`009cmpb`009#0,gotanyon`009`009`009; were any on?
X`009`009bneq`009130$`009`009`009`009; yes, some where, go process them
X`009`009movc3`009#4,none,value`009`009`009; none were on, so use keyword NON
VE
X`009`009movw`009#4,slen
X`009`009brb`009140$`009`009`009`009; go set symbol
X130$:
X`009`009subl2`009R8,R7`009`009`009`009; get difference between ending and
X`009`009movw`009R7,slen`009`009`009`009; this is length of output
X140$:
X`009`009pushal`009table`009`009`009`009; table indicator
X`009`009pushaq`009sdesc`009`009`009`009; value descriptor
X`009`009pushaq`009symbol`009`009`009`009; name descriptor
X`009`009calls`009#3,G`094lib$set_symbol`009`009; set the symbol
X`009`009blbs`009R0,200$
X`009`009brw`009error
X200$:
X`009`009cmpb`009#0,display`009`009`009; check display flag
X`009`009beql`009210$`009`009`009`009; if off, go exit
X`009`009pushaq`009sdesc`009`009`009`009; if on, display output
X`009`009calls`009#1,G`094lib$put_output`009`009; to SYS$OUTPUT
X`009`009blbs`009R0,210$
X`009`009brw`009error
X210$:
Xexit:
X`009`009$exit_s
XError:
X`009`009$exit_s`009R0
X`009`009.End`009getbclass
$ CALL UNPACK GETBCLASS.MAR;14 203294323
$ create/nolog 'f'
XThis program is a little dittie I whipped up recently. Actually
Xit started out as an exercise of analyzing the broadcast classes
Xmask. After someone mentioned a need for something like it, I
Xfrilled it up a bit. Written in MACRO-32, so if you got VMS, you
Xcan use it. Just build with:
X
X$ macro getbclass
X$ link getbclass
X
XYou will need the Verb defined. If you don't have system privileges,
Xedit the .CLD file and substitute SYS$LOGIN for SYS$SYSTEM, and
Xput the following line in your login.com:
X
X$ set command getbclass
X
XThe program ALWAYS sets a symbol, BCLASS, with the value of the
Xcurrent state of ALL broadcast classes. The symbol is local by
Xdefault, but will be global if the optional /GLOBAL qualifier is
Xpresent. The keywords ALL and NONE will used if applicable. The
Xvalue of the symbol can be used in a subsequent SET BROADCAST command
Xto restore the values. eg,
X
X$ set broad=('bclass')
X
XThe program will optionally display the value assigned to the
Xsymbol to SYS$OUTPUT, if the optional qualfier /DISPLAY is present.
$ CALL UNPACK GETBCLASS.README;1 2086422151
$ v=f$verify(v)
$ EXIT


Zack Sessions                          | Utilizing the computing facilities
General Electric                       | at the University of North Carolina 
Nuclear Fuels & Component Manufacturing| at Wilmington 
Wilmington, NC                         |
(919) 675-5517                         |

"If it ain't broke, then don't fix it!"