From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 27-FEB-1989 15:23
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Access Port Names (part 2 of 2)


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Fri, 24 FEB 89 18:32:29 PDT
Received: from TopGun.Sdsc.Edu by KL.SRI.COM with TCP; Fri, 24 Feb 89 18:27:14 PST
Date:    Sat, 25 Feb 89 02:26:10 GMT
From:     gkn@TopGun.Sdsc.Edu (Gerard K. Newman)
Message-Id: <890225022610.29a00119@TopGun.Sdsc.Edu>
Subject: Access Port Names (part 2 of 2)
To:       info-vax@kl.sri.com
X-ST-Vmsmail-To: ST%"info-vax@kl.sri.com"

+-+-+-+ Beginning of part 2 +-+-+-+
X`009MOVAQ`009DEVICE_DESC,R1`009`009`009;Presume it's not a terminal
X`009MOVL`009#ACCP$_NOTERM,R0`009`009;Presume not a terminal
X`009CMPL`009#DC$_TERM,DEVICE_CLASS`009`009;Is it?
X`009BNEQ`00920$`009`009`009`009;Nope.
X`009MOVL`009#ACCP$_OFFLINE,R0`009`009;Presume device off line
X`009BBC`009#UCB$V_ONLINE,DEVICE_STS,20$`009;Branch if so
V`009MOVAL`009TT_DESC,R1`009`009`009;It's a terminal, so use this name for err
Xors
X`009MOVL`009#ACCP$_TEMPLATE,R0`009`009;Presume template device
X`009BBS`009#UCB$V_TEMPLATE,DEVICE_STS,20$`009;Branch if so
X`009MOVL`009#SS$_NORMAL,R0`009`009`009;Else we're
X`009RET`009`009`009`009`009; Ok
X
X; Here on a system service error.
X
X10$:`009PUSHL`009R0`009`009`009;Stack the error code
X`009CALLS`009#1,G`094LIB$SIGNAL`009`009;Signal same
X`009RET`009`009`009`009;Done
X
X; Here when it appears that we don't have an acceptible device.
X
X20$:`009PUSHL`009R1`009`009`009;Stack the device descriptor address
X`009PUSHL`009#1`009`009`009;1 FAO argument
X`009PUSHL`009R0`009`009`009;Stack the error code
X`009CALLS`009#3,G`094LIB$SIGNAL`009`009;Signal the error
X`009RET`009`009`009`009;Done
X
X`009.Page
X`009.Subtitle`009SHOW_ACCP`009- Show the Access Port Name
X
X;+
X;
X; ----- SHOW_ACCP:  Show the Access Port Name
X;
X;
X; This routine is called as a TPARSE action routine to show the
X; Access Port Name for the current device.
X;
X; Inputs:
X;
X;`009TPA$L_TOKENCNT(AP)`009- A descriptor of the device name
X;
X; Outputs:
X;
X;`009Access Port Name displayed.
X;
X;-
X
XSHOW_ACCP: .Word `094m<>`009`009`009;Show the Access Port Name
X
X; Get the scoop on the device.
X
X`009$GETDVIW_S DEVNAM=TPA$L_TOKENCNT(AP),-`009;Fetch the
X`009`009ITMLST=DVI_LIST`009`009`009; poop on this device
X`009BLBC`009R0,10$`009`009`009`009;Lose!
X
X; Lose if it's not a terminal, off line, or a template device.
X
X`009MOVAQ`009DEVICE_DESC,R1`009`009`009;Presume it's not a terminal
X`009MOVL`009#ACCP$_NOTERM,R0`009`009;Presume not a terminal
X`009CMPL`009#DC$_TERM,DEVICE_CLASS`009`009;Is it?
X`009BNEQ`00920$`009`009`009`009;Nope.
X`009MOVL`009#ACCP$_OFFLINE,R0`009`009;Presume device off line
X`009BBC`009#UCB$V_ONLINE,DEVICE_STS,20$`009;Branch if so
X`009MOVAQ`009TT_DESC,R1`009`009`009;It's a terminal, so use this name
X`009MOVL`009#ACCP$_TEMPLATE,R0`009`009;Presume template device
X`009BBS`009#UCB$V_TEMPLATE,DEVICE_STS,20$`009;Branch if so
X
X; It's a terminal -- signal the Access Port Name.
X
X`009PUSHAQ`009ACCP_DESC`009`009;Stack the Access Port Name descriptor address
X`009PUSHAQ`009TT_DESC`009`009`009;Stack the device name descriptor address
X`009PUSHL`009#2`009`009`009;2 FAO arguments
X`009PUSHL`009#ACCP$_ACCP`009`009;Stack the message code
X`009CALLS`009#4,G`094LIB$SIGNAL`009`009;Signal the message
X`009RET`009`009`009`009;Done
X
X; Here when $GETDVI loses.
X
X10$:`009PUSHL`009R0`009`009`009;Stack the error
X`009CALLS`009#1,G`094LIB$SIGNAL`009`009;Signal it
X`009RET`009`009`009`009;Done
X
X; Here when the device isn't a terminal or is otherwise unacceptable.
X
X20$:`009PUSHL`009R1`009`009`009;Stack the device descriptor address
X`009PUSHL`009#1`009`009`009;1 FAO argument
X`009PUSHL`009R0`009`009`009;Stack the error code
X`009CALLS`009#3,G`094LIB$SIGNAL`009`009;Signal the error
X`009RET`009`009`009`009;Done
X
X`009.Page
X`009.Subtitle`009SET_ACCP`009- Set the Access Port Name
X
X;+
X;
X; ----- SET_ACCP:  Set the Access Port Name
X;
X;
X; This routine is called as a TPARSE action routine to set the Access
X; Port Name for the specified device.  If  the device  already has an
X; Access  Port Name  buffer then  we simply replace its contents.  If
X; not, then  we allocate a  64 byte  chunk of  non-paged pool and use
X; that.
X;
X; Inputs:
X;
X;`009TT_DESC`009`009`009- Descriptor of the device to hack
X;`009TPA$L_TOKENCNT(AP)`009- Descriptor of the Access Port Name
X;
X; Outputs:
X;
X;`009Access Port Name bashed.
X;
X;-
X
XSET_ACCP: .Word`009`094m<>`009`009`009;Set the Access Port Name
X
X`009CMPL`009TPA$L_TOKENCNT(AP),#63`009;Too big?
X`009BGTRU`00910$`009`009`009;If GTRU yes
X`009$CMKRNL_S B`09420$,(AP)`009`009;Do this in kernel mode
X`009RET`009`009`009`009;Done, status in R0
X
X; Here when the string is too long.
X
X10$:`009PUSHAQ`009TPA$L_TOKENCNT(AP)`009;Stack the string descriptor address
X`009PUSHL`009#1`009`009`009;1 FAO argument
X`009PUSHL`009#ACCP$_TOOLONG`009`009;Stack the error code
X`009CALLS`009#1,G`094LIB$SIGNAL`009`009;Signal the error
X`009RET`009`009`009`009;Done
X
X; Here in kernel mode to do the hard work.
X
V20$:`009.Word`009`094m<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11> ;Here in kernel mode
X to do the hard work.
X
X; Hunt down the device.
X
X`009MOVL`009G`094CTL$GL_PCB,R4`009`009  ;Fetch my PCB address
X`009JSB`009G`094SCH$IOLOCKW`009`009  ;Lock the I/O database for write access
X`009MOVAB`009TT_DESC,R1`009`009  ;Here's the device to find
X`009JSB`009G`094IOC$SEARCHDEV`009`009  ;Find the device
X`009BLBC`009R0,40$`009`009`009  ;Lose.
X`009MOVL`009R1,R5`009`009`009  ;Remember the UCB address
X
V; Check to make sure that the UCB is long enough to accomodate an Access Port
X Name.
X
X`009MOVL`009#ACCP$_BADUCB,R0`009  ;Presume the UCB is too small
X`009CMPW`009UCB$W_SIZE(R5),-`009  ;Is the UCB
X`009`009#UCB$L_TT_ACCPORNAM+4`009  ; big enough?
X`009BLSSU`00940$`009`009`009  ;If LSSU no, we have to lose.`032
V`009MOVL`009UCB$L_TT_ACCPORNAM(R5),R2 ;Fetch the Access Port Name buffer addr
Xess
X`009BLSS`00930$`009`009`009  ;If LSS use the one that's there
X
X; We have to  allocate an Access Port Name buffer.  This is a problem for
X; ephemeral devices, in that when the UCB goes away then we will lose the
X; non-paged  pool for the  Access Port Name  buffer.  We  can't make this
X; check in  CHECK_DEVICE because of  the cretinous misfeature  of $GETDVI
X; which returns UCB$W_STS  for the  *virtual*  terminal when  you ask for
X; information on the  *physical*  terminal.  If I  had wanted information
X; for the *virtual* terminal I would have asked for it...
X
X`009MOVL`009#ACCP$_EPHEMERAL,R0`009;Presume that the device is ephemeral
X`009BBS`009#UCB$V_DELETEUCB,-`009;Branch if this
X`009`009UCB$W_STS(R5),40$`009; is the case
X
X; Allocate an Access Port Name buffer
X
X`009MOVL`009#64,R1`009`009`009  ;We'd like 64 bytes
X`009JSB`009G`094EXE$ALONPAGVAR`009  ;Get some pool
X`009BLBC`009R0,40$`009`009`009  ;Lossage!
X`009MOVL`009R2,UCB$L_TT_ACCPORNAM(R5) ;Fill in the address of the block
X`009BBSS`009#TTY$V_PC_ACCPORNAM,-`009  ;Indicate that there's
X`009`009UCB$W_TT_PRTCTL(R5),30$`009  ; an access port name buffer
X
X; Stuff the string into the Access Port Name buffer.
X
X30$:`009MOVZBL`009TPA$L_TOKENCNT(AP),R0`009    ;Grab the device length
X`009MOVB`009R0,(R2)+`009`009    ;Stash the length
X`009MOVC3`009R0,@TPA$L_TOKENPTR(AP),(R2) ;Stash the Access Port Name
X`009MOVL`009#SS$_NORMAL,R0`009`009    ;Success
X
X40$:`009PUSHL`009R0`009`009`009;Save the status
X`009MOVL`009G`094CTL$GL_PCB,R4`009`009;Fetch my PCB address
X`009JSB`009G`094SCH$IOUNLOCK`009`009;Unlock the I/O database
X`009POPL`009R0`009`009`009;Restore the status
X`009RET`009`009`009`009;Back to user mode
X
X`009.Page
X`009.Subtitle`009BLANKS_VISIBLE`009- Make blanks visible
X
X;+
X;
X; ----- BLANKS_VISIBLE:  Make blanks visible
X;
X;
X; This routine is called as a TPARSE action routine to make
X; blanks significant in the input string.
X;
X; Inputs:
X;
X;`009AP`009- TPARSE parameter block address
X;
X; Outputs:
X;
X;`009TPA$M_BLANKS set in TPA$L_OPTIONS(AP).
X;
X;-
X
XBLANKS_VISIBLE:`009.Word `094m<>`009`009;Make blanks visible
X
X`009BISL`009#TPA$M_BLANKS,-`009`009;Make blanks
X`009`009TPA$L_OPTIONS(AP)`009; visible
X`009RET`009`009`009`009;Done
X
X`009.Page
X`009.Subtitle`009UPCASE`009`009- Upcase the current token
X
X;+
X;
X; ----- UPCASE:  Upcase the current token
X;
X;
X; This routine is called as a TPARSE action routine to upcase the
X; current token.  The routine  returns failure to cause TPARSE to
X; scan forward for the next transition.
X;
X; Inputs:
X;
X;`009TPA$L_TOKENCNT(AP)`009- A descriptor of the token
X;
X; Outputs:
X;
X;`009Token upcased.
X;
X;-
X
XUPCASE:`009.Word`009`094m<>`009`009`009;Upcase the current token
X
X`009PUSHAL`009TPA$L_TOKENCNT(AP)`009;Here's the destination string
X`009PUSHL`009(SP)`009`009`009;Which happens to be the source string
X`009CALLS`009#2,G`094STR$UPCASE`009`009;Uppercasify it
X`009CLRL`009R0`009`009`009;Lose
X`009RET`009`009`009`009;Done
X
X`009.Page
X`009.Subtitle`009COND_HANDLER`009- Condition handler
X
X;+
X;
X; ----- COND_HANDLER:  Condition handler
X;
X;
X; This routine is the condition handler for this module.  We output an error
X; message and exit with status if the error condition was severe.
X;
X; Inputs:
X;
X;`009CHF$L_SIGARGLST(AP)`009- Signal argument vector address
X;`009CHF$L_MECARGLST(AP)`009- Mechanism argument vector address
X;
X; Outputs:
X;
X;`009An error message is output to SYS$OUTPUT and SYS$ERROR using
X;`009$PUTMSG.  Image exit will be forced if the error was SEVERE.
X;
X;-
X
XCOND_HANDLER: .Word `094M<R2>`009`009;Here on a signalled error
X
X`009MOVL`009CHF$L_SIGARGLST(AP),R2`009;Address the signal vector
X`009SUBL`009#2,(R2)`009`009`009;Never mind the PC and PSL
X`009$PUTMSG_S MSGVEC=(R2),-`009`009;Output the error code(s)
X`009`009FACNAM=US`009`009;Use our name.
X`009BISL3`009#STS$M_INHIB_MSG,-`009;Don't output
X`009`009CHF$L_SIG_NAME(R2),R1`009; the message twice
X`009CMPZV`009#STS$V_SEVERITY,-`009;Is this a
X`009`009#STS$S_SEVERITY,-`009; severe (fatal)
X`009`009R1,#STS$K_SEVERE`009;  error?
X`009BEQL`00910$`009`009`009;If EQL yes, force image exit
V`009MOVL`009CHF$L_MCHARGLST(AP),R2`009;Else address the mechanism argument li
Xst
X`009MOVL`009R1,CHF$L_MCH_SAVR0(R2)`009;Return the error code and return to
X`009RET`009`009`009`009; the previous thread of execution
X
X10$:`009$EXIT_S`009R1`009`009`009;Exit with status
X
X
X
X`009.End`009START
$ GOSUB UNPACK_FILE

$ FILE_IS = "ACCPORNAM_MSG.MSG"
$ CHECKSUM_IS = 251932821
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.Title`009ACCPMessage Message file for ACCPORNAM
X`009.Ident`009"V01.000"
X
X!+
X!
X! ----- ACCPMessage:  Message file for ACCP
X!
X!
X! This file contains the message defintions for ACCPORNAM.
X!
X!
X! Version:`009V01.000
X! Date:`009`00924-Feb-1989
X!
X! Copyright `169 1989  San Diego Supercomputer Center
X!
X! Gerard K. Newman`00924-Feb-1989
X! San Diego Supercomputer Center
X! General Atomics
X! P.O. Box 85608
X! San Diego, CA  92138-5608
X! 619.534.5076
X!
X! Internet:`009GKN@SDS.SDSC.EDU
X! Bitnet:`009GKN@SDSC.BITNET
X! SPAN:`009`009SDSC::GKN (27.1)
X! MFEnet:`009GKN@SDS.MFENET
X! SDSCnet:`009GKN@SDS.SDSCNET
X!
X!
X! Modifications:
X!
X!
X!-
X
X`009.Facility`009ACCP,100/Prefix=ACCP$_
X
X`009.Severity`009Informational
X
XACCP`009`009<Access port name of !AS set to !AS>/FAO_Count=2
X
X`009.Severity`009Error
X
XSYNTAX`009`009<Error parsing "!AS">/FAO_Count=1
XNOTERM`009`009<!AS is not a terminal>/FAO_Count=1
XOFFLINE`009`009<!AS is offline>/FAO_Count=1
XTEMPLATE`009<!AS is only a template>/FAO_Count=1
XEPHEMERAL`009<Device is ephemeral>
XTOOLONG`009`009<"!AS" is too long to be an Access Port Name>/FAO_Count=1
XBADUCB`009`009<UCB is too short for an Access Port Name>
X
X
X`009.End
$ GOSUB UNPACK_FILE

$ FILE_IS = "MAKE_ACCPORNAM.COM"
$ CHECKSUM_IS = 2033063831
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$ macro accpornam
X$ message accpornam_msg
X$ link/notrace accpornam+accpornam_msg
$ GOSUB UNPACK_FILE
$ EXIT
-+-+-+-+-+ End of part 2 +-+-+-+-+-

