From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 27-JUL-1989 20:23
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Get Broadcast Classes (Part 1 of 2)

Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 27 JUL 89 15:13:26 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Thu, 27 Jul 89 14:51:36 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.37)
	id AA20851; Thu, 27 Jul 89 14:49:48 -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: 27 Jul 89 19:05:17 GMT
From: ecsvax!uncw!session@mcnc.org  (Zack Sessions)
Organization: UNC-Wilmington, Math&CS Dept
Subject: Get Broadcast Classes (Part 1 of 2)
Message-Id: <446@uncw.UUCP>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

This is a little something I threw together after someone requested
such a beast a few days ago. It sets a symbol to a character string
containing the current broadcast class values. Value can be later
substituted in a SET BROADCAST command. In VMS Share format (nice tool!)

$! ------------------ CUT HERE -----------------------
$!
$! This archive created by VMS_SHARE Version 7.1-001  26-JUN-1989
$!   On 27-JUL-1989 14:44:34.33   By user 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
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! 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;2
$!       2. GETBCLASS.MAR;44
$!       3. GETBCLASS.README;1
$!
$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. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ 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;2 722941316
$ create/nolog 'f'
X`009`009.Title getbclass`009; get broadcast class information
X`009`009.Ident`009'V01-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
Xdcl:`009`009.ascii`009/DCL,/`009`009`009; names of classes
Xgeneral:`009.ascii`009/GENERAL,/`009`009;
Xmail:`009`009.ascii`009/MAIL,/
Xopcom:`009`009.ascii`009/OPCOM,/
Xphone:`009`009.ascii`009/PHONE,/
Xqueue:`009`009.ascii`009/QUEUE,/
Xshutdown:`009.ascii`009/SHUTDOWN,/
Xurgent:`009`009.ascii`009/URGENT,/
Xuser1:`009`009.ascii`009/USER1,/
Xuser2:`009`009.ascii`009/USER2,/
Xuser3:`009`009.ascii`009/USER3,/
Xuser4:`009`009.ascii`009/USER4,/
Xuser5:`009`009.ascii`009/USER5,/
Xuser6:`009`009.ascii`009/USER6,/
Xuser7:`009`009.ascii`009/USER7,/
Xuser8:`009`009.ascii`009/USER8,/
Xuser9:`009`009.ascii`009/USER9,/
Xuser10:`009`009.ascii`009/USER10,/
Xuser11:`009`009.ascii`009/USER11,/
Xuser12:`009`009.ascii`009/USER12,/
Xuser13:`009`009.ascii`009/USER13,/
Xuser14:`009`009.ascii`009/USER14,/
Xuser15:`009`009.ascii`009/USER15,/
Xuser16:`009`009.ascii`009/USER16/
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
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>
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`009movab`009value,R7`009`009`009; get address of work area
X`009`009movl`009R7,R8`009`009`009`009; save it
X`009`009movzwl`009#BRK$C_DCL,R6`009`009`009; check for DCL Class
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#4,dcl,(R7)`009`009`009; move "DCL"
X`009`009addl`009#4,R7`009`009`009`009; increment index
X
X`009`009movzwl`009#BRK$C_GENERAL,R6`009`009; GENERAL
X`009`009bbc`009R6,Buffer,28$`009`009`009; all the rest are just like DCL, so
V I'm not
X`009`009movb`009#1,gotanyoff`009`009`009; going to comment all of them.
X`009`009movc3`009#2,none,(R7)`009`009`009; except to identifi them
X`009`009addl`009#2,R7
X`009`009brb`00930$
X28$:
X`009`009movb`009#1,gotanyon
X30$:
X`009`009movc3`009#8,general,(R7)
X`009`009addl`009#8,R7
X
X`009`009movzwl`009#BRK$C_MAIL,R6`009`009`009; MAIL
X`009`009bbc`009R6,Buffer,34$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00934$
X32$:
X`009`009movb`009#1,gotanyon
X34$:
X`009`009movc3`009#5,mail,(R7)
X`009`009addl`009#5,R7
X
X`009`009movzwl`009#BRK$C_OPCOM,R6`009`009`009; OPCOM
X`009`009bbc`009R6,Buffer,38$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00938$
X36$:
X`009`009movb`009#1,gotanyon
X38$:
X`009`009movc3`009#6,opcom,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_PHONE,R6`009`009`009; PHONE
X`009`009bbc`009R6,Buffer,40$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00942$
X40$:
X`009`009movb`009#1,gotanyon
X42$:
X`009`009movc3`009#6,phone,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_QUEUE,R6`009`009`009; QUEUE
X`009`009bbc`009R6,Buffer,44$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00946$
X44$:
X`009`009movb`009#1,gotanyon
X46$:
X`009`009movc3`009#6,queue,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_SHUTDOWN,R6`009`009; SHUTDOWN
X`009`009bbc`009R6,Buffer,48$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00950$
X48$:
X`009`009movb`009#1,gotanyon
X50$:
X`009`009movc3`009#9,shutdown,(R7)
X`009`009addl`009#9,R7
X
X`009`009movzwl`009#BRK$C_URGENT,R6`009`009; URGENT
X`009`009bbc`009R6,Buffer,52$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00954$
X52$:
X`009`009movb`009#1,gotanyon
X54$:
X`009`009movc3`009#7,urgent,(R7)
X`009`009addl`009#7,R7
X
X`009`009movzwl`009#BRK$C_USER1,R6`009`009`009; USER1
X`009`009bbc`009R6,Buffer,56$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00958$
X56$:
X`009`009movb`009#1,gotanyon
X58$:
X`009`009movc3`009#6,user1,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_USER2,R6`009`009`009; USER2
X`009`009bbc`009R6,Buffer,60$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00962$
X60$:
X`009`009movb`009#1,gotanyon
X62$:
X`009`009movc3`009#6,user2,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_USER3,R6`009`009`009; USER3
X`009`009bbc`009R6,Buffer,64$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00966$
X64$:
X`009`009movb`009#1,gotanyon
X66$:
X`009`009movc3`009#6,user3,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_USER4,R6`009`009`009; USER4
X`009`009bbc`009R6,Buffer,68$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00970$
X68$:
X`009`009movb`009#1,gotanyon
X70$:
X`009`009movc3`009#6,user4,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_USER5,R6`009`009`009; USER5
X`009`009bbc`009R6,Buffer,72$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00974$
X72$:
X`009`009movb`009#1,gotanyon
X74$:
X`009`009movc3`009#6,user5,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_USER6,R6`009`009`009; USER6
X`009`009bbc`009R6,Buffer,76$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00978$
X76$:
X`009`009movb`009#1,gotanyon
X78$:
X`009`009movc3`009#6,user6,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_USER7,R6`009`009`009; USER7
X`009`009bbc`009R6,Buffer,80$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00982$
X80$:
X`009`009movb`009#1,gotanyon
X82$:
X`009`009movc3`009#6,user7,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_USER8,R6`009`009`009; USER8
X`009`009bbc`009R6,Buffer,84$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00986$
X84$:
X`009`009movb`009#1,gotanyon
X86$:
X`009`009movc3`009#6,user8,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_USER9,R6`009`009`009; USER9
X`009`009bbc`009R6,Buffer,88$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00990$
X88$:
X`009`009movb`009#1,gotanyon
X90$:
X`009`009movc3`009#6,user9,(R7)
X`009`009addl`009#6,R7
X
X`009`009movzwl`009#BRK$C_USER10,R6`009`009; USER10
X`009`009bbc`009R6,Buffer,92$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00994$
X92$:
X`009`009movb`009#1,gotanyon
X94$:
X`009`009movc3`009#7,user10,(R7)
X`009`009addl`009#7,R7
X
X`009`009movzwl`009#BRK$C_USER11,R6`009`009; USER11
X`009`009bbc`009R6,Buffer,96$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`00998$
X96$:
X`009`009movb`009#1,gotanyon
X98$:
X`009`009movc3`009#7,user11,(R7)
X`009`009addl`009#7,R7
X
X`009`009movzwl`009#BRK$C_USER12,R6`009`009; USER12
X`009`009bbc`009R6,Buffer,100$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`009102$
X100$:
X`009`009movb`009#1,gotanyon
X102$:
X`009`009movc3`009#7,user12,(R7)
X`009`009addl`009#7,R7
X
X`009`009movzwl`009#BRK$C_USER13,R6`009`009;  USER13
X`009`009bbc`009R6,Buffer,104$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`009106$
X104$:
X`009`009movb`009#1,gotanyon
X106$:
X`009`009movc3`009#7,user13,(R7)
X`009`009addl`009#7,R7
X
X`009`009movzwl`009#BRK$C_USER14,R6`009`009; USER14
X`009`009bbc`009R6,Buffer,108$
X`009`009movb`009#1,gotanyoff
X`009`009movc3`009#2,none,(R7)
X`009`009addl`009#2,R7
X`009`009brb`009110$
X108$:
X`009`009movb`009#1,gotanyon
X110$:
X`009`009movc3`009#7,user14,(R7)
X`009`009addl`009#7,R7
X
X`009`009movzwl`009#BRK$C_USER15,R6`009`009; USER15
X`009`009bbc`009R6,Buffer,112$
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-

