.TITLE SYMCLUSTER ; VAXcluster SYMBOL support .IDENT "SYMBOL v3%4.091" ; internals demo program... ;++ ; This program demonstrates the use of the undocumented SMI shareable image ; library functions which provide the interface to the VAXcluster SMISERVER. ;-- ; Copyright © 1993, 1994 by Brian Schenkenberger and TMESIS Consulting ; All rights reserved. ; ------------------------ ; This software is provided "as is" and is supplied for informational purpose ; only. No warranty is expressed or implied and no liability can be accepted ; for any actions or circumstances incurred from the use of this software or ; from the information contained herein. The author makes no claim as to the ; suitablility or fitness of this software or information contain herein for a ; particular purpose. ; ------------------------- ; This software may be copied and distributed only with the inclusion of this ; copyright notice. ;-- ; Modifications: ; 06-FEB-1994: created this file... ; Version V3: ----------------------------------------------------------- ; 24-FEB-1994: V3 (Include OpenVMS/AlphaAXP Support) Removed architecture ; type check. ;-- .LIBRARY "SYS$LIBRARY:LIB.MLB" ; look here when assembling $DSCDEF ; VMS descriptor type/class def's $PCBDEF ; Processor control block def's $PRVDEF ; Processor privilege quadword def's $SSDEF ; system service error definitions ;------------------------------------------------------------------------------ SMI$K_FUNC_SHOW = 1 ; symbolic name of SMI function codes SMI$K_FUNC_SHOW_NEXT = 2 ; obtained from the source code. no SMI$K_FUNC_MODIFY = 5 ; known include library modules exist. ;---------------------------------------------------------------------------- .NTYPE ...ON_ALPHA...,R31 .IIF EQ,<...ON_ALPHA...@-4&^XF>-5, ALPHA=0 .IIF DF,ALPHA, .DISABLE FLAGGING ;---------------------------------------------------------------------------- .PSECT $$DATA,WRT,NOEXE,LONG SMICTX: .LONG 0 CURPRV: .QUAD 0 NOPRIV: .LONG -1,-1 ; S * mSec * uSec *TC ; TC - tick cnt = 100 nSecs TIMEOUT: .LONG -10 * 1000 * 1000 *10,-1; 10 second timeout. NODENAME_DSC: .LONG 16 .ADDRESS NODENAME_STR NODENAME_STR: .BLKB 16 BUFF_LEN = 256 BUFF_DESC: .LONG !!BUFF_LEN .ADDRESS BUFFER BUFFER: .BLKB BUFF_LEN COMMAND: .LONG !,0 GETLINE: .ASCID /$LINE/ MCR: .ASCID /MCR SYMBOL / ;------------------------------------------------------------------------------ .PSECT $$CODE_RO,PIC,GBL,SHR,NOWRT,EXE,LONG .IF DF ALPHA .CALL_ENTRY LABEL=SYMCLUSTER,HOME_ARGS=TRUE,MAX_ARGS=1 .IF_FALSE .ENTRY SYMCLUSTER,0 .ENDC PUSHAB COMMAND PUSHAB GETLINE CALLS #2,G^CLI$GET_VALUE ; get the command line BLBS R0,10$ RET 10$: PUSHAB MCR ; prepend the command line PUSHAL #6 ; with MCR before using PUSHAL #1 PUSHAB COMMAND PUSHAB COMMAND CALLS #5,G^STR$REPLACE BLBS R0,20$ RET 20$: $CMKRNL_S ROUTIN=GET_NODE_FROM_PID,- ; get nodename ARGLST=(AP) BLBS R0,30$ RET 30$: PUSHAB SMICTX ; initialize SMI context block CALLS #1,G^SMI$INIT BLBS R0,40$ RET 40$: PUSHAB TIMEOUT ; setup a commun. timeout PUSHAB SMICTX ; SMI context block CALLS #2,G^SMI$SET_TIMEOUT ; BLBS R0,50$ RET 50$: PUSHAB NODENAME_DSC ; add the remote nodename to the PUSHAB SMICTX ; SMI context block CALLS #2,G^SMI$SET_NODENAME BLBS R0,60$ RET 60$: $SETPRV_S PRVPRV=CURPRV ; get and save current privies BLBS R0,70$ RET 70$: ASSUME PRV$V_GROUP LT 32 ; ASSUME PRV$V_WORLD LT 32 ; \ assuptions for the next ASSUME PRV$V_SETPRV LT 32 ; / two BICL2 instructions ASSUME PRV$V_TMPMBX LT 32 ; CLRL CURPRV+4 ; no 2nd longword privies BICL2 #^C<- ; if local process has PRV$M_GROUP!- ; group privilege, PRV$M_WORLD!- ; world privilege, PRV$M_TMPMBX!- ; tmpmbx privilege or PRV$M_CMKRNL>,- ; cmkrnl privilege CURPRV ; remote should inherit same BICL2 #PRV$M_SETPRV,CURPRV ; don't inherit auth.privies PUSHL #0 ; prmflg = 0 PUSHAB NOPRIV ; prv vector (all privs) PUSHL #0 ; enbflg = 0 (disable) PUSHL #SMI$K_FUNC_MODIFY ; remote command value PUSHAB SMICTX ; SMI context block CALLS #5,G^SMI$PRIV ; disable all privies BLBS R0,80$ RET 80$: PUSHL #0 ; prmflg = 0 PUSHAB CURPRV ; current active prv vector PUSHL #1 ; enbflg = 1 (enable) PUSHL #SMI$K_FUNC_MODIFY ; remote command value PUSHAB SMICTX ; SMI context block CALLS #5,G^SMI$PRIV ; enable current privies BLBS R0,90$ RET 90$: PUSHAB BUFF_DESC ; adr of word for length PUSHAB BUFF_DESC ; adr of buffer (ascid) PUSHAB COMMAND ; adr of command (ascid) PUSHL #SMI$K_FUNC_SHOW ; remote command value PUSHAB SMICTX ; SMI context block CALLS #5,G^SMI$RCOMM ; issue command and get output BLBS R0,110$ CMPL R0,#SS$_NOPRIV BNEQ 100$ MOVL #SS$_NOTMPMBX,R0 100$: RET 110$: PUSHAB BUFF_DESC ; buffer filled by SMI$RCOMM CALLS #1,G^LIB$PUT_OUTPUT ; write it out BLBS R0,120$ RET 120$: MOVW #BUFF_LEN,BUFF_DESC ; reset buffer desc length PUSHAB BUFF_DESC ; adr of word for length PUSHAB BUFF_DESC ; adr of buffer (ascid) PUSHL #0 ; adr of command (ascid) PUSHL #SMI$K_FUNC_SHOW_NEXT ; remote command value PUSHAB SMICTX ; SMI context block CALLS #5,G^SMI$RCOMM ; get subsequent command output BLBS R0,130$ RET 130$: CMPL R0,#SS$_NORMAL ; returns SS$_NORMAL when there BEQL 110$ ; is more output RET ;++ ; This routine will obtain the nodename of the node which corresponds with ; the specified EPID (/IDENT qualifier argument) by extracting the node's ; index value from the EPID and searching the local node cluster database. ; This routine is used because the $GETSYI CSIDADR argument expects a true ; CSID. After the 4th incarnation of a node in the cluster, the CSID can ; no longer be constructed from the node seq # and the node index numbers ; in the given EPID. This routine uses the node index number taken from ; the EPID(21:28) to index in the the CSV (Cluster System block Vector) ; which is pointed to by CLU$GL_CLUSVEC. If the index is value id valid, ; the vector will contain the address of the Cluster Status Block (a SOVA ; address). If the value is invalid, the slot contains the next sequence ; id (a positive non=-negative value). ; ; RTFM: 'VAXcluster Principles', Roy G. Davis, Digital Press EY-M740E-DP ; Chapter 7: 'The VAXcluster Connection Manager', ; Section 9: 'Connection Manager Data Structures' ;-- .PSECT $$CODE_DATA_RW,WRT,EXE,LONG .ENTRY GET_NODE_FROM_PID,^M PUSHAB NODENAME_STR+16 ; push adr of descriptor data end PUSHAB NODENAME_DSC ; push adr of descriptor beginning MOVAB (SP),R0 ; save adr of INADR arg $LKWSET_S INADR=(R0) ; lock in WS/no paging at IPL$_SCS BLBS R0,10$ ; locked down tight? RET ; no... tell user. 10$: MOVL #SS$_NOSUCHNODE,R10 ; assume error NOSUCHNODE MOVL 4(AP),R2 ; get the EPID BGTR 20$ ; a valid EPID? BRW 60$ ; zero or neg? not a valid EPID 20$: .IF DF ALPHA $LOCK_PAGE ERROR=60$ ; use $LOCK_PAGE macro on AXP .IF_FALSE PUSHAB 50$ ; push adr of routine end PUSHAB 30$ ; push adr of routine start MOVAB (SP),R0 ; save adr of INADR arg $LKWSET_S INADR=(R0) ; lock WS/no paging @IPL$_SCHED BLBS R0,30$ ; locked down tight? RET ; no... tell user. .ENDC 30$: EXTZV #PCB$V_EPID_NODE_IDX,- ; extract node index from EPID #PCB$S_EPID_NODE_IDX,- R2,R1 BEQL 50$ ; is it zero? not a valid index CMPW R1,CLU$GW_MAXINDEX ; is it bigger than the maximum? BGEQU 50$ ; not a valid index LOCK LOCKNAME=SCS ; acquire SCS spinlock MOVL @#CLU$GL_CLUSVEC,R0 ; get the base of the CSV MOVL (R0)[R1],R0 ; get adr of Cluster System Block BGEQ 40$ ; not a valid CSB index entry EXTZV #PCB$V_EPID_NODE_SEQ,- ; extract node seq. # from EPID #PCB$S_EPID_NODE_SEQ,R2,-(SP) INSV (SP)+,#16,- ; move to hi word in R1 #PCB$S_EPID_NODE_SEQ,R1 CMPZV #0,#<16+PCB$S_EPID_NODE_SEQ>,- CSB$L_CSID(R0),R1 ; does it compare against CSID? BNEQ 40$ ; nope... not valid index MOVL CSB$L_SB(R0),R1 ; get adr of the system block MOVAL SB$T_NODENAME(R1),R1 ; and the adr of the nodename MOVQ NODENAME_DSC,R2 ; move nodename desc to R2:R3 MOVZBL (R1),NODENAME_DSC ; modify the length MOVZBL (R1)+,R0 ; make ascic into a desc MOVC5 R0,(R1),#20,R2,(R3) ; copy nodename string MOVZWL #SS$_NORMAL,R10 ; return success 40$: UNLOCK LOCKNAME=SCS ; release the SCS spinlock 50$: .IIF DF,ALPHA, $UNLOCK_PAGE ; use $UNLOCK_PAGE macro on AXP 60$: MOVL R10,R0 RET .END