NetNews Usenet Archive 1992 #31/NN_1992_31.iso/spool/comp/os/vms/20113

Internet Message Format | 1992-12-30 | 25.8 KB

Path: sparky!uunet!zaphod.mps.ohio-state.edu!moe.ksu.ksu.edu!engr.uark.edu!mbox.ualr.edu!backup.ualr.edu!domiller
Newsgroups: comp.os.vms
Subject: Re: TT_AccPorNam field remains null on a SHOW USERS output ?
Message-ID: <[e-mail]>
From: [e-mail]
Date: 30 Dec 92 15:45:52 GMT
References: <[e-mail]> <[e-mail]>
Organization: University of Arkansas at Little Rock
Nntp-Posting-Host: backup.ualr.edu
Lines: 840

In article <[e-mail]>, [e-mail] (Carl J Lydick) writes:
> In article <[e-mail]>, [e-mail] writes:
> =From a terminal hardwired to the system (ours is VMS 5.4), the server/port
> =field is left blank (see below).  An attempt at using
> =f$getdvi("TT","TT_AccPorNam") also returns an empty string.
> =
> That's because the system has already identified, as fully as possible, the
> location from which the login is taking place.  Think:  There's no way for VMS
> to be able to tell you where the terminal cable goes once it leaves the VAX.
> What information would you expect in the TT_ACCPORNAM field in this case?
>

Okay, it may be silly, but I also like to see where a terminal is (even if it
is hardwired).  The following program will let you set the ACCPORNAM field of
a hardwired terminal to whatever makes sense to you.  I run it from SYSTARTUP
to alter OPA0 and the TX lines we now have (it was of more use when we had
4 780s, each of which had 80 TX ports).
    Dale
----------------------------------------------------------------------------
| Dale O. Miller                          | #   #  ###  #     ####         |
| University of Arkansas at Little Rock   | #   # #   # #     #   #        |
| 2801 S. University                      | #   # ##### #     ####         |
| Little Rock, AR  72204-1099  USA        | #   # #   # #     #  #         |
| [phone]                           |  ###  #   # ##### #   #        |
| [e-mail], [e-mail] | Disclaimer: This does not      |
| 92-20-28 W,34-43-30 N.ICBMNET           | say what I say it doesn't say. |
----------------------------------------------------------------------------
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 30-DEC-1992 15:37:43.74   By user DOMILLER
$!
$! 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. ACCPORNAM.MAR;1
$!       2. ACCPORNAM_MSG.MSG;1
$!       3. EXAMPLE.COM;2
$!       4. MAKE_ACCPORNAM.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`09.Title`09ACCPORNAM`09- Set the Access Port Name for terminals
X`09.Ident`09/V01.000/
X`09.Enable`09SUP
X`09.Default Displacement,Word
X`09.Subtitle`09Introduction
X
X;+
X;
X; ----- ACCPORNAM:  Set the Access Port Name for terminals
X;
X;
X; Facility:
X;
X;`09VAX/VMS system management
X;
X; Abstract:
X;
X;`09This module allows a suitably privileged user to set the Access
X;`09Port Name (ACCPORNAM) for hard-wired terminals.
X;
X; Environment:
X;
X;`09VAX/VMS native mode, VMS V5.0 or later, CMKRNL privilege.
X;
X;
X;
X; Version:`09V01.000
X; Date:`09`0924-Feb-1989
X;
X; Copyright `A9 1989  San Diego Supercomputer Center
X;
X; Gerard K. Newman`0924-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:`[e-mail]
X; BITNET:`[e-mail]
X; SPAN:`09`09SDSC::GKN (27.1)
X; MFENET:`[e-mail]
X; SDSCNET:`[e-mail]
X;
X;
X; Modifications:
X;
X;
X;-
X
X`09.Page
X`09.Subtitle`09Local definitions
X
X`09.Link`09 "SYS$SYSTEM:SYS.STB"/Selective_Search`09;Grab the system symbol
V table
X`09.Library "SYS$LIBRARY:LIB.MLB"`09`09`09;Get special macros from here
X
X`09.NoCross`09`09`09;Save a tree
X
X`09$CHFDEF`09`09`09`09;Define condition handler stuff
X`09$DCDEF`09`09`09`09;Device class & type definitions
X`09$SSDEF`09`09`09`09;System service codes
X`09$STSDEF`09`09`09`09;Define severity codes
X`09$TPADEF`09`09`09`09;TPARSE definitions
X`09$TTYUCBDEF`09`09`09;Terminal UCB offsets
X`09$UCBDEF`09`09`09`09;UCB offsets
X
X`09.Cross`09`09`09`09;Turn CREF back on
X
X
X; Local macros
X
X; Item:`09`09Make an item list entry for $GETxxI
X
X.Macro`09Item`09Type=DVI,Item=,Length=4,RetAdr=,RetLen= ;Make an item list e
Vntry for $GETxxI
X`09.Word`09Length,Type'$_'Item`09;Length,,what
X`09.Address RetAdr`09`09`09;Put it here
X`09.If`09NB,RetLen`09`09;If we have an explicit return length
X`09.Address RetLen`09`09`09; then use it
X`09.Iff`09`09`09`09;  else
X`09.Long`090`09`09`09;   we don't care
X`09.Endc`09`09`09`09;`09...
X.Endm`09Item`09`09`09`09;`09...
X
X; .Ascip:`09Create a pointer to an .Ascid string
X
X.Macro`09.Ascip`09STRING,?A`09`09;Point to a string descriptor in another PS
VECT
X`09.Enable`09LSB`09`09`09;Turn on the local symbol block
X`09.Save`09`09`09`09;Save the current PSECT
X`09.Psect`09STRINGS NOEXE,RD,NOWRT,PIC,SHR,PAGE
XA:`09.Ascid`09\'STRING\`09`09;String
X`09.Restore`09`09`09;Restore the current PSECT
X`09.Address A`09`09`09;Store pointer to the string
X`09.Disable LSB`09`09`09;Turn off the local symbol block
X.Endm`09.Ascip`09`09`09`09;       ...
X
X`09.Page
X`09.Subtitle`09TPARSE state table
X
X;+
X;
X; ----- TPARSE state table
X;
X;
X; Valid commands:
X;
X;`09HELP or ?`09`09- Print a short help message
X;`09SET <device> <string>`09- Set  the ACCPORNAM for <device> to <string>
X;`09SHOW <device>`09`09- Show the ACCPORNAM for <device>
X;`09EXIT`09`09`09- Quit
X;
X;-
X
X`09$INIT_STATE`09ACCP_STATES,ACCP_KEYS`09;Initialize the state table
X
X; Parse the major verb.
X
X`09$STATE`09`09`09`09`09;First state
X
X`09$TRAN`09TPA$_STRING,,UPCASE`09`09;Upcase the first token (!)
X`09$TRAN`09TPA$_EOS,TPA$_EXIT`09`09;Ignore empty commands
X`09$TRAN`09'?',TPA$_EXIT,HELP`09`09;Print help
X`09$TRAN`09'EXIT',TPA$_EXIT,RET_EOF`09;Quit
X`09$TRAN`09'HELP',TPA$_EXIT,HELP`09`09;    ...
X`09$TRAN`09'SET',ST_SET`09`09`09;Set the ACCPORNAM
X`09$TRAN`09'SHOW',ST_SHOW`09`09`09;Show the ACCPORNAM
X
X; Set <device> <string>
X
X`09$STATE`09ST_SET`09`09`09`09;Set the ACCPORNAM
X
X`09$TRAN`09TPA$_FILESPEC,,CHECK_DEVICE`09;Go check the device name out
X
X`09$STATE`09`09`09`09`09;Here to set the string
X
X`09$TRAN`09!ST_NAME,TPA$_EXIT,SET_ACCP`09;Go set the string
X
X; Show <device>
X
X`09$STATE`09ST_SHOW`09`09`09`09  ;Show the ACCPORNAM
X
X`09$TRAN`09TPA$_FILESPEC,TPA$_EXIT,SHOW_ACCP ;Go show the access port name
X
X; Sub-expression to swallow stuff until EOS.
X
X`09$STATE`09ST_NAME`09`09`09`09;Sub-expression to collect until EOS
X
X`09$TRAN`09TPA$_LAMBDA,,BLANKS_VISIBLE`09;Make blanks visible again
X
X`09$STATE`09ST_NAME_1`09`09`09;Here to collect until EOS
X
X`09$TRAN`09TPA$_EOS,TPA$_EXIT`09`09;Quit at EOS
X`09$TRAN`09TPA$_ANY,ST_NAME_1`09`09;Else munch another character
X
X`09$END_STATE`09`09`09`09;End of the state table
X
X`09.Page
X`09.Subtitle`09Impure storage
X
X`09.Psect`09IMPURE_DATA`09NOEXE,RD,WRT,PIC,NOSHR,PAGE
X
X
X; TPARSE parameter block.
X
XTPARSE_BLOCK:`09.Long`09TPA$K_COUNT0`09;Argument count
X`09`09.Blkb`09TPA$K_LENGTH0-4`09;Allocate the rest of the block
X
X
X; Random other crud.
X
XDEVICE_CLASS:`09.Blkl`09`09`09;Device class
XDEVICE_STS:`09.Blkl`09`09`09;Device status
XDEVICE_DESC:`09.Blkl`09`09`09;Device name
X`09`09.Address DEVICE_BUFF`09; descriptor
XACCP_DESC:`09.Blkl`09`09`09;Access Port Name
X`09`09.Address ACCP_BUFF`09; descriptor
XTT_DESC:`09.Blkl`09`09`09;Physical terminal
X`09`09.Address TT_BUFF`09; descriptor
X
XIN_BUFF:`09.Blkb`09128`09`09;Command input buffer
XTT_BUFF:`09.Blkb`0964`09`09;Physical terminal name buffer
XDEVICE_BUFF:`09.Blkb`0964`09`09;Device name buffer
XACCP_BUFF:`09.Blkb`0964`09`09;Access Port Name buffer
X
X`09.Page
X`09.Subtitle`09Pure storage
X
X`09.Psect`09PURE_DATA`09NOEXE,RD,NOWRT,PIC,SHR,PAGE
X
X
X; $GETDVI wish list.
X
XDVI_LIST:`09Item`09Item=DEVCLASS,-`09`09;Get the device class
X`09`09`09RetAdr=DEVICE_CLASS`09;Put it here
X`09`09Item`09Item=STS,-`09`09;Get the device status word
X`09`09`09RetAdr=DEVICE_STS`09;Put it here
X`09`09Item`09Item=TT_PHYDEVNAM,-`09;Get the device name
X`09`09`09Length=64,-`09`09;It can be this big
X`09`09`09RetAdr=TT_BUFF,-`09;Put it here
X`09`09`09RetLen=TT_DESC`09`09;Return the length here
X`09`09Item`09Item=TT_ACCPORNAM,-`09;Get the Access Port Name
X`09`09`09Length=64,-`09`09;It can be this big
X`09`09`09RetAdr=ACCP_BUFF,-`09;Put it here
X`09`09`09RetLen=ACCP_DESC`09;Return the length here
X`09`09Item`09Item=DEVNAM,-`09`09;Get the device name
X`09`09`09Length=64,-`09`09;It can be this big
X`09`09`09RetAdr=DEVICE_BUFF,-`09;Put it here
X`09`09`09RetLen=DEVICE_DESC`09;Return the length here
X`09`09.Long`090`09`09`09;That's all
X
X
X; Help text.
X
XHELP_TEXT:`09.Ascip`09<>
X`09`09.Ascip`09<Commands:>
X`09`09.Ascip`09<>
X`09`09.Ascip`09<EXIT`09`09`09- Exit the program>
X`09`09.Ascip`09<SET device string`09- Set  the ACCPORNAM for device to strin
Vg>
X`09`09.Ascip`09<SHOW device`09`09- Show the ACCPORNAM for device>
X`09`09.Ascip`09<>
X`09`09.Long`090
X
X
X; Other random text.
X
XPROMPT:`09`09.Ascid`09"ACCP> "
XUS:`09`09.Ascid`09"ACCP"
X
X`09.Page
X`09.Subtitle`09Entry point
X
X`09.Psect`09CODE`09`09EXE,RD,NOWRT,PIC,SHR,PAGE
X
X`09.Entry`09START,`5EM<>`09`09;Entry here
X
X`09MOVAB`09COND_HANDLER,(FP)`09;Establish a condition handler
X`09MOVAL`09TPARSE_BLOCK,R11`09;Address our TPARSE block
X
X; Loop here reading commands from SYS$INPUT.
X
X10$:`09MOVZBL`09#128,TPA$L_STRINGCNT(R11)    ;Reset the input
X`09MOVAB`09IN_BUFF,TPA$L_STRINGPTR(R11) ; descriptor
X`09MOVL`09#TPA$M_ABBREV,-`09`09     ;Reset the
X`09`09TPA$L_OPTIONS(R11)`09     ; TPARSE options
X`09PUSHAW`09TPA$L_STRINGCNT(R11)`09     ;Return the length here
X`09PUSHAQ`09PROMPT`09`09`09     ;Prompt with this
X`09PUSHAQ`09TPA$L_STRINGCNT(R11)`09     ;Here's the input buffer
X`09CALLS`09#3,G`5ELIB$GET_INPUT`09     ;Fetch some input
X`09BLBC`09R0,20$`09`09`09     ;Presume EOF
X`09TSTW`09TPA$L_STRINGCNT(R11)`09     ;Any input?
X`09BEQL`0910$`09`09`09     ;If EQL no, ask again
X
X; Feed the command to TPARSE.  Command execution handled by TPARSE
X; action routines.
X
X`09PUSHAL`09ACCP_KEYS`09`09;Stack the keyword table address
X`09PUSHAL`09ACCP_STATES`09`09;Stack the state table address
X`09PUSHL`09R11`09`09`09;Stack the TPARSE block address
X`09CALLS`09#3,G`5ELIB$TPARSE`09`09;Parse the command
X`09BLBS`09R0,10$`09`09`09;Win!
X
X; Here on some sort of error.
X
X20$:`09CMPL`09#RMS$_EOF,R0`09`09;End of file?
X`09BEQL`0940$`09`09`09;If EQL yes, not an error
X`09BBS`09#STS$V_INHIB_MSG,R0,10$`09;Branch if we've already signalled the er
Vror
X`09CMPL`09#LIB$_SYNTAXERR,R0`09;Syntax error?
X`09BNEQ`0930$`09`09`09;If NEQ no, a real problem
X`09PUSHAQ`09TPA$L_TOKENCNT(R11)`09;Else stack the token descriptor address
X`09PUSHL`09#1`09`09`09;1 FAO argument
X`09PUSHL`09#ACCP$_SYNTAX`09`09;Stack the error code
X`09CALLS`09#3,G`5ELIB$SIGNAL`09`09;Signal the error
X`09BRB`0910$`09`09`09;And loop
X
X; Here on some drastic error.
X
X30$:`09PUSHL`09R0`09`09`09;Stack the error
X`09CALLS`09#1,G`5ELIB$STOP`09`09;Punt.
X
X; Here to exit peacefully.
X
X40$:`09MOVL`09#SS$_NORMAL,R0`09`09;Success
X`09RET`09`09
X
X`09.Page
X`09.Subtitle`09HELP`09`09- List brief help
X
X;+
X;
X; ----- HELP:  List brief help
X;
X;
X; This routine is called as a TPARSE action routine to print
X; brief help on SYS$OUTPUT.
X;
X; Inputs:
X;
X;`09HELP_TEXT`09- Table of help text pointers.
X;
X; Outputs:
X;
X;`09As described above.
X;
X;-
X
XHELP:`09.Word`09`5Em<R2>`09`09`09;List brief help
X
X`09MOVAL`09HELP_TEXT,R2`09`09;Address the help text
X
X10$:`09PUSHL`09(R2)+`09`09`09;Stack the next descriptor address
X`09BEQL`0920$`09`09`09;If EQL we're done
X`09CALLS`09#1,G`5ELIB$PUT_OUTPUT`09;Display it
X`09BRB`0910$`09`09`09;Around and around we go
X
X20$:`09RET`09`09`09`09;Done
X
X`09.Page
X`09.Subtitle`09RET_EOF`09`09- Return RMS$_EOF
X
X;+
X;
X; ----- RET_EOF:  Return RMS$_EOF
X;
X;
X; This routine is called as a TPARSE action routine for the EXIT command.
X;
X; Inputs:
X;
X;`09None
X;
X; Outputs:
X;
X;`09R0`09- RMS$_EOF
X;
X;-
X
XRET_EOF: .Word`09`5Em<>`09`09`09;Return RMS$_EOF
X
X`09MOVL`09#RMS$_EOF,R0`09`09;Return
X`09RET`09`09`09`09; RMS$_EOF
X
X`09.Page
X`09.Subtitle`09CHECK_DEVICE`09- Ensure that the device is a terminal
X
X;+
X;
X; ----- CHECK_DEVICE:  Ensure that the device is a terminal
X;
X;
X; This routine will ensure that the target device is a terminal
X; and is not a "ephemeral" device.
X;
X; Inputs:
X;
X;`09TPA$L_TOKENCNT(AP)`09- A descriptor of the device name
X;
X; Outputs:
X;
X;`09R0`09- Success or failure
X;
X;-
X
XCHECK_DEVICE: .Word `5Em<>`09`09`09;Ensure that the device is a terminal
X
X; Get the scoop on this device
X
X`09$GETDVIW_S DEVNAM=TPA$L_TOKENCNT(AP),-`09;Fetch the
X`09`09ITMLST=DVI_LIST`09`09`09; poop on this device
X`09BLBC`09R0,10$`09`09`09`09;Lose!
X
X; Reject if it's not a terminal, off line, or a template device.
X
X`09MOVAQ`09DEVICE_DESC,R1`09`09`09;Presume it's not a terminal
X`09MOVL`09#ACCP$_NOTERM,R0`09`09;Presume not a terminal
X`09CMPL`09#DC$_TERM,DEVICE_CLASS`09`09;Is it?
X`09BNEQ`0920$`09`09`09`09;Nope.
X`09MOVL`09#ACCP$_OFFLINE,R0`09`09;Presume device off line
X`09BBC`09#UCB$V_ONLINE,DEVICE_STS,20$`09;Branch if so
X`09MOVAL`09TT_DESC,R1`09`09`09;It's a terminal, so use this name for errors
X`09MOVL`09#ACCP$_TEMPLATE,R0`09`09;Presume template device
X`09BBS`09#UCB$V_TEMPLATE,DEVICE_STS,20$`09;Branch if so
X`09MOVL`09#SS$_NORMAL,R0`09`09`09;Else we're
X`09RET`09`09`09`09`09; Ok
X
X; Here on a system service error.
X
X10$:`09PUSHL`09R0`09`09`09;Stack the error code
X`09CALLS`09#1,G`5ELIB$SIGNAL`09`09;Signal same
X`09RET`09`09`09`09;Done
X
X; Here when it appears that we don't have an acceptible device.
X
X20$:`09PUSHL`09R1`09`09`09;Stack the device descriptor address
X`09PUSHL`09#1`09`09`09;1 FAO argument
X`09PUSHL`09R0`09`09`09;Stack the error code
X`09CALLS`09#3,G`5ELIB$SIGNAL`09`09;Signal the error
X`09RET`09`09`09`09;Done
X
X`09.Page
X`09.Subtitle`09SHOW_ACCP`09- 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;`09TPA$L_TOKENCNT(AP)`09- A descriptor of the device name
X;
X; Outputs:
X;
X;`09Access Port Name displayed.
X;
X;-
X
XSHOW_ACCP: .Word `5Em<>`09`09`09;Show the Access Port Name
X
X; Get the scoop on the device.
X
X`09$GETDVIW_S DEVNAM=TPA$L_TOKENCNT(AP),-`09;Fetch the
X`09`09ITMLST=DVI_LIST`09`09`09; poop on this device
X`09BLBC`09R0,10$`09`09`09`09;Lose!
X
X; Lose if it's not a terminal, off line, or a template device.
X
X`09MOVAQ`09DEVICE_DESC,R1`09`09`09;Presume it's not a terminal
X`09MOVL`09#ACCP$_NOTERM,R0`09`09;Presume not a terminal
X`09CMPL`09#DC$_TERM,DEVICE_CLASS`09`09;Is it?
X`09BNEQ`0920$`09`09`09`09;Nope.
X`09MOVL`09#ACCP$_OFFLINE,R0`09`09;Presume device off line
X`09BBC`09#UCB$V_ONLINE,DEVICE_STS,20$`09;Branch if so
X`09MOVAQ`09TT_DESC,R1`09`09`09;It's a terminal, so use this name
X`09MOVL`09#ACCP$_TEMPLATE,R0`09`09;Presume template device
X`09BBS`09#UCB$V_TEMPLATE,DEVICE_STS,20$`09;Branch if so
X
X; It's a terminal -- signal the Access Port Name.
X
X`09PUSHAQ`09ACCP_DESC`09`09;Stack the Access Port Name descriptor address
X`09PUSHAQ`09TT_DESC`09`09`09;Stack the device name descriptor address
X`09PUSHL`09#2`09`09`09;2 FAO arguments
X`09PUSHL`09#ACCP$_ACCP`09`09;Stack the message code
X`09CALLS`09#4,G`5ELIB$SIGNAL`09`09;Signal the message
X`09RET`09`09`09`09;Done
X
X; Here when $GETDVI loses.
X
X10$:`09PUSHL`09R0`09`09`09;Stack the error
X`09CALLS`09#1,G`5ELIB$SIGNAL`09`09;Signal it
X`09RET`09`09`09`09;Done
X
X; Here when the device isn't a terminal or is otherwise unacceptable.
X
X20$:`09PUSHL`09R1`09`09`09;Stack the device descriptor address
X`09PUSHL`09#1`09`09`09;1 FAO argument
X`09PUSHL`09R0`09`09`09;Stack the error code
X`09CALLS`09#3,G`5ELIB$SIGNAL`09`09;Signal the error
X`09RET`09`09`09`09;Done
X
X`09.Page
X`09.Subtitle`09SET_ACCP`09- 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;`09TT_DESC`09`09`09- Descriptor of the device to hack
X;`09TPA$L_TOKENCNT(AP)`09- Descriptor of the Access Port Name
X;
X; Outputs:
X;
X;`09Access Port Name bashed.
X;
X;-
X
XSET_ACCP: .Word`09`5Em<>`09`09`09;Set the Access Port Name
X
X`09CMPL`09TPA$L_TOKENCNT(AP),#63`09;Too big?
X`09BGTRU`0910$`09`09`09;If GTRU yes
X`09$CMKRNL_S B`5E20$,(AP)`09`09;Do this in kernel mode
X`09RET`09`09`09`09;Done, status in R0
X
X; Here when the string is too long.
X
X10$:`09PUSHAQ`09TPA$L_TOKENCNT(AP)`09;Stack the string descriptor address
X`09PUSHL`09#1`09`09`09;1 FAO argument
X`09PUSHL`09#ACCP$_TOOLONG`09`09;Stack the error code
X`09CALLS`09#1,G`5ELIB$SIGNAL`09`09;Signal the error
X`09RET`09`09`09`09;Done
X
X; Here in kernel mode to do the hard work.
X
X20$:`09.Word`09`5Em<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11> ;Here in kernel mode to
V do the hard work.
X
X; Hunt down the device.
X
X`09MOVL`09G`5ECTL$GL_PCB,R4`09`09  ;Fetch my PCB address
X`09JSB`09G`5ESCH$IOLOCKW`09`09  ;Lock the I/O database for write access
X`09MOVAB`09TT_DESC,R1`09`09  ;Here's the device to find
X`09JSB`09G`5EIOC$SEARCHDEV`09`09  ;Find the device
X`09BLBC`09R0,40$`09`09`09  ;Lose.
X`09MOVL`09R1,R5`09`09`09  ;Remember the UCB address
X
X; Check to make sure that the UCB is long enough to accomodate an Access Por
Vt Name.
X
X`09MOVL`09#ACCP$_BADUCB,R0`09  ;Presume the UCB is too small
X`09CMPW`09UCB$W_SIZE(R5),-`09  ;Is the UCB
X`09`09#UCB$L_TT_ACCPORNAM+4`09  ; big enough?
X`09BLSSU`0940$`09`09`09  ;If LSSU no, we have to lose.`20
X`09MOVL`09UCB$L_TT_ACCPORNAM(R5),R2 ;Fetch the Access Port Name buffer addre
Vss
X`09BLSS`0930$`09`09`09  ;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`09MOVL`09#ACCP$_EPHEMERAL,R0`09;Presume that the device is ephemeral
X`09BBS`09#UCB$V_DELETEUCB,-`09;Branch if this
X`09`09UCB$W_STS(R5),40$`09; is the case
X
X; Allocate an Access Port Name buffer
X
X`09MOVL`09#64,R1`09`09`09  ;We'd like 64 bytes
X`09JSB`09G`5EEXE$ALONPAGVAR`09  ;Get some pool
X`09BLBC`09R0,40$`09`09`09  ;Lossage!
X`09MOVL`09R2,UCB$L_TT_ACCPORNAM(R5) ;Fill in the address of the block
X`09BBSS`09#TTY$V_PC_ACCPORNAM,-`09  ;Indicate that there's
X`09`09UCB$W_TT_PRTCTL(R5),30$`09  ; an access port name buffer
X
X; Stuff the string into the Access Port Name buffer.
X
X30$:`09MOVZBL`09TPA$L_TOKENCNT(AP),R0`09    ;Grab the device length
X`09MOVB`09R0,(R2)+`09`09    ;Stash the length
X`09MOVC3`09R0,@TPA$L_TOKENPTR(AP),(R2) ;Stash the Access Port Name
X`09MOVL`09#SS$_NORMAL,R0`09`09    ;Success
X
X40$:`09PUSHL`09R0`09`09`09;Save the status
X`09MOVL`09G`5ECTL$GL_PCB,R4`09`09;Fetch my PCB address
X`09JSB`09G`5ESCH$IOUNLOCK`09`09;Unlock the I/O database
X`09POPL`09R0`09`09`09;Restore the status
X`09RET`09`09`09`09;Back to user mode
X
X`09.Page
X`09.Subtitle`09BLANKS_VISIBLE`09- 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;`09AP`09- TPARSE parameter block address
X;
X; Outputs:
X;
X;`09TPA$M_BLANKS set in TPA$L_OPTIONS(AP).
X;
X;-
X
XBLANKS_VISIBLE:`09.Word `5Em<>`09`09;Make blanks visible
X
X`09BISL`09#TPA$M_BLANKS,-`09`09;Make blanks
X`09`09TPA$L_OPTIONS(AP)`09; visible
X`09RET`09`09`09`09;Done
X
X`09.Page
X`09.Subtitle`09UPCASE`09`09- 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;`09TPA$L_TOKENCNT(AP)`09- A descriptor of the token
X;
X; Outputs:
X;
X;`09Token upcased.
X;
X;-
X
XUPCASE:`09.Word`09`5Em<>`09`09`09;Upcase the current token
X
X`09PUSHAL`09TPA$L_TOKENCNT(AP)`09;Here's the destination string
X`09PUSHL`09(SP)`09`09`09;Which happens to be the source string
X`09CALLS`09#2,G`5ESTR$UPCASE`09`09;Uppercasify it
X`09CLRL`09R0`09`09`09;Lose
X`09RET`09`09`09`09;Done
X
X`09.Page
X`09.Subtitle`09COND_HANDLER`09- 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;`09CHF$L_SIGARGLST(AP)`09- Signal argument vector address
X;`09CHF$L_MECARGLST(AP)`09- Mechanism argument vector address
X;
X; Outputs:
X;
X;`09An error message is output to SYS$OUTPUT and SYS$ERROR using
X;`09$PUTMSG.  Image exit will be forced if the error was SEVERE.
X;
X;-
X
XCOND_HANDLER: .Word `5EM<R2>`09`09;Here on a signalled error
X
X`09MOVL`09CHF$L_SIGARGLST(AP),R2`09;Address the signal vector
X`09SUBL`09#2,(R2)`09`09`09;Never mind the PC and PSL
X`09$PUTMSG_S MSGVEC=(R2),-`09`09;Output the error code(s)
X`09`09FACNAM=US`09`09;Use our name.
X`09BISL3`09#STS$M_INHIB_MSG,-`09;Don't output
X`09`09CHF$L_SIG_NAME(R2),R1`09; the message twice
X`09CMPZV`09#STS$V_SEVERITY,-`09;Is this a
X`09`09#STS$S_SEVERITY,-`09; severe (fatal)
X`09`09R1,#STS$K_SEVERE`09;  error?
X`09BEQL`0910$`09`09`09;If EQL yes, force image exit
X`09MOVL`09CHF$L_MCHARGLST(AP),R2`09;Else address the mechanism argument list
X`09MOVL`09R1,CHF$L_MCH_SAVR0(R2)`09;Return the error code and return to
X`09RET`09`09`09`09; the previous thread of execution
X
X10$:`09$EXIT_S`09R1`09`09`09;Exit with status
X
X
X
X`09.End`09START
$ CALL UNPACK ACCPORNAM.MAR;1 1142977795
$ create 'f'
X`09.Title`09ACCPMessage Message file for ACCPORNAM
X`09.Ident`09"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:`09V01.000
X! Date:`09`0924-Feb-1989
X!
X! Copyright `A9 1989  San Diego Supercomputer Center
X!
X! Gerard K. Newman`0924-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:`[e-mail]
X! Bitnet:`[e-mail]
X! SPAN:`09`09SDSC::GKN (27.1)
X! MFEnet:`[e-mail]
X! SDSCnet:`[e-mail]
X!
X!
X! Modifications:
X!
X!
X!-
X
X`09.Facility`09ACCP,100/Prefix=ACCP$_
X
X`09.Severity`09Informational
X
XACCP`09`09<Access port name of !AS set to !AS>/FAO_Count=2
X
X`09.Severity`09Error
X
XSYNTAX`09`09<Error parsing "!AS">/FAO_Count=1
XNOTERM`09`09<!AS is not a terminal>/FAO_Count=1
XOFFLINE`09`09<!AS is offline>/FAO_Count=1
XTEMPLATE`09<!AS is only a template>/FAO_Count=1
XEPHEMERAL`09<Device is ephemeral>
XTOOLONG`09`09<"!AS" is too long to be an Access Port Name>/FAO_Count=1
XBADUCB`09`09<UCB is too short for an Access Port Name>
X
X
X`09.End
$ CALL UNPACK ACCPORNAM_MSG.MSG;1 251932821
$ create 'f'
X$RUN ACCPORNAM
XSET OPA0 SIGMA/NS213-SC
XSET TXA0 SIGMA/VOCOM-40
XSET TXA1 SIGMA/NS202
XSET TXA2 SIGMA/NS213-03
XSET TXA3 SIGMA/UNUSED03
XSET TXA3 SIGMA/UNUSED04
XSET TXA3 SIGMA/UNUSED05
XSET TXA3 SIGMA/UNUSED06
XSET TXA3 SIGMA/UNUSED07
XEXIT
$ CALL UNPACK EXAMPLE.COM;2 928176445
$ create 'f'
X$ macro accpornam
X$ message accpornam_msg
X$ link/notrace accpornam+accpornam_msg
$ CALL UNPACK MAKE_ACCPORNAM.COM;1 2033063831
$ v=f$verify(v)
$ EXIT