From: SMTP%"rlboyd@rock.concert.net" 9-FEB-1994 15:53:30.48 To: EVERHART CC: Subj: SLMOD part 2 of 5 From: Bob Boyd X-Disclaimer-1: rock.concert.net is a CONCERT-CONNECT public access host. X-Disclaimer-2: Opinions expressed are not necessarily X-Disclaimer-3: those of MCNC or the CONCERT Network. Message-Id: <9402092050.AA24074@rock.concert.net> Subject: SLMOD part 2 of 5 To: ADAMSE@LETT.KUN.NL (Hans Adamse), 8004slb@vmsf.csd.mu.edu (Sandy Berger), Everhart@arisia.gce.com (Glenn Everhart), bolson@u.washington.edu (Ed Bolson), jkraft@mccoy.fhcrc.org (John Kraft) Date: Wed, 9 Feb 94 15:50:23 EST X-Mailer: ELM [version 2.3 PL11] -+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X`09if( cli_present('DELETE').ne.cli$_absent) then X`09`09insert_flag = .false. Xc Xc see if they have specified DELETE=ALL Xc X`09`09status = cli_present('DELETE.ALL') X`09`09if( (status.eq.cli$_locpres).or.(status.eq.cli$_present) ) then X`09`09`09delete_all = .TRUE. X`09`09else`09! they've said /DELETE=NOALL`20 X`09`09`09if((status.eq.cli$_locneg).or.(status.eq.cli$_negated) ) X`091`09`09ok_to_delete = .FALSE. X`09`09endif`09! delete all present X`09else if( cli_present('REMOVE').ne.cli$_absent) then X`09`09insert_flag = .false. Xc Xc see if they have specified DELETE=ALL Xc X`09`09status = cli_present('REMOVE.ALL') X`09`09if( (status.eq.cli$_locpres).or.(status.eq.cli$_present) )then X`09`09`09delete_all = .TRUE. X`09`09else`20 X`09`09`09if((status.eq.cli$_locneg).or.(status.eq.cli$_negated) ) X`091`09`09ok_to_delete = .FALSE. X`09`09endif`09! delete all present X`09endif Xc Xc Is it ok to delete the logical name if the list is empty after Xc processing the deletion list? Xc X`09status = cli_present('EMPTY_DELETE') X`09if( status.ne.cli$_absent) then X`09`09ok_to_delete = status.ne.cli$_negated X`09endif Xc Xc Find out whether it will be Before or After Xc X`09status = cli_present('AFTER') X`09if( status.ne.cli$_absent) then X`09`09defaulted = status.eq.cli$_defaulted X`09`09after_flag = .true. X`09`09before_flag = .false. X`09`09status = cli_get_value('AFTER',cmd_item,cmd_len) Xc Xc Process the after field, if empty then -1 to indicate the end Xc X`09`09if( cmd_len.gt.0 ) then X`09`09`09status = ots$cvt_ti_l(cmd_item(:cmd_len),after_index) X`09`09else X`09`09`09after_index = -1 X`09`09endif X`09`09if( defaulted .and. .not.insert_flag ) then Xc Xc when deleting and /AFTER is defaulted, set it to start from the beginning Xc X`09`09`09after_index = 0 X`09`09endif`09! defaulted and delete in progress X`09endif`09! after selected Xc Xc Process BEFORE qualifier if present Xc X`09if( cli_present('BEFORE').ne.cli$_absent) then X`09`09after_flag = .false. X`09`09before_flag = .true. X`09`09status = cli_get_value('BEFORE',cmd_item,cmd_len) Xc Xc process the before item. If empty, then it is before the 1st item Xc X`09`09if( cmd_len.gt.0) then X`09`09`09status = ots$cvt_ti_l(cmd_item(:cmd_len),before_index) X`09`09else X`09`09`09before_index = 0 X`09`09endif X`09endif Xd`09TYPE *,'insert_flag:',insert_flag Xd`09TYPE *,'after_flag:',after_flag,', after_index:',after_index Xd`09TYPE *,'before_flag:',before_flag,', before_index:',before_index Xc Xc Determine if any global translation attributes are present. If so, read Xc in all of the values and build a mask of them. Xc X`09status = cli_present('TRANSLATION_ATTRIBUTES') X`09if( `09status.eq.cli$_present X`091`09.or.status.eq.cli$_concat X`092`09.or.status.eq.cli$_comma X`093`09.or.status.eq.cli$_locpres) then X`09 status = cli_get_value('TRANSLATION_ATTRIBUTES',cmd_item,cmd_len) X`09 if( status.ne.cli$_absent) then X`09 status = cli_present('TRANSLATION_ATTRIBUTES.CONCEALED') Xd`09`09type *,'TRANSLATION_attributes.Conceal: ',status X`09`09if((status.eq.cli$_locpres).or.(status.eq.cli$_present)) then X`09`09 tran_attributes = lnm$m_concealed.or.tran_attributes X`09`09else if( (status.eq.cli$_locneg) .or. X`091`09`09 (status.eq.cli$_negated) ) then X`09`09 tran_attributes = (.not.lnm$m_concealed).and.tran_attributes X`09`09endif ! concealed_present X X X`09`09status = cli_present('TRANSLATION_ATTRIBUTES.TERMINAL') Xd`09`09type *,'Translation_attributes.Terminal: ',status X`09`09if((status.eq.cli$_locpres).or.(status.eq.cli$_present)) then X`09`09 tran_attributes = lnm$m_terminal.or.tran_attributes X`09`09else if( (status.eq.cli$_locneg) .or. X`091`09`09 (status.eq.cli$_negated) ) then X`09`09 tran_attributes = (.not.lnm$m_terminal).and.tran_attributes X`09`09endif ! terminal_present X`09 endif ! TRANSLATION value present X`09endif ! TRANSLATION qualifier present Xd`09type *,'Tran_Attributes:',tran_attributes Xc Xc Determine if there is an equivalence name present. If so, read Xc in all of the values and build a list of them. Also process translation Xc attributes. Xc X`09input_item = 0 X`09p2_status = cli_present('Equivalence_Name') Xd`09type *, 'p2_status:',p2_status X`09do while(`09p2_status.eq.cli$_present X`091`09.or.p2_status.eq.cli$_concat X`092`09.or.p2_status.eq.cli$_comma) Xc Xc Get the next value from the list Xc X`09 p2_status = cli_get_value('Equivalence_Name',cmd_item,cmd_len) Xd`09 type *, 'equ_name:'//cmd_item(:cmd_len) X`09 if( p2_status.ne.cli$_absent) then Xc Xc Increment the counter of how many items have been read Xc X`09`09input_item = 1+input_item Xc Xc Store the equivalence string and its length Xc X`09`09input_list(input_item).name_length = cmd_len X`09`09input_list(input_item).name_string = cmd_item(:cmd_len) Xc Xc Set the attributes to the value of the global mask before processing any l Vocal Xc override. Xc X`09`09input_list(input_item).attributes = tran_attributes Xc Xc Is there any local translation attribute specified? If so, unwind the Xc list and store the mask. Similar to the global one, use cli$_locpres Xc X`09 `09status = cli_present('TRANSLATION_ATTRIBUTES') X`09 `09if( status.eq.cli$_concat.or. status.eq.cli$_present X`092`09.or.status.eq.cli$_comma X`093`09.or.status.eq.cli$_locpres) then X`09`09 status = cli_get_value('TRANSLATION_ATTRIBUTES', X`091`09`09`09`09cmd_item,cmd_len) X`09`09 if( status.ne.cli$_absent) then X`09`09status = cli_present('TRANSLATION_ATTRIBUTES.CONCEALED') Xd`09`09type *,'Translation_attributes.Conceal: ',status X`09`09if( (status.eq.cli$_locpres) X`091`09`09.or. (status.eq.cli$_present)) then X`09`09 input_list(input_item).attributes = X`091`09 lnm$m_concealed.or.input_list(input_item).attributes X`09`09else if( (status.eq.cli$_locneg) .or. X`091`09`09 (status.eq.cli$_negated) ) then X`09`09 input_list(input_item).attributes = X`091`09 (.not.lnm$m_concealed).and. X`092`09`09input_list(input_item).attributes X`09`09endif ! concealed_present X X X`09`09status = cli_present('TRANSLATION_ATTRIBUTES.TERMINAL') Xd`09`09type *,'Translation_Attributes.Terminal: ',status X`09`09if( (status.eq.cli$_locpres) X`091`09`09.or. (status.eq.cli$_present)) then X`09`09 input_list(input_item).attributes = X`091`09 lnm$m_terminal.or.input_list(input_item).attributes X`09`09else if( (status.eq.cli$_locneg) .or. X`091`09`09 (status.eq.cli$_negated) ) then X`09`09 input_list(input_item).attributes = X`091`09 (.not.lnm$m_terminal).and. X`092`09`09input_list(input_item).attributes X`09`09endif ! terminal_present X`09 endif ! translation value present X`09 endif ! translation qualifier present X`09 endif ! p2 list element present X`09enddo Xc X`09input_count = input_item X Xd`09type *,'Input Count:',input_count Xc Xc Grab the process privilege mask in case locks and/or access mode are an is Vsue Xc X`09jpi_list(1).item_code = jpi$_curpriv X`09jpi_list(1).buffer_address = %loc(current_privileges) X`09jpi_list(1).buffer_length = 4 X`09jpi_list(1).return_length_address = 0 X X`09jpi_list(2).item_code = jpi$_authpriv X`09jpi_list(2).buffer_address = %loc(authorized_privileges) X`09jpi_list(2).buffer_length = 4 X`09jpi_list(2).return_length_address = 0 X X`09jpi_list(3).item_code = jpi$_imagpriv X`09jpi_list(3).buffer_address = %loc(image_privileges) X`09jpi_list(3).buffer_length = 4 X`09jpi_list(3).return_length_address = 0 X X`09jpi_list(4).item_code = jpi$_procpriv X`09jpi_list(4).buffer_address = %loc(process_privileges) X`09jpi_list(4).buffer_length = 4 X`09jpi_list(4).return_length_address = 0 X X`09jpi_list(5).end_list = 0 X`09status = sys$getjpi(,,,jpi_list,,,) X Xd`09type 990,'Process_Privileges: ',Process_privileges Xd`09type 990,'Current_Privileges: ',Current_privileges Xd`09type 990,'Authorized_Privileges: ',Authorized_privileges Xd`09type 990,'Image_Privileges: ',Image_privileges Xc Xc If the current process has sufficient privileges or the image has Xc sufficient privileges to do this, then for each table (input and output) Xc determine the actual table name and its parent table. Xc For either one, if they are a shared logical name table Xc take a lock out on the table and the search list logical name being Xc worked on before translating it. Xc Xc For current releases of VAX/VMS a shared logical name table is any child Xc logical name table of LNM$SYSTEM_DIRECTORY. All lnt's are children of Xc either LNM$PROCESS_DIRECTORY(private) or LNM$SYSTEM_DIRECTORY(shared) Xc Xc Check the input table name first Xc X`09if( input_tlen.gt.0 ) then X`09 status = lnm_table_find(input_table_name, input_table_len, X`091`09`09input_table_parent, input_table_parent_len, X`092`09`09logical_name(:lnm_len), input_table(:input_tlen), X`093`09`09lnt$m_read,input_access_mode) X`09 if( status.ne.ss$_normal ) call exit(status) Xc Xc If the table is a shared table then take out a lock on it and the Xc search list logical name being worked on. Xc X`09 if( (input_table_len.gt.0) .and. X`091 (input_table_parent(:input_table_parent_len).ne. X`092`09'LNM$PROCESS_DIRECTORY') ) X`093 call lock_it( 1,input_table_name(:input_table_len), X`094`09`09 logical_name(:lnm_len) ) X`09endif Xc Xc Check the output table next. If the output table is the same as the Xc input table, then don't do anything more to lock it -- the work done for Xc the input table will suffice. Xc X`09if( output_table(:output_tlen).ne.input_table(:input_tlen)) then X`09 status = lnm_table_find(output_table_name, output_table_len, X`091`09`09output_table_parent, output_table_parent_len, X`092`09`09logical_name(:lnm_len), output_table(:output_tlen), X`093`09`09lnt$m_write,output_access_mode) X`09 if( status.ne.ss$_normal ) call exit(status) Xc Xc If the table is a shared table then take out a lock on it and the Xc search list logical name being worked on. Xc X`09 if( output_table_parent(:output_table_parent_len).ne. X`091`09'LNM$PROCESS_DIRECTORY' ) X`091 call lock_it( 2,output_table_name(:output_table_len), X`092`09`09 logical_name(:lnm_len) ) X`09endif Xc Xc Determine if the logical name exists, and Xc determine the maximum index of the logical name Xc X`09lnm_list(1).item_code = lnm$_max_index X`09lnm_list(1).buffer_length = 4 X`09lnm_list(1).buffer_address = %loc(initial_index) X`09lnm_list(1).return_length_address = 0 X`09lnm_list(2).item_code = lnm$_attributes X`09lnm_list(2).buffer_length = 4 X`09lnm_list(2).buffer_address = %loc(input_attributes) X`09lnm_list(2).return_length_address = 0 X`09lnm_list(3).end_list = 0 Xc Xc If there was an input table name specified then use it. Otherwise Xc allow translation via normal translation search list. Xc X`09if( input_tlen.le.0 ) then X`09`09input_tlen = 12 X`09`09input_table(1:input_tlen) = 'LNM$FILE_DEV' X`09endif X`09if( input_access_mode.le.psl$c_user) then X`09 status = sys$trnlnm(,input_table(:input_tlen), X`091`09logical_name(:lnm_len),input_access_mode,lnm_list) X`09else X`09 status = sys$trnlnm(,input_table(:input_tlen), X`091`09logical_name(:lnm_len),,lnm_list) X`09endif ! access mode specified for input ? Xd`09type *,'Translate:',status,', Attributes:',input_attributes Xc Xc If the logical name exists, then translate it. Xc X`09if( (status.eq.ss$_normal) X`091`09.and. (initial_index.ge.0) ) then ! the logical name exists Xc Xc Build the item list to retrieve all of the equivalence strings and Xc attributes. Xc X`09translation_count = 1+initial_index X`09do indx = 0,initial_index Xc Xc For a search list we have to tell it each index that we want retrieved Xc X`09`09index_table(1+indx) = indx X`09`09lnm_list(1+indx*gnum).item_code = lnm$_index X`09`09lnm_list(1+indx*gnum).buffer_length = 4 X`09`09lnm_list(1+indx*gnum).buffer_address = %loc(index_table(1+indx)) X`09`09lnm_list(1+indx*gnum).return_length_address = 0 Xc Xc We want the string and its associated length Xc X`09`09lnm_list(2+indx*gnum).item_code = lnm$_string X`09`09lnm_list(2+indx*gnum).buffer_length = X`091`09`09len(translation(1).name_string) X`09`09lnm_list(2+indx*gnum).buffer_address = X`091`09`09%loc(translation(1+indx).name_string) X`09`09lnm_list(2+indx*gnum).return_length_address = X`091`09`09%loc(translation(1+indx).name_length) Xc Xc We want to preserve any existing attributes associated with Xc each equivalence string. Xc X`09`09lnm_list(3+indx*gnum).item_code = lnm$_attributes X`09`09lnm_list(3+indx*gnum).buffer_length = 4 X`09`09lnm_list(3+indx*gnum).buffer_address = X`091`09`09%loc(translation(1+indx).attributes) X`09`09lnm_list(3+indx*gnum).return_length_address = 0 Xc X`09enddo`09! build translation parameter item list Xc Xc Tack on the end marker Xc X`09list_end = 1+gnum*translation_count X`09lnm_list(list_end).end_list = 0 Xc Xc Acquire all of the equivalence names and attributes. Again, differentiate Xc calls based on whether or not a specific name table was requested. Xc X`09 if( input_access_mode.le.psl$c_user) then X`09`09status = sys$trnlnm(,input_table(:input_tlen), X`091`09`09logical_name(:lnm_len),input_access_mode,lnm_list) X`09 else X`09`09status = sys$trnlnm(,input_table(:input_tlen), X`091`09`09logical_name(:lnm_len),,lnm_list) X`09 endif ! input_tlen >0 X`09else Xc XC The name doesn't exist? Xc Xd`09`09type *,'TRNLNM STATUS:',status X`09`09if( status .ne.SS$_NOLOGNAM) then X`09`09`09call exit(status) X`09`09endif X`09endif ! logical name exists Xc Xc Preserve input logical name attributes (unless specifically overridden) Xc X`09name_attributes = input_attributes.and. X`091`09(lnm$m_confine.or.lnm$m_no_alias) Xc Xc Determine if any name attributes are present on the command. If so, read Xc in all of the values and build a mask of them. Xc X`09status = cli_present('NAME_ATTRIBUTES') X`09if( `09status.eq.cli$_present X`091`09.or.status.eq.cli$_concat X`092`09.or.status.eq.cli$_comma X`093`09.or.status.eq.cli$_locpres) then X`09 status = cli_get_value('NAME_ATTRIBUTES',cmd_item,cmd_len) X`09 if( status.ne.cli$_absent) then Xc Xc Check for CONFINE Xc X`09 status = cli_present('NAME_ATTRIBUTES.CONFINE') Xd`09`09type *,'NAME_attributes.Confine:',status X`09`09if((status.eq.cli$_locpres).or.(status.eq.cli$_present)) then X`09`09 name_attributes = lnm$m_confine.or.name_attributes X`09`09else if( (status.eq.cli$_locneg) .or. X`091`09`09 (status.eq.cli$_negated) ) then X`09`09 name_attributes = (.not.lnm$m_confine).and.name_attributes X`09`09endif ! confine_present Xc Xc Check for NO_ALIAS Xc X`09`09status = cli_present('NAME_ATTRIBUTES.NO_ALIAS') Xd`09`09type *,'Name_attributes.No_Alias:',status X`09`09if((status.eq.cli$_locpres).or.(status.eq.cli$_present)) then X`09`09 name_attributes = lnm$m_no_alias.or.name_attributes X`09`09else if( (status.eq.cli$_locneg) .or. X`091`09`09 (status.eq.cli$_negated) ) then X`09`09 name_attributes = (.not.lnm$m_no_alias).and.name_attributes X`09`09endif ! no_alias_present X`09 endif ! NAME value present X`09endif ! NAME qualifier present Xd`09type *,'Name_Attributes:',name_attributes Xc Xd`09type *, 'Preparing Item List' Xc Xc Now what? Xc Xc Are we inserting or removing? If insert_flag is false, then it is a Xc DELETE of one kind or other Xc Xc If we are inserting -- get the input list and adjust the list to make it Xc fit in. Xc Xc Determine whether or not we will use chaining to do it or just append Xc to the list. Arrange all of the pointers and then do the work. Xc X`09if( insert_flag ) then`09! we are inserting/appending/prepending X`09 if( before_flag ) then`09! before something X`09 if( before_index.gt.translation_count) then`09! before the end of it Xc Xc Same as /AFTER Xc X`09 move_index = translation_count X`09 else Xc Xc Determine indices to move, etc. Xc X`09 if( before_index.lt.1) then`09! before the beginning X`09 move_index = 0 X`09 else X`09 move_index = before_index-1`09! somewhere in the middle X`09 endif ! where to move X`09 endif ! before_index > max_index X`09 else ! we're inserting after something`20 Xc Xc It's after something Xc X`09 if( after_index.gt.initial_index) then`09! past the end Xc Xc The value is too big, so it goes at the end Xc X`09 move_index = translation_count X`09 else ! after_index < max_index Xc Xc It is somewhere in the front,middle or maybe at the end Xc X`09 if( after_index.ge.0) then X`09 move_index = after_index X`09 else ! after all Xc Xc It goes at the end Xc X`09 move_index = translation_count X`09 endif ! after_index >= 0 X`09 endif ! after_index < max_index X`09 endif ! before or after Xc Xc Now process the lists Xc Xd`09type *, 'Translation_count:',translation_count Xd`09type *, 'Move_index:',move_index Xd`09type *, 'Input_count:',input_count Xc X`09if( translation_count.gt.0 ) then ! there was a translation X`09 if( move_index.gt.0 ) then ! Does it go in the middle? X`09 call build_item_list (Translation,Lnm_List,Move_Index) X`09 endif Xc Xc Insert the new item(s) Xc X`09 call build_item_list (Input_List, X`091`09Lnm_List(2*Move_Index+1),input_count) Xc Xc Finish off with any remaining item(s) from the original translation Xc X`09 if( move_index.lt.translation_count) then X`09 call build_item_list (Translation(Move_Index+1), X`091`09Lnm_List(2*Move_Index+2*input_count+1), X`092`09Translation_count-Move_Index) X`09 endif ! move_index < translation_count X`09else ! no translation existed X`09 call build_item_list (Input_List(1),Lnm_List(1),input_count) X`09endif ! translation test X`09output_item = 2 X`09else ! delete/insert ? Xc Xc We are deleting: get to the proper index and start eliminating Xc things from the list. Xc Xc Is it a list of items or is it a bounded by name delete? Xc X`09status = cli_present('ITEM') X`09if( status.ne.cli$_absent ) then`09! ITEM present Xc Xc Get the list of item number(s) Xc X`09 input_count = 0 X`09 do while(`09status.eq.cli$_present X`091`09.or.status.eq.cli$_concat X`092`09.or.status.eq.cli$_comma) X`09`09status = cli_get_value('ITEM',cmd_item,cmd_len) X`09`09if( status.ne.cli$_absent) then Xd`09`09 type *,'item:'//cmd_item(:cmd_len) Xd`09`09 type *,'status:',status X`09`09 if( cmd_len.gt.0) then`09! we have a value Xc Xc see if we have a * or number, or number1-number2 Xc X`09`09 if( cmd_item(:cmd_len).eq.'*') then`09! wildcarded = all X`09`09`09delete_all = .TRUE. X`09`09 else`09! something other than * X`09`09 if ( .not. DELETE_ALL ) then ! specific ones make sense X`09`09`09hyphen_loc = index(cmd_item(:cmd_len),'-') X`09`09`09if( hyphen_loc .ne. 0 ) then Xc Xc it's a pair of values, get the pair and fill in between Xc special combinations: -m,n-,m-*,*-m Xc X`09`09`09if( hyphen_loc .eq. 1 ) then`09! n1 = null X`09`09`09 delete_start = 1`09! null sets start to 1 X`09`09`09else`09! it is not null X`09`09`09 if( cmd_item(1:hyphen_loc-1) .eq. '*') then X`09`09`09 delete_start = 1`09! wild card = 1 X`09`09`09 else`09! it must be a number X`09`09 `09`09p2_status =`20 X`091`09`09`09ots$cvt_ti_l(cmd_item(:hyphen_loc-1),`20 X`092`09`09`09`09delete_start) X`09`09 `09`09if(p2_status.ne.ss$_normal) call exit(p2_status) X`09`09`09 endif ! n1 number`20 X`09`09`09endif`09! n1 not null X`09`09`09if( hyphen_loc .eq. cmd_len ) then`09! n2 = null X`09`09`09 delete_end = translation_count X`09`09`09else`09! n2 not null X`09`09`09 if( cmd_item(hyphen_loc+1:cmd_len).eq.'*') then X`09`09`09 delete_end = translation_count`09! n2 = to end X`09`09`09 else`09! n2 is a number X`09`09 `09`09p2_status =`20 X`091`09`09`09ots$cvt_ti_l(cmd_item(hyphen_loc+1:cmd_len),`20 X`092`09`09`09`09delete_end) X`09`09 `09`09if(p2_status.ne.ss$_normal) call exit(p2_status) X`09`09`09 endif! n2 star/number X`09`09`09endif`09! n2 null/value X`09`09`09if( delete_end.gt.translation_count)`20 X`091`09`09`09delete_end = translation_count Xc Xc fill the table with the list Xc X`09`09`09do item_id = delete_start,delete_end X`09`09`09`09input_count = 1+input_count X`09`09`09`09index_table(input_count) = item_id X`09`09`09enddo X`09`09`09else`09! no hyphen, single number X`09`09 X`09`09`09 input_count = 1+input_count X`09`09`09 p2_status = ots$cvt_ti_l(cmd_item(:cmd_len), X`091`09`09`09index_table(input_count)) X`09`09`09 if(p2_status.ne.ss$_normal) call exit(p2_status) X`09`09 endif`09! hyphen X`09`09 endif`09! specific deletes make sense (no delete_all) X`09`09 endif`09! * or something else X`09`09 endif`09! cmd_len > 0 => we have a value X`09`09endif`09! next good item X`09 enddo`09! ITEM qualifier present X`09 item_flag = input_count.gt.0 X`09 if( item_flag ) then`09! items were supplied X`09`09input_item = 1 X`09`09move_index = index_table(input_item) Xd`09`09type *,'Input_item:',input_item Xd`09`09type *,'Move_index:',Move_index X`09 endif`09! items were supplied Xc`20 Xc Otherwise we're deleting based on matching equivalence names supplied Xc with the command. Xc Xc ITEM was not specified Xc Are we deleting from the beginning or the middle/end? Xc Xc Xc If the count is 0 and /DELETE has been specified then assume /DELETE=ALL Xc if /ITEM was not specified Xc X`09else if( input_count .eq. 0 .and. .not. insert_flag ) then X`09`09delete_all = .TRUE. X`09else if( before_flag ) then X`09 if( before_index.gt.translation_count ) then X`09`09move_index = translation_count X`09 else X`09 if( before_index.lt.1 ) then X`09 move_index = 1 X`09 else X`09 move_index = before_index-1 X`09 endif ! before_index > 1 X`09 endif ! before_index > translation_count X`09else ! after_flag X`09 if( after_index.gt. translation_count ) then X`09 move_index = translation_count-1 X`09 else ! after_index < initial_index X`09 if( after_index .lt. 0 ) then X`09 move_index = translation_count-1 X`09 else ! after_index > 0 X`09 move_index = after_index X`09 endif ! after_index >0 X`09 endif ! after_index < translation_count X`09endif ! before/after X`09end_index = move_index + input_count X`09if( end_index .gt. translation_count ) end_index = translation_count Xd`09type *,'Move_Index:',move_index,', End_Index:',end_index Xc Xc What is this next block doing? Fill in here when I remember Xc Xc X`09if( move_index.gt.1 ) then X`09 call build_item_list( Translation, Lnm_List, move_index-1) X`09 if( end_index.lt. initial_index) then X`09 call build_item_list( translation(end_index), X`091`09lnm_list(2*move_index-1), translation_count-end_index+1) X`09 endif ! move_index < initial_index X`09else ! move_index < 1 X`09 call build_item_list( Translation(end_index), lnm_list, X`091`09translation_count-end_index+1 ) X`09endif ! move_index > 1 X`09 X`09if( delete_all ) then`09! don't look at 'em, wipe 'em all!! ;-) X`09`09output_item = 0 X`09else`09! process the items specified Xc Xc Search for the input items and remove them in order from the list. Xc If not found before finishing the translation list, the remaining ones Xc are not checked. Xc X`09input_item = 1 X`09output_item = 1 X`09do lnm_index = 1, translation_count Xc Xc Does the current item on the translation list = the head of the input list V? Xc X`09 if(item_flag .and. ( move_index.eq.lnm_index ) ) then Xc Xc If working from item list numbers then update the pointer Xc X`09`09input_item = 1+input_item X`09`09if( input_item.le.input_count ) then X`09`09`09move_index = index_table(input_item) X`09`09else X`09`09`09move_index = translation_count+1 X`09`09endif Xd`09`09type *,'Input_item:',input_item Xd`09`09type *,'Move_index:',move_index X`09 else if( .not.item_flag .and. X`091 (lnm_index.ge.move_index .and. X`091 translation(lnm_index).name_string( X`092 :translation(lnm_index).name_length).eq. X`093 input_list(input_item).name_string( X`094 :input_list(input_item).name_length)) X`095 ) then Xd`09`09type *, 'Matched input:',input_item,' with translation:', Xd`091`09`09lnm_index X`09`09input_item = 1+input_item X`09 else ! copy the element from the translation list Xc Xc For each equivalence name generate 2 entries in the item list. Xc The 1st entry is for the translation attributes. The 2nd entry Xc is for the string. Xc X`09 lnm_list(output_item).item_code = lnm$_attributes X`09 lnm_list(output_item).buffer_length = 4 Xc Xc Force equivalence name attributes to be limited to only those that Xc apply directly to equivalence names. Currently these are only the Xc 2 translation attributes. Xc X`09 translation(lnm_index).attributes = X`091`09(lnm$m_concealed.or.lnm$m_terminal) X`092`09.and. translation(lnm_index).attributes X`09 lnm_list(output_item).buffer_address = X`091`09%loc(translation(lnm_index).attributes) X`09 Lnm_List(output_item).return_length_address = 0 Xc Xc Put in the entry for the equivalence name string Xc X`09 output_item = 1+output_item X`09 Lnm_List(output_item).item_code = lnm$_string X`09 Lnm_List(output_item).buffer_length = X`091`09translation(lnm_index).name_length X`09 Lnm_List(output_item).buffer_address = X`091`09%loc(translation(lnm_index).name_string) X`09 Lnm_List(output_item).return_length_address = 0 X`09 output_item = 1+output_item X`09 endif X`09end do Xc Xc Terminate the item list Xc X`09lnm_list(output_item).end_list = 0 Xc Xc X`09endif ! process specified items for delete X`09endif ! insert/delete Xc Xc Then call the sys$crelnm routine to put the new definition out. Xc If the new list is empty, then delete the logical name. Xc Xd`09type *,'Output_item:',output_item X`09if( output_item.gt.1 ) then ! There is a new definition Xc Xc Xc During the development I was limited to working on a system without Xc privileges, so I didn't really test out the ideas listed below. Xc Eventually, I would like to have the image coded and tested for Xc safety when it might be installed with privileges. Currently Xc I would only recommend that you install it with SYSLCK privilege. Xc Xc If the image is installed with privileges, but the user doesn't have Xc SYSNAM or GRPNAM or some other relevant privilege, then it may be Xc important to add code in here to make sure that the current privileges Xc are no greater than the ones held by the user outside of the image. Xc The only legitimate privilege to keep if the image is installed with it Xc is the SYSLCK privilege -- there is no real risk in using SYSLCK since Xc the only conflict will be with other users of SLMOD or other utilities Xc that might use the same locks as SLMOD. Xc Xc Xc The meta-code for the privs check might look like this: Xc Xc Does the image have privs to affect system or group logical names ? Xc If so, does the user have elevated privs ? Intersect the user's Xc privs with the image privs. Xc Xc Does the image/user have SYSLCK? If so, make sure that stays on. Xc Set current privs to the appropriate ones. Xc Perform the $CRELNM or $DELLNM. Xc Restore privs to what they were. Xc Xc If an access mode was specified, then use it. Otherwise use the Xc default of none -- which is USER Xc Xc If an access mode was specified, then use it. Otherwise use the Xc default of none -- which is USER Xc X`09 if( output_access_mode.le.psl$c_user ) then Xc Xc verify that the user has privs to access the mode they are asking for Xc Xc Xc Decide between call to $crelnm and lib$set_logical Xc X`09 if( output_access_mode.eq.psl$c_user) then X`09`09create_mode = 1 X`09 else if( output_access_mode.eq.psl$c_super ) then X`09`09create_mode = 2 X`09 else Xc Xc Does the user have sufficient privileges to do the inner access mode Xc requested? If not, use supervisor mode instead. Xc X`09`09if( (current_privileges.and. X`091`09`09(prv$m_cmexec.or.prv$m_cmkrnl)).eq.0 ) then X`09`09 create_mode = 2 X`09`09 output_access_mode = psl$c_super X`09`09else X`09`09 create_mode = 1 X`09`09endif X`09 endif ! mode tests Xd`09type *,'Create_Mode:',create_mode X`09 if( create_mode.eq.1) then X`09`09status = sys$crelnm(name_attributes,output_table(:output_tlen), X`091`09`09logical_name(:lnm_len),output_access_mode,lnm_list) X`09 else X`09`09status = lib$set_logical(logical_name(:lnm_len),, X`091`09`09output_table(:output_tlen),name_attributes,lnm_list) X`09 endif ! create mode compare X`09 else ! output access mode not specified X`09 status = sys$crelnm(name_attributes,output_table(:output_tlen), X`091`09`09logical_name(:lnm_len),,lnm_list) X`09 endif X`09 exit_status = status X X`09 if( (exit_status.and.1) .ne. 0 ) then Xc Xc Post processing Xc X`09 if( log_flag) then X`09 p2_status = lib$put_output( X`091 'SLMOD-I-UPDATED, DEFINED/UPDATED logical name ' X`092 //logical_name(:lnm_len)) X`09 endif X X`09 if( cli_present('SYMBOL').ne.cli$_absent) then X`09 status = cli_get_value('SYMBOL',symbol_name,sym_len) X`09 sym_ptr = 1 X`09 sym_ctr = 1 X`09 do while( ( lnm_list(sym_ctr).item_code.ne.0) .and. X`091`09(sym_ptr.lt.1024) ) X`09`09sym_ctr = 1+sym_ctr X`09 cmd_len = lnm_list(sym_ctr).buffer_length +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+-