.TITLE PERM ; define a symbol permanent .IDENT "PERM V1%4.051" ; internals demo program... ;++ ; This program will establish a permanent symbol definition for the symbol ; specified as the input parameter to this program. ; This program can be used to make any defined "STRING" symbol permanent. ;-- ; Copyright © 1994 by Brian Schenkenberger and TMESIS Consulting, Jackson NJ ; 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 the software or information contain herein for a ; particular purpose. ; ------------------------- ; This software may be copied and distributed only with the inclusion of this ; copyright notice. ;-- ; OpenVMS/VAX Build: ; ; $ MACRO PERMANENT ; $ LINK PERMANENT ;-- ; OpenVMS/AXP Build: ; ; $ MACRO PERMANENT ; $ LINK/SYSEXE PERMANENT,SYS$LOADABLE_IMAGES:DCLDEF.STB ;-- ; PERMANENT requires CMEXEC privilege. ;-- ; To use: ; 1) First, define a foreign command symbol definition: ; $ PERMANENT:==$DISK$???:[]PERMANENT ; ; 2) Then, define the symbol to be made permanent: ; $ ETERNITY:=="I want this symbol to live forever!" ; ; 3) Use the command PERMANENT to define the symbol permanently. ; $ PERMANENT ETERNITY ; ; 4) Any attempt to redefine the symbol will result in the following: ; %DCL-W-PERMSYM, deletion of permanent symbols not allowed ;-- ; Modifications: ; 09-FEB-1994: creation date. ;-- .NTYPE ...ON_ALPHA...,R31 .IIF EQ,<...ON_ALPHA...@-4&^XF>-5, .DISABLE FLAGGING .LIBRARY "SYS$LIBRARY:LIB.MLB" ; look here during assembly $LIBCLIDEF ; LIB${GET/SET}_SYMBOL codes $CLIMSGDEF ; CLI error message codes $DSCDEF ; VMS descriptor class/type codes ;---------------------------------------------------------------------------- .PSECT $$DATA,WRT,NOEXE,QUAD SYMBOL: .LONG !,0 ARGLST: .LONG 1 .ADDRESS SYMBOL AUTODIN:.LONG ^x00000000,^x1DB71064 ; Autodin-II CRC polynomial table .LONG ^x3B6E20C8,^x26D930AC ; ------------------------------- .LONG ^x76DC4190,^x6B6B51F4 ; used to calculate a hash value .LONG ^x4DB26158,^x5005713C ; of the symbol to determine the .LONG ^xEDB88320,^xF00F9344 ; index of the symbol table list- .LONG ^xD6D6A3E8,^xCB61B38C ; head where the symbol's (SYM) .LONG ^x9B64C2B0,^x86D3D2D4 ; block will/should be queued. .LONG ^xA00AE278,^xBDBDF21C ; ------------------------------- .IF DF ELECT_SYLOGIN_ONLY_USAGE ;++ Optional restriction check code $LNMDEF ; TRNLNM item list definitions LNMITEMS: .WORD 255,LNM$_STRING .ADDRESS SYLOGIN .ADDRESS SYLOGLEN .LONG 0 SYLOGIN: .BLKB 256 SYLOGLEN: .LONG 0 FAB: $FAB FNA=SYLOGIN,NAM=NAM,DNM=<.COM;> NAM: $NAM ESA=EXPAND,ESS=NAM$C_MAXRSS EXPAND: .BLKB NAM$C_MAXRSS LNM$SYS_TAB: .ASCID /LNM$SYSTEM_TABLE/ SYS$SYLOGIN: .ASCID /SYS$SYLOGIN/ .ENDC ;-- Optional restriction check code ;---------------------------------------------------------------------------- .PSECT $$CODE_RO,PIC,GBL,SHR,NOWRT,EXE,QUAD .ENTRY PERM_SYM,^m<> .IF DF ELECT_SYLOGIN_ONLY_USAGE ;++ Optional restriction check code $TRNLNM_S TABNAM=LNM$SYS_TAB,- ; search system logical table LOGNAM=SYS$SYLOGIN,- ; for SYS$SYLOGIN and return ITMLST=LNMITEMS ; its translated value BLBS R0,10$ RET 10$: MOVB SYLOGLEN,FAB+FAB$B_FNS ; update FAB with filename length $PARSE FAB=FAB ; parse to get expanded name BLBS R0,20$ RET 20$: $SEARCH FAB=FAB ; search to get exact name BLBS R0,30$ RET .ENDC ;-- Optional restriction check code 30$: PUSHAB SYMBOL ; get the name of the symbol CALLS #1,G^LIB$GET_FOREIGN ; from the command line BLBS R0,40$ RET 40$: $CMEXEC_S ROUTIN=SET_PERM,- ;call SET_PERM at exec mode ARGLST=ARGLST RET ;++ ; This routine calculates and locates the listhead in which the symbol's SYM ; block should be located. It then walks-the-list looking for the specified ; symbol. When it is located, it sets the type to PERManent. ;-- .ENTRY SET_PERM,^m MOVAB @#CTL$AG_CLIDATA,R7 ; base of cli data region .IF DF ELECT_SYLOGIN_ONLY_USAGE ;++ Optional restriction check code MOVL PPD$L_PRC(R7),R0 ; get adr of prc area MOVL PRC_L_IDFLNK(R0),R1 ; get the first IDF block MOVL IDF_L_FILENAME(R1),R2 ; and find the filename MOVZBL NAM+NAM$B_ESL,R0 ; length of expanded name MOVL NAM+NAM$L_ESA,R1 ; address of expanded name CMPC3 R0,(R1),1(R2) ; compare it with SYS$SYLOGIN BEQL 10$ ; continue if it compares MOVL #SS$_NOPRIV,R0 ; tell user NOPRIV RET .ENDC ;-- Optional restriction check code 10$: MOVQ @4(AP),R4 ; get the symbol name CRC AUTODIN,#-1,R4,(R5) ; calc the hash value BICL2 #^C^XFF,R0 ; calc the listhead index MOVAQ @PPD$Q_CLISYMTBL+4(R7)[R0],R6 ; get the assoc listhead MOVL R6,R7 ; save for end-of-line check 20$: MOVL (R6),R6 ; walk the list of SYM blocks CMPL R7,R6 ; end of the line??? BEQL 30$ ; quit if at end. MOVAB SYM_T_SYMBOL(R6),R1 ; get ascic symbol adress MOVZBL (R1)+,R0 ; extract the length CMPC5 R0,(R1),#0,R4,(R5) ; is this our symbol? BNEQ 20$ ; better luck next round. TSTW SYM_W_NONUNIQUE(R6) ; is the symbol unique? BLSS 20$ ; branch if not unique... TSTW SYM_W_PROCLEVEL(R6) ; is it a gbl/lcl symbol? BGEQ 20$ ; local symbol test CMPB #SYM_K_STRING,SYM_B_TYPE(R6) ; is this a string symbol? BNEQ 30$ MOVB #SYM_K_PERM,SYM_B_TYPE(R6) ; make it permanent MOVL #CLI$_NORMAL,R0 ; signal success RET 30$: MOVL #CLI$_UNDSYM,R0 ; return with UNDSYM RET .END PERM_SYM