From:	ADVAX::"mcnc!WKUVX1.BITNET!MACROSRV" 13-JUN-1991 19:51:09.44
To:	ARISIA::EVERHART
CC:	
Subj:	SHODEFAST.01_OF_01

Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Thu, 13 Jun 91 19:48:00 EDT
Received:  from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP
	id AA04824 for ; Thu, 13 Jun 91 11:10:04 -0400
Received: from UKCC.uky.edu by mcnc.mcnc.org (5.59/MCNC/3-21-91)
	id AA25502; Thu, 13 Jun 91 08:07:53 -0400
	for ARISIA.dnet.ge.com!EVERHART
Message-Id: <9106131207.AA25502@mcnc.mcnc.org>
Received: from ukcc.uky.edu by UKCC.uky.edu (IBM VM SMTP V2R1)
   with BSMTP id 0226; Thu, 13 Jun 91 08:07:17 EST
Received: from UKCC by ukcc.uky.edu (Mailer R2.07) with BSMTP id 2595; Thu, 13
 Jun 91 08:07:16 EST
Received: from WKUVX1.BITNET by ukcc.uky.edu (Mailer R2.07) with BSMTP id 2594;
 Thu, 13 Jun 91 08:07:15 EST
Received: by WKUVX1.BITNET (MX V2.3-1) id 25767; Thu, 13 Jun 1991 07:06:13 CDT
Date: Thu, 13 Jun 1991 07:06:13 CDT
From: mcnc!WKUVX1.BITNET!MACROSRV-Mgr
Reply-To: mcnc!WKUVX1.BITNET!MACROSRV
Subject: SHODEFAST.01_OF_01
To: ARISIA::EVERHART
 
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 12-JUN-1991 14:56:45.88   By user GOATHUNTER (@WKUVX1.BITNET)
$!
$! 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. SHODEFAST.MAR;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`09.TITLE`09SHOW_DEFAULT_OOB_AST`09Causes Control D to show default
X`09.IDENT`09"1-002"
X
X;+
X; Abstract:`09This program sets up a supervisor mode out-of-band AST so that
X;`09`09Control-D will cause the current default disk and directory
X;`09`09to be displayed.
X;
X; Author:`09Dave Rolin`097-June-1991
X;
X; Modification History:
X;  001 DWR  7-June-1991`09Created this file
X;
X;  002 DWR 12-June-1991`09The program now checks to see if the Control-D
X;`09`09`09bit is already set in the terminal out of band mask.
X;`09`09`09If it is we return error status and exit.
X;
X; Notes:`09The routines to load the code and set the out-of-band AST
X;`09`09were written by Ehud Gavron.  These routines were taken
X;`09`09from his priority booster program, and modified slightly.
X;
X;`09`09You need CMEXEC priveledge to use this program, since the
X;`09`09AST routine is loaded into an area that has UREW protection.
X;
X;`09`09Please send any comments, suggestions, or changes to:
X;`09`09Rolin@nusc.nl.navy.mil
X;-
X
X
X
X`09.PSECT`09GAVRON_CODE
X
X; Many thanks to Ehud Gavron for the code to set up and load the AST routine
X
X`09.LINK`09`09"SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH
X`09.LIBRARY`09"SYS$LIBRARY:LIB.MLB"
X
X; The CHECK macro is used to check the return status after calls
X
X`09.MACRO CHECK ?LAB
X`09BLBS`09R0,LAB
X`09$EXIT_S`09R0
XLAB:
X`09.ENDM CHECK
X
X
X`09$IODEF
X`09$SSDEF
X`09$PSLDEF
X`09$LNMDEF
X`09$CCBDEF`09`09; Channel Control Block symbols
X`09$TTYUCBDEF`09; Terminal specific UCB symbols
X
XCHANNEL:`09.blkw`091`09; Store number of channel used (one word used)
Xsys_command:`09.ascid`09'TT'`09; Device to set the out of band ast on
X
Xqiolist:`09.long`0912`09;`0912 arguments in arglist
X`09efn:`09.long`090`09;`09efn (not used)
X`09chan:`09.blkl`091`09;`09channel number
X`09func:`09.blkl`091`09;`09function code
X`09iosb:`09.long`090`09; `09address of iosb (not used)
X`09astadr:`09.long`090`09;`09address of ast routine (not used)
X`09astprm:`09.long`090`09;`09value of ast param (not used)
X`09p1:`09.blkl`091`09;`09address of ast routine
X`09p2:`09.address oob`09;`09address of oob mask
X`09p3:`09.blkl`091`09;`09p3 (access mode io user gdI 8-46)
X`09p4:`09.blkl`093`09;`09p4-p6 (not used)
X
X`09oob:`09.long`090`09;`09Short form terminator (io user gdI 8-28)
X`09`09.long   16`09;`09Control-D (set bit n+1 since 0=`5E@)
X
X
X
X`09.entry`09control_d,`5Em<>
X
X`09$cmexec_s routin = load_control_d`09; Load the code
X`09check
X
X`09$cmexec_s routin = set_ast
X`09check
X`09ret
X;+
X;  Here we set the out of band ast.
X;-
X`09.entry`09set_ast,`5Em<>
X`09$assign_s `09devnam=sys_command,chan=channel
X`09blbc`09r0,`0910$
X
X`09movzwl`09channel,chan`09`09; put channel number into arglist
X`09movzwl`09#<io$_setmode!io$m_outband>,func`09; and function code
X`09movl`09#psl$c_super,p3`09`09; Use Supervisor mode (like `5ET)
X`09callg`09qiolist,g`5Esys$qiow`09; set ast
X`09blbc`09r0,`0910$`09`09; Do NOT deassign the channel...
X`09movl`09#ss$_normal,r0
X
X`09movl #ss$_Normal,r0
X10$:`09ret
X
X`09.entry`09load_control_d,`5Em<r2,r3,r4,r5,r7>
X
X;+
X; Modified 12-June-1991 by DWR.  Before we load the code, check to see if `5
VED
X; is already set up as an OOB character.  We do this by assigning a channel
V to
X; the terminal, and then using the CCB from that channel to find the UCB.
X; We then check the the UCB$L_TL_OUTBAND field to see which OOB characters
X; are enabled.  If `5ED is already set, we return error status.
X;-
X`09$assign_s `09devnam=sys_command,chan=channel
X`09BLBC`09R0, BYE
X`09MOVL`09@#CTL$GL_CCBBASE, R2`09; Locate the table of CCBs
X`09MOVZWL`09CHANNEL, R3`09`09; Stick the offset into the CCB table
X`09`09`09`09`09; for this channel into R3
X`09SUBL2`09R3, R2`09`09`09; Point R2 at this channel's CCB
X`09MOVL`09CCB$L_UCB(R2), R3`09; Point R3 at the UCB
X
X; Now do a bit compare on the OUTBAND mask and return error status if `5ED i
Vs set
X
X`09BBC`09#4, -`09`09`09; If the "D" bit (bit 4) is clear
X`09`09UCB$L_TL_OUTBAND(R3), -`09; in the OUTBAND mask, then we haven't
X`09`09NO_PRIOR`09`09; been here before
X
X`09$DASSGN_S`09CHAN=CHANNEL`09; Deassign the channel
X`09MOVL`09#SS$_VECINUSE, R0`09; Let the caller know that the request
XBYE:`09RET`09`09`09`09; to load this again has been denied
X
XNO_PRIOR:
X`09$DASSGN_S`09CHAN=CHANNEL`09`09; Deassign the channel
X`09movl`09#astlen,r1`09`09`09; Length of code piece
X`09jsb`09g`5Eexe$alop1proc`09`09`09; Attempt allocation of P1 pool
X`09blbc`09r0,10$`09`09`09`09; If failed exit error
X`09movl`09r2,r7`09`09`09`09; Save pointer to it
X`09movc3`09#astlen,aststart,(r7)`09`09; Put code in allocated region
X`09movl`09r7,p1`09`09`09`09; Save address
X`09movl`09#ss$_normal,r0
X10$:`09ret`09`09`09`09`09; Return to main code
X
X
X
X`09.PSECT`09SHOW_DEFAULT_AST
X;+
X; Title:
X;
X;`09SHOW_DEFAULT_AST
X;
X; Author:
X;
X;`09Dave Rolin
X;
X; Functional Description:
X;
X; `09This AST routine obtains the current default disk and directory
X;`09and displays it on the terminal.  The default disk is obtained
X;`09by calling $TRNLNM to translate SYS$DISK, and the directory string
X;`09is obtained from the PIO$GT_DDSTRING field in the process I/O
X;`09segment.
X;-
X
XASTSTART:`09.ENTRY`09ASTCODE, `5EM<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X
X; Define some stack offsets
X
XBUFF_LENGTH`09=`090
XITEM_CODE`09=`092
XBUFF_ADDR`09=`094
XRETURN_LENGTH`09=`098
XITEM_LIST_END `09=`0912
XSTRING_LENGTH`09=`0916
XSTRING_BUFF`09=`0918
X
X; Set up string descriptors on the stack for the arguments to $TRNLNM,
X; starting with tabnam.
X
X`09MOVL`09SP, R11`09`09; Save the SP on entry
X
X`09SUBL2`09#8, SP`09`09; Room for the tabnam descriptor
X`09MOVL`09#11, (SP)`09; Descriptor length
X`09MOVAL`09TABLE, 4(SP)`09; Pointer to the string
X`09MOVL`09SP, R2`09`09; Set up R2 to point to the tabnam descriptor
X
X; Set up the lognam desc on the stack
X
X`09SUBL2`09#8, SP`09`09; Room for lognam descriptor
X`09MOVL`09#8, (SP)`09; Descriptor length
X`09MOVAL`09NAME, 4(SP)`09; Pointer to the string
X`09MOVL`09SP, R3`09`09; Set up R3 to point to the lognam descriptor
X
X; Set up the item list on the stack, with the buffer for the string
X; immediately following it.
X
X`09SUBL2`09#132, SP`09`09; Room for item list and string buffer
X`09MOVW`09#112, -`09`09`09; Fill in the buffer length
X`09`09BUFF_LENGTH(SP)
X`09MOVW`09#LNM$_STRING, -`09`09; Fill in item code
X`09`09ITEM_CODE(SP)
X`09MOVAL`09STRING_BUFF(SP), -`09; Fill in return buffer address
X`09`09BUFF_ADDR(SP)
X`09MOVAL`09STRING_LENGTH(SP), -`09; Fill in return length address
X`09`09RETURN_LENGTH(SP)
X`09CLRL`09ITEM_LIST_END(SP)`09; Terminate the item list with a 0
X`09MOVL`09SP, R4`09`09`09; Set up R4 to point to the item list
X
X`09$TRNLNM_S -
X`09`09TABNAM = (R2),- `09; Use the LNM$PROCESS table
X`09`09LOGNAM = (R3),-`09`09; Translate SYS$DISK
X`09`09ITMLST = (R4)`09`09; Itemlist for call
X`09CHECK
X
X; Now stick the directory after the disk
X
X`09MOVAL`09STRING_BUFF(R4), -`09; R6 = disk string address
X`09`09R6
X`09ADDW2`09STRING_LENGTH(R4), -`09; Offset to the end of the string
X`09`09R6
X`09MOVZBL`09@#PIO$GT_DDSTRING, -`09; R7 = directory length
X`09`09R7
X
X`09PUSHR`09#`5EM<R0,R1,R2,R3,R4,R5>`09; Save registers from MOVC3
X`09MOVC3`09R7, -`09`09`09; Concatenate the directory
X`09`09@#PIO$GT_DDSTRING+1, -`09; string to the disk string
X`09`09(R6)
X`09POPR`09#`5EM<R0,R1,R2,R3,R4,R5>`09; Restore registers
X
X`09ADDW2`09R7, -`09`09`09; Update the string length to include
X`09`09STRING_LENGTH(R4)`09; directory string
X
X; Now assign a channel for outputting the info
X
X`09SUBL2   #12, SP`09`09; Room for devnam descriptor and returned chan.
X`09MOVL    #2, (SP)`09; Descriptor length
X`09MOVAB   8(SP), 4(SP)`09; Pointer to the device string
X`09MOVL    #`5EA'TT', 8(SP)`09; Assign the channel to the terminal
X`09MOVL`09SP, R5`09`09; Set up R5 to point to devnam and chan
X
X`09$ASSIGN_S -`09`09; Make the call
X`09`09CHAN = 12(R5),-
X`09`09 DEVNAM=(R5)
X`09CHECK
X
X; Now use QIO to blast out the info
X
X`09MOVZWL`09STRING_LENGTH(R4), -`09; Need to pass QIO the length in a
X`09`09R7`09`09`09; longword
X`09$QIOW_S`09-
X`09`09CHAN=12(R5), -
X`09`09FUNC=#<IO$_WRITELBLK!IO$M_REFRESH!IO$M_BREAKTHRU>,-
X`09`09P1=STRING_BUFF(R4), -
X`09`09P2=R7, -
X`09`09P4=#32`09`09`09; Put the string on a new line
X`09CHECK
X
X
X; Deassign the channel, restore the Stack Pointer, and return to caller
X
X`09$DASSGN_S       CHAN=12(R5)
X`09MOVL`09R11, SP
X`09RET
X
X; Strings used with $TRNLNM
X
XTABLE:`09.ASCII`09/LNM$PROCESS/`09`09; ASCII string for tabnam descriptor
XNAME:`09.ASCII`09/SYS$DISK/`09`09; ASCII string for lognam descriptor
X
XASTLEN = . - ASTSTART`09`09`09; Size of code to load in P1 pool
X
X`09.END`09CONTROL_D
$ CALL UNPACK SHODEFAST.MAR;1 594253170
$ v=f$verify(v)
$ EXIT
