q~% SLMOD.SAV[A` SLMOD.SAVBACKUP AAAREADME.TXT;,SLMOD.FOR;,SLMOD.HLP;,SLMOD_STRUCTURES.INC;,BUILD.COM;,KIT.COM;,CLIMSGDEF.FOR;,SLMOD.CLD;,TEST.COM;,SLMOD.SPEC;,SLMOD.OBJ; SLMOD.SAV/SAVE_SET/BLOCK=8192/COMMENT=SLMOD source kitSLMOD source kit RBN jV5.3 _VAXTM1::  _$2$DUA62: V5.3  ;*[LNM]AAAREADME.TXT;2+,4./ 4K-{0123KPWO56 hJj7Jj8 9GHJ(SLMOD = Search List Modification UtilityKSLMOD is a utility for manipulating search list logical names in a way that9mimics the behavior of the DEFINE command in most ways. EThe program will create a search list logical name, insert additionalHelements at any specified position in the list, remove specific elementsEfrom the list, and if the resulting list is empty, it will delete theGlogical name. If the logical name to be updated is in a shared logicalHname table the program will use the lock manager to coordinate access toJthe table and logical name. Note: there apparently is no other interlockJmechanism on logical names, so this will not prevent a DEFINE command fromHoverwriting a logical name at the same time that SLMOD is working on it.IThe program concept was developed by Bob Boyd while working at the HarrisEMicroelectronics Center. The program was completed while working for3Unisys at the US EPA National Data Processing Dept.EIncluded are: source files, build procedure, specification text, and-help text, and a verification/test procedure.GYou can contact Bob via Internet at RBN@EPAVAX.RTPNC.EPA.GOV. By voiceat (919)541-4441.p SLMOD.SAV {[LNM]SLMOD.FOR;46PKo*[LNM]SLMOD.FOR;46+, .K/ 4PKI\-{0123KPWOL56 xgj7@j8@m9GHJ3C Last Modified: 5-APR-1991 16:09:25.38, By: RBN G! To do: find out what happens to the attributes that should be copiedC! from the old definition to the new one. Seems that they're being ! dropped.c)C Last Modified: , By: RBN 1 15:19:56.51c Program SLMOD implicit nonecc Title: SLMOD.FORc.c Author: Robert L. Boyd, Harris Semiconductorcc Date: Nov, 1990cAc Abstract: This program is intended to simplify the manipulation7c of logical name search lists. It provides a simpleDc VAX/VMS DCL command line interface to define or update search listFc logical names. The most significant features are the easy insertion.c and deletion of elements in the search list.c=c Contributors: Robert L. Boyd, Fred Stluka, & Jerry Leichterc9 integer sys$trnlnm, sys$crelnm, sys$dellnm, ots$cvt_ti_l> integer cli$get_value,cli$present, lib$put_output, sys$getjpiB integer str$copy_r, lib$set_symbol, lib$set_logical, dereference,( 1 lib$delete_symbol, lib$delete_logicalc include '($lnmdef)' include 'climsgdef.for' include '($psldef)' include '($ssdef)' include '($jpidef)' include '($prvdef)'c parameter gnum = 3 parameter maximum_items = 1280 parameter maximum_list = (1+gnum)*maximum_itemsc% integer*4 index_table(maximum_items)c include 'slmod_structures.inc'* record /item_list/ lnm_list(maximum_list) record /item_list/ jpi_list(6)c9 record /equivalence_strings/ translation(maximum_items)c8 record /equivalence_strings/ input.І SLMOD.SAV {[LNM]SLMOD.FOR;46PKB_list(maximum_items)cc cE integer initial_index, final_index, max_index, move_index, end_index+ integer first_item, lnm_index, tran_attribc5 character*31 input_table, output_table, logical_name character*255 cmd_item. character symbol_name*32, symbol_buffer*32385 character tran_string*64; integer sym_len, sym_ptr, sym_ctr, name_pointer, tran_len4 integer*2 cmd_len, translation_count, input_count, $ 1 input_item, lnm_len, output_item3 integer*4 name_attributes /0/, tran_attributes /0/ integer*4 create_mode2 byte input_access_mode/4/, output_access_mode/2/cD integer p2_status, status, input_tlen*2, output_tlen*2, exit_status< integer indx, list_end, input_attributes /0/, before_index, 1 after_index, item_index8 logical after_flag, before_flag, log_flag, insert_flag, 1 ok_to_delete, item_flagcc Process the command line c. status = cli$get_value('p1',cmd_item,cmd_len)" logical_name = cmd_item(:cmd_len) lnm_len = cmd_lencCc If the INPUT_TABLE is not explicitly specified there is no accessEc mode associated with the input table. The global qualifier(s) that5c specify access mode apply only to the output table.c3 if( cli$present('USER_MODE').ne.cli$_absent ) then! output_access_mode = psl$c_user> else if( cli$present('SUPERVISOR_MODE').ne.cli$_absent ) then" output_access_mode = psl$c_super= else if( cli$present('EXECUTIVE_MODE').ne.cli$_absent ) then! output_access_mode = psl$c_exec: else if( cli$present('KERNEL_MODE').ne.cli$_absent ) then# output_access_mode = psl$c_kernel endif0d type *,'INPUT_ACCESS_MODE:',input_access_mode,.d 1 ', OUTPUT_ACCESS_MODE:',output_access_modec+c Process any specified logical table namesc input_tlen = 0% status = cli$present('OUTPUT_TABLE')$ if( status.eq.cli$_defaulted ) thenc?c workaround for bug in CLI interface routines with lists with 3c defaulted values. Bug present through VMS V5.3-1c Output_Tlen = 11- Output_Table(1:output_tlen) = 'LNM$PROCESS'" output_access_mode = psl$c_super endifc;c If the output table was defaulted but there is a /Cc qualifier present, honor that qualifier over the defaulted table.c- if( cli$present('JOB').ne.cli$_absent ) then input_table = 'LNM$JOB' input_tlen = 7 output_table = 'LNM$JOB' output_tlen = 74 else if( cli$present('GROUP').ne.cli$_absent ) then input_table = 'LNM$GROUP' input_tlen = 9 output_table = 'LNM$GROUP' output_tlen = 95 else if( cli$present('SYSTEM').ne.cli$_absent ) then input_table = 'LNM$SYSTEM' input_tlen = 10 output_table = 'LNM$SYSTEM' output_tlen = 105 else if( cli$present('PROCESS').ne.cli$_absent )then input_table = 'LNM$PROCESS' input_tlen = 11 output_table = 'LNM$PROCESS' output_tlen = 11 endifc,c Process any INPUT_TABLE qualifier value(s)c$ status = cli$present('INPUT_TABLE') if( status.ne.cli$_absent) then8 status = cli$get_value('input_table',cmd_item,cmd_len)+ if( cli$present('input_table.name')) then status = cli$get_value(. 1 'input_table.name',input_table,input_tlen) endif+ if( cli$present('input_table.mode')) then? status = cli$get_value('input_table.mode',cmd_item,cmd_len)3d type *,'INPUT_ACCESS_MODE:'//cmd_item(:cmd_len)< if( cmd_item(:1).eq.'U') input_access_mode = psl$c_user= if( cmd_item(:1).eq.'S') input_access_mode = psl$c_super< if( cmd_item(:1).eq.'E') input_access_mode = psl$c_exec> if( cmd_item(:1).eq.'K') input_access_mode = psl$c_kernel endif endifc)c Process OUTPUT_TABLE qualifier value(s)c% status = cli$present('OUTPUT_TABLE')" if( status.eq.cli$_present ) thenc&d type *,'Output_Table status:',status9 status = cli$get_value('output_table',cmd_item,cmd_len),d type *,'Output_Table:'//cmd_item(:cmd_len)+ status = cli$present('output_table.name')" if( status.ne.cli$_absent ) then status = cli$get_value(4 1 'output_table.name',output_table,output_tlen) endif+ status = cli$present('output_table.mode')" if( status.ne.cli$_absent ) then status = cli$get_value() 1 'output_table.mode',cmd_item,cmd_len)4d type *,'OUTPUT_ACCESS_MODE:'//cmd_item(:cmd_len)< if( cmd_item(:1).eq.'U') output_access_mode = psl$c_user= if( cmd_item(:1).eq.'S') output_access_mode = psl$c_super< if( cmd_item(:1).eq.'E') output_access_mode = psl$c_exec> if( cmd_item(:1).eq.'K') output_access_mode = psl$c_kernel endif endif0d type *,'INPUT_ACCESS_MODE:',input_access_mode,.d 1 ', OUTPUT_ACCESS_MODE:',output_access_modec&c see if we are to LOG the transactionc status = cli$present('LOG')# if( status .eq. cli$_present) then log_flag = 1 else log_flag = 0 endifc/c Find out whether we are Inserting or Deletingcc/ if( cli$present('INSERT').ne.cli$_absent) then insert_flag = .true. endif/ if( cli$present('DELETE').ne.cli$_absent) then insert_flag = .false.4 else if( cli$present('REMOVE').ne.cli$_absent) then insert_flag = .false. endifcAc Is it ok to delete the logical name if the list is empty after c processing the deletion list?c% status = cli$present('EMPTY_DELETE') if( status.ne.cli$_absent) then' ok_to_delete = status.ne.cli$_negated endifc-c Find out whether it will be Before or Afterc. if( cli$present('AFTER').ne.cli$_absent) then after_flag = .true. before_flag = .false.2 status = cli$get_value('AFTER',cmd_item,cmd_len)c?c Process the after field, if empty then -1 to indicate the endc if( cmd_len.gt.0 ) then 8 status = ots$cvt_ti_l(cmd_item(:cmd_len),after_index) else  after_index = -1 endif endifcc/ if( cli$present('BEFORE').ne.cli$_absent) then after_flag = .false. before_flag = .true.3 status = cli$get_value('BEFORE',cmd_item,cmd_len)cDc process the before item. If empty, then it is before the 1st itemc if( cmd_len.gt.0) then 9 status = ots$cvt_ti_l(cmd_item(:cmd_len),before_index) else before_index = 0 endif endif#d TYPE *,'inse SLMOD.SAV {[LNM]SLMOD.FOR;46PKrt_flag:',insert_flag>d TYPE *,'after_flag:',after_flag,', after_index:',after_indexBd TYPE *,'before_flag:',before_flag,', before_index:',before_indexcKc Determine if any global translation attributes are present. If so, read 0c in all of the values and build a mask of them.c/ status = cli$present('TRANSLATION_ATTRIBUTES') if( status.eq.cli$_present 1 .or.status.eq.cli$_concat 2 .or.status.eq.cli$_comma# 3 .or.status.eq.cli$_locpres) thenE status = cli$get_value('TRANSLATION_ATTRIBUTES',cmd_item,cmd_len)# if( status.ne.cli$_absent) thenA status = cli$present('TRANSLATION_ATTRIBUTES.CONCEALED')3d type *,'TRANSLATION_attributes.Conceal: ',status? if((status.eq.cli$_locpres).or.(status.eq.cli$_present)) then8 tran_attributes = lnm$m_concealed.or.tran_attributes' else if( (status.eq.cli$_locneg) .or.$ 1 (status.eq.cli$_negated) ) then@ tran_attributes = (.not.lnm$m_concealed).and.tran_attributes endif ! concealed_present 9 status = cli$present('TRANSLATION_ATTRIBUTES.TERMINAL')4d type *,'Translation_attributes.Terminal: ',status? if((status.eq.cli$_locpres).or.(status.eq.cli$_present)) then7 tran_attributes = lnm$m_terminal.or.tran_attributes' else if( (status.eq.cli$_locneg) .or.$ 1 (status.eq.cli$_negated) ) then? tran_attributes = (.not.lnm$m_terminal).and.tran_attributes endif ! terminal_present% endif ! TRANSLATION value present& endif ! TRANSLATION qualifier present+d type *,'Tran_Attributes:',tran_attributescBc Determine if there is an equivalence name present. If so, read Ic in all of the values and build a list of them. Also process translation c attributes.c input_item = 0 p2_status = cli$present('P2') d type *, 'p2_status:',p2_status$ do while( p2_status.eq.cli$_present 1 .or.p2_status.eq.cli$_concat 2 .or.p2_status.eq.cli$_comma)c"c Get the next value from the listc3 p2_status = cli$get_value('P2',cmd_item,cmd_len)+d type *, 'equ_name:'//cmd_item(:cmd_len)% if( p2_status.ne.cli$_absent) thenc8c Increment the counter of how many items have been readc input_item = 1+input_itemc-c Store the equivalence string and its lengthc. input_list(input_item).name_length = cmd_len9 input_list(input_item).name_string = cmd_item(:cmd_len)cPc Set the attributes to the value of the global mask before processing any local c override.c5 input_list(input_item).attributes = tran_attributescGc Is there any local translation attribute specified? If so, unwind theGc list and store the mask. Similar to the global one, use cli$_locpresc 1 status = cli$present('TRANSLATION_ATTRIBUTES')7 if( status.eq.cli$_concat.or. status.eq.cli$_present 2 .or.status.eq.cli$_comma# 3 .or.status.eq.cli$_locpres) then4 status = cli$get_value('TRANSLATION_ATTRIBUTES', 1 cmd_item,cmd_len)# if( status.ne.cli$_absent) then: status = cli$present('TRANSLATION_ATTRIBUTES.CONCEALED')3d type *,'Translation_attributes.Conceal: ',status if( (status.eq.cli$_locpres) ' 1 .or. (status.eq.cli$_present)) then, input_list(input_item).attributes = ? 1 lnm$m_concealed.or.input_list(input_item).attributes' else if( (status.eq.cli$_locneg) .or.$ 1 (status.eq.cli$_negated) ) then, input_list(input_item).attributes = & 1 (.not.lnm$m_concealed).and.% 2 input_list(input_item).attributes endif ! concealed_present 9 status = cli$present('TRANSLATION_ATTRIBUTES.TERMINAL')4d type *,'Translation_Attributes.Terminal: ',status if( (status.eq.cli$_locpres)' 1 .or. (status.eq.cli$_present)) then, input_list(input_item).attributes = > 1 lnm$m_terminal.or.input_list(input_item).attributes( else if( (status.eq.cli$_locneg) .or. $ 1 (status.eq.cli$_negated) ) then, input_list(input_item).attributes = % 1 (.not.lnm$m_terminal).and.% 2 input_list(input_item).attributes endif ! terminal_present( endif ! translation value present* endif ! translation qualifier present" endif ! p2 list element present enddoc input_count = input_item#d type *,'Input Count:',input_countcJc Grab the process privilege mask if locks and/or access mode is an issue c5 if( ( output_table(:output_tlen).ne.'LNM$PROCESS' )7 1 .or.( input_table(:input_tlen).ne.'LNM$PROCESS' ) 6 2 .or.( output_access_mode .lt.psl$c_super ) ) then) jpi_list(1).item_code = jpi$_curpriv: jpi_list(1).buffer_address = %loc(current_privileges)" jpi_list(1).buffer_length = 4* jpi_list(1).return_length_address = 0* jpi_list(2).item_code = jpi$_authpriv= jpi_list(2).buffer_address = %loc(authorized_privileges)" jpi_list(2).buffer_length = 4* jpi_list(2).return_length_address = 0* jpi_list(3).item_code = jpi$_imagpriv8 jpi_list(3).buffer_address = %loc(image_privileges)" jpi_list(3).buffer_length = 4* jpi_list(3).return_length_address = 0* jpi_list(4).item_code = jpi$_procpriv: jpi_list(4).buffer_address = %loc(process_privileges)" jpi_list(4).buffer_length = 4* jpi_list(4).return_length_address = 0 jpi_list(5).end_list = 0( status = sys$getjpi(,,,jpi_list,,,)4d type 990,'Process_Privileges: ',Process_privileges4d type 990,'Current_Privileges: ',Current_privileges:d type 990,'Authorized_Privileges: ',Authorized_privileges0d type 990,'Image_Privileges: ',Image_privileges endifcCc If the current process has sufficient privileges or the image has@c sufficient privileges to do this, then take a lock out on the 1c logical name search list before translating it.c if( input_tlen.gt.0 ) then3 if( input_table(:input_tlen).ne.'LNM$PROCESS' )0 1 call lock_it( 1,input_table(:input_tlen)," 2 logical_name(:lnm_len) ) endifA if( output_table(:output_tlen).ne.input_table(:input_tlen)) then4 if( output_table(:output_tlen).ne.'LNM$PROCESS' )1 1 call lock_it( 2,output_table(:output_tlen), 2 logical_name(:lnm_len) ) endifc,c Determine if the logical name exists, and 1c determine the maximum index of the logical namec' lnm_list(1).item_code = lnm$_max_index lnm_list(1).buffer_length = 41 lnm_list(1).buffer_address = %loc(initial_index)& lnm_list(1).return_length_address = 0( lnm_list(2).item_code = lnm$_attributes lnm_list(2).buffer_length = 44 lnm_list(2).buffer_address = %loc(input_attributes)& lnm_list(2).return_length_address = 0 lnm_list(3).end_list = 0cDc If there was an input table name specified then use it. Otherwise7c allow translation via normal translation search list.c if( input_tlen.le.0 ) then  input_tlen = 12, input_table(1:input_tlen) = 'LNM$FILE_DEV' endif* if( input_access_mode.le.psl$c_user) then1 status = sys$trnlnm(,input_table(:input_tlen),5 1 logical_name(:lnm_len),input_access_mode,lnm_list) else1 status = sys$trnlnm(,input_table(:input_tlen),$ 1 logical_name(:lnm_len),,lnm_list)* endif ! access mode specified for input ?=d type *,'Translate:',status,', Attributes:',input_attributesc0c If the logical name exists, then translate it.c if( (status.eq.ss$_normal) > 1 .and. (initial_index.ge.0) ) then ! the logical name existscEc Build the item list to retrieve all of the equivalence strings and c attributes.c$ translation_count = 1+initial_index do indx = 0,initial_indexcHc For a search list we have to tell it each index that we want retrievedc index_table(1+indx) = indx. lnm_list(1+indx*gnum).item_code = lnm$_index) lnm_list(1+indx*gn*ew SLMOD.SAV {[LNM]SLMOD.FOR;46PK c um).buffer_length = 4B lnm_list(1+indx*gnum).buffer_address = %loc(index_table(1+indx))1 lnm_list(1+indx*gnum).return_length_address = 0c.c We want the string and its associated lengthc/ lnm_list(2+indx*gnum).item_code = lnm$_string( lnm_list(2+indx*gnum).buffer_length = # 1 len(translation(1).name_string)) lnm_list(2+indx*gnum).buffer_address = ) 1 %loc(translation(1+indx).name_string)/ lnm_list(2+indx*gnum).return_length_address =) 1 %loc(translation(1+indx).name_length)c=c We want to preserve any existing attributes associated withc each equivalence string.c3 lnm_list(3+indx*gnum).item_code = lnm$_attributes) lnm_list(3+indx*gnum).buffer_length = 4) lnm_list(3+indx*gnum).buffer_address = ( 1 %loc(translation(1+indx).attributes)1 lnm_list(3+indx*gnum).return_length_address = 0c enddocc Tack on the end markerc$ list_end = 1+gnum*translation_count lnm_list(list_end).end_list = 0cLc Acquire all of the equivalence names and attributes. Again, differentiateDc calls based on whether or not a specific name table was requested.ca, if( input_access_mode.le.psl$c_user) then0 status = sys$trnlnm(,input_table(:input_tlen),6 1 logical_name(:lnm_len),input_access_mode,lnm_list) else0 status = sys$trnlnm(,input_table(:input_tlen),% 1 logical_name(:lnm_len),,lnm_list)d endif ! input_tlen >0 elseecoC The name doesn't exist?hcp!d type *,'TRNLNM STATUS:',statusm# if( status .ne.SS$_NOLOGNAM) thenr call exit(status) endif endif ! logical name existscrIc Preserve input logical name attributes (unless specifically overridden)tca( name_attributes = input_attributes.and.$ 1 (lnm$m_confine.or.lnm$m_no_alias)c Lc Determine if any name attributes are present on the command. If so, read 0c in all of the values and build a mask of them.cg( status = cli$present('NAME_ATTRIBUTES') if( status.eq.cli$_present 1 .or.status.eq.cli$_concat 2 .or.status.eq.cli$_commab# 3 .or.status.eq.cli$_locpres) then> status = cli$get_value('NAME_ATTRIBUTES',cmd_item,cmd_len)# if( status.ne.cli$_absent) thenec$c Check for CONFINE$cd8 status = cli$present('NAME_ATTRIBUTES.CONFINE')+d type *,'NAME_attributes.Confine:',statusm? if((status.eq.cli$_locpres).or.(status.eq.cli$_present)) thene6 name_attributes = lnm$m_confine.or.name_attributes( else if( (status.eq.cli$_locneg) .or. % 1 (status.eq.cli$_negated) ) theng> name_attributes = (.not.lnm$m_confine).and.name_attributes endif ! confine_present)cc Check for NO_ALIAScl2 status = cli$present('NAME_ATTRIBUTES.NO_ALIAS'),d type *,'Name_attributes.No_Alias:',status? if((status.eq.cli$_locpres).or.(status.eq.cli$_present)) thenc7 name_attributes = lnm$m_no_alias.or.name_attributes_' else if( (status.eq.cli$_locneg) .or.$ 1 (status.eq.cli$_negated) ) then? name_attributes = (.not.lnm$m_no_alias).and.name_attributesp endif ! no_alias_present endif ! NAME value present endif ! NAME qualifier presentu%+d type *,'Name_Attributes:',name_attributestccd type *, 'Preparing Item List'/c c Now what?_ctc Are we inserting or removing?tc*Jc If we are inserting -- get the input list and adjust the list to make it c fit in.icxGc Determine whether or not we will use chaining to do it or just append1Ac to the list. Arrange all of the pointers and then do the work.ac  if( insert_flag ) theni if( before_flag ) then 0 if( before_index.gt.translation_count) thenctc Same as /AFTERc x% move_index = translation_count elsecce!c Determine indices to move, etc. cl# if( before_index.lt.1) then  move_index = 0t elsei$ move_index = before_index-1 endif ! where to move% endif ! before_index > max_indexn else ! before_flag.c$c It's after somethingcc+ if( after_index.gt.initial_index) then(cE-c The value is too big, so it goes at the endacs% move_index = translation_counts# else ! after_index < max_indexhc9c It is somewhere in the front,middle or maybe at the endNc_! if( after_index.ge.0) then ! move_index = after_indexc else ! after all c c It goes at the endca' move_index = translation_count$ endif ! after_index >= 0a$ endif ! after_index < max_index endif ! before or afterccc Now process the listshc0d type *, 'Translation_count:',translation_count"d type *, 'Move_index:',move_index$d type *, 'Input_count:',input_countc < if( translation_count.gt.0 ) then ! there was a translation9 if( move_index.gt.0 ) then ! Does it go in the middle?r; call build_item_list (Translation,Lnm_List,Move_Index)i endifctc Insert the new item(s)c$ call build_item_list (Input_List,( 1 Lnm_List(2*Move_Index+1),input_count)ctEc Finish off with any remaining item(s) from the original translationuca, if( move_index.lt.translation_count) then5 call build_item_list (Translation(Move_Index+1),$* 1 Lnm_List(2*Move_Index+2*input_count+1), 2 Translation_count-Move_Index)) endif ! move_index < translation_count else ! no translation existed? call build_item_list (Input_List(1),Lnm_List(1),input_count)M endif ! translation test1 output_item = 2 else ! delete/insert ?tceCc If we are deleting, get to the proper index and start eliminatingc things from the list.PcT:c Is it a list of items or is it a bounded by name delete?cl status = cli$present('ITEM')e! if( status.ne.cli$_absent ) thennc' c Get the list of item number(s)c( input_count = 0# do while( status.eq.cli$_present 1 .or.status.eq.cli$_concat 2 .or.status.eq.cli$_comma)1 status = cli$get_value('ITEM',cmd_item,cmd_len)! if( status.ne.cli$_absent) thenc'd type *,'item:'//cmd_item(:cmd_len)ed type *,'status:',status if( cmd_len.gt.0) then e! input_count = 1+input_countu2 p2_status = ots$cvt_ti_l(cmd_item(:cmd_len), 1 index_table(input_count))m6 if(p2_status.ne.ss$_normal) call exit(p2_status) endif endifs enddo item_flag = input_count.gt.0a if( item_flag ) then_ input_item = 1& move_index = index_table(input_item)"d type *,'Input_item:',input_item"d type *,'Move_index:',Move_index endif dcn8c Are we deleting from the beginning or the middle/end? cc else if( before_flag ) then/ if( before_index.gt.translation_count ) thens move_index = translation_count elsem" if( before_index.lt.1 ) then  move_index = 1e elset" move_index = before_index-1 endif ! before_index > 1g+ endif ! before_index > translation_countc else ! after_flag/ if( after_index.gt. translation_count ) thenf% move_index = translation_count-1d% else ! after_index < initial_index." if( after_index .lt. 0 ) then' move_index = translation_count-1c else ! after_index > 0f move_index = after_indexe endif ! after_index >0i* endif ! after_index < translation_count endif ! before/after,% end_index = move_index + input_counteE if( end_index .gt. translation_count ) end_index = translation_count( if( move_index.gt.1 ) then_= call build_item_list( Translation, Lnm_List, move_index-1)( if( end_index.lt. initial_index) then2 call build_item_list( translation(end_index),; 1 lnm_list(2*move_index-1), translation_count-end_index+1)e% endif ! move_index < initial_index  else ! move_index < 1: call build_item_list( Translation(end_index), lnm_list," 1 translation_count-end_index+1 ) endif SLMOD.SAV {[LNM]SLMOD.FOR;46PK. ! move_index > 1ccnDc Search for the input items and remove them in order from the list.Hc If not found before finishing the translation list, the remaining onesc are not checked.cu input_item = 1 output_item = 1$ do lnm_index = 1, translation_countcMc Does the current item on the translation list = the head of the input list? co8 if(item_flag .and. ( move_index.eq.lnm_index ) ) thenc,;c If working from item list numbers then update the pointericc input_item = 1+input_iteme& if( input_item.le.input_count ) then' move_index = index_table(input_item) else r# move_index = translation_count+1 endifi"d type *,'Input_item:',input_item"d type *,'Move_index:',move_index else if( .not.item_flag .and.$ 1 (lnm_index.ge.move_index .and. ( 1 translation(lnm_index).name_string(/ 2 :translation(lnm_index).name_length).eq..( 3 input_list(input_item).name_string(- 4 :input_list(input_item).name_length)) f 5 ) then<d type *, 'Matched input:',input_item,' with translation:',d 1 lnm_index input_item = 1+input_item'4 else ! copy the element from the translation listcr@c For each equivalence name generate 2 entries in the item list.Ac The 1st entry is for the translation attributes. The 2nd entrybc is for the string.c6 lnm_list(output_item).item_code = lnm$_attributes, lnm_list(output_item).buffer_length = 4ccDc Force equivalence name attributes to be limited to only those thatDc apply directly to equivalence names. Currently these are only thec 2 translation attributes.sc)) translation(lnm_index).attributes = S& 1 (lnm$m_concealed.or.lnm$m_terminal)* 2 .and. translation(lnm_index).attributes+ lnm_list(output_item).buffer_address =.* 1 %loc(translation(lnm_index).attributes)4 Lnm_List(output_item).return_length_address = 0c.2c Put in the entry for the equivalence name stringcn output_item = 1+output_item2 Lnm_List(output_item).item_code = lnm$_string+ Lnm_List(output_item).buffer_length = N% 1 translation(lnm_index).name_length , Lnm_List(output_item).buffer_address = + 1 %loc(translation(lnm_index).name_string)l4 Lnm_List(output_item).return_length_address = 0 output_item = 1+output_item endif end docc)c Terminate the item list$cg# lnm_list(output_item).end_list = 0.c. endif ! insert/deletectBc Then call the sys$crelnm routine to put the new definition out.9c If the new list is empty, then delete the logical name.'cn8 if( output_item.gt.1 ) then ! There is a new definitionceBc If an access mode was specified, then use it. Otherwise use the"c default of none -- which is USERcl. if( output_access_mode.le.psl$c_user ) thenctGc verify that the user has privs to access the mode they are asking for_ctce5c Decide between call to $crelnm and lib$set_logicalrc_/ if( output_access_mode.eq.psl$c_user) thenf create_mode = 1 7 else if( output_access_mode.eq.psl$c_super ) then y create_mode = 2c elsedcnFc Does the user have sufficient privileges to do the inner access mode2c requested? If not, use supervisor mode instead.c p if( (current_privileges.and./ 1 (prv$m_cmexec.or.prv$m_cmkrnl)).eq.0 ) thenp create_mode = 2=$ output_access_mode = psl$c_super else create_mode = 1 endife endif ! mode testsa#d type *,'Create_Mode:',create_modei if( create_mode.eq.1) then A status = sys$crelnm(name_attributes,output_table(:output_tlen),e7 1 logical_name(:lnm_len),output_access_mode,lnm_list) elset3 status = lib$set_logical(logical_name(:lnm_len),,c8 1 output_table(:output_tlen),name_attributes,lnm_list) endif ! create mode compare* else ! output access mode not specifiedD status = sys$crelnm(name_attributes,output_table(:output_tlen),% 1 logical_name(:lnm_len),,lnm_list)S endif m exit_status = status ' if( (exit_status.and.1) .ne. 0 ) thenicec Post processingTcB if( log_flag) thenp p2_status = lib$put_output(7 1 'SLMOD-I-UPDATED, DEFINED/UPDATED logical name '( 2 //logical_name(:lnm_len)) endif1 if( cli$present('SYMBOL').ne.cli$_absent) thenn9 status = cli$get_value('SYMBOL',symbol_name,sym_len)t sym_ptr = 1 sym_ctr = 19 do while( ( lnm_list(sym_ctr).item_code.ne.0) .and. ) 1 (sym_ptr.lt.1024) ) sym_ctr = 1+sym_ctrd2 cmd_len = lnm_list(sym_ctr).buffer_lengthd type *,'cmd_len:',cmd_len,-d 1 ', sym_ptr:',sym_ptr,',sym_ctr:',sym_ctrT if( sym_ctr.lt.3 ) thensA status = str$copy_r(symbol_buffer(sym_ptr:sym_ptr+cmd_len-1),)4 1 cmd_len, %val(lnm_list(sym_ctr).buffer_address)) sym_ptr = 1+cmd_leni else( symbol_buffer(sym_ptr:sym_ptr) = ',' sym_ptr = 1+sym_ptr A status = str$copy_r(symbol_buffer(sym_ptr:sym_ptr+cmd_len-1),d3 1 cmd_len,%val(lnm_list(sym_ctr).buffer_address))  sym_ptr = sym_ptr+cmd_lena endif tran_attrib = 9 1 dereference(%val(lnm_list(sym_ctr-1).buffer_address))d'd type 990,'Tran_attrib: ',tran_attribf990 format(1X,A,Z8) if( tran_attrib.ne.0) then" tran_string = '/TRANSLATION=(' tran_len = 145 if( (tran_attrib.and.lnm$m_concealed).ne.0 ) thenp3 tran_string(tran_len+1:tran_len+9) = 'CONCEALED'a tran_len = tran_len+94 if( (tran_attrib.and. lnm$m_terminal).ne.0 ) then6 tran_string(tran_len+1:tran_len+9) = ',TERMINAL' tran_len = tran_len+9_ endif else4 if( (tran_attrib.and. lnm$m_terminal).ne.0 ) then5 tran_string(tran_len+1:tran_len+8) = 'TERMINAL'l tran_len = tran_len+8j endif endifg, tran_string(1+tran_len:1+tran_len) = ')' tran_len = 1+tran_len(. symbol_buffer(sym_ptr:sym_ptr+tran_len) =  1 tran_string(1:tran_len)g sym_ptr = sym_ptr+tran_len endifd sym_ctr = 1+sym_ctr(!d type *,'sym_ptr:',sym_ptrj:d type *,'symbol_buffer:'//symbol_buffer(:sym_ptr-1) enddoc_4c Add NAME_ATTRIBUTES on the end of the whole stringc # if( name_attributes.ne.0) thenr tran_string = '/NAME=('d tran_len = 77 if( (name_attributes.and.lnm$m_CONFINE).ne.0 ) thenj1 tran_string(tran_len+1:tran_len+7) = 'CONFINE's tran_len = tran_len+78 if( (name_attributes.and. lnm$m_no_alias).ne.0 ) then6 tran_string(tran_len+1:tran_len+9) = ',NO_ALIAS' tran_len = tran_len+9  endif else8 if( (name_attributes.and. lnm$m_no_alias).ne.0 ) then5 tran_string(tran_len+1:tran_len+8) = 'NO_ALIAS'e tran_len = tran_len+8l endif endif, tran_string(1+tran_len:1+tran_len) = ')' tran_len = 1+tran_leni. symbol_buffer(sym_ptr:sym_ptr+tran_len) =  1 tran_string(1:tran_len) sym_ptr = sym_ptr+tran_len endif. if( output_access_mode.le.psl$c_user ) then- if( output_access_mode.eq.psl$c_user ) then) tran_len = 10t* tran_string(1:tran_len) = '/USER_MODE'3 else if( output_access_mode.eq.psl$c_super ) then' tran_len = 16 / tran_string(:tran_len) = '/SUPERVISOR_MODE'22 else if( output_access_mode.eq.psl$c_exec ) then tran_len = 15n. tran_string(:tran_len) = '/EXECUTIVE_MODE' else tran_len = 12l+ tran_string(:tran_len) = '/KERNEL_MODE'l endife, symbol_buffer(sym_ptr:sym_ptr+tran_len) =  1 tran_string(1:tran_len)( sym_ptr = sym_ptr+tran_len endifci.c Set the DCL symbol to the appropriate valuecg) if( sym_ptr.gt.1024 ) sym_ptr = 1024id type *,'sym_ptr:',sym_ptrt8d type *,'symbol_buffer:'//symbol_buffer(:sym_ptr-1)3 status = lib$set_symbol(symbol_name(:sym_len),t 1 s=7 SLMOD.SAV {[LNM]SLMOD.FOR;46PK0=ymbol_buffer(:sym_ptr-1))  endif endif ! status normal testci' else ! the name is to be deleted if ok= if(ok_to_delete) then6d type *,'Deleting '//logical_name(:lnm_len)//' with ',d 1 //'with access mode:',output_access_mode1 if( output_access_mode.eq.psl$c_super ) thenn5 status = lib$delete_logical(logical_name(:lnm_len),$ 1 output_table(:output_tlen)) exit_status = status5 else if( output_access_mode.le.psl$c_user ) thent6 status = sys$dellnm(output_table(:output_tlen),- 1 logical_name(:lnm_len),output_access_mode)h exit_status = statust$ else ! no access mode specified6 status = sys$dellnm(output_table(:output_tlen), 1 logical_name(:lnm_len),)  exit_status = statuss% endif ! access mode is specifiedn9 if( ((exit_status.and.1).ne.0 ) .and. log_flag) then " p2_status = lib$put_output(B 1 'SLMOD-I-DELETED, logical name '//logical_name(:lnm_len)) endif elsen if( log_flag) thenx" p2_status = lib$put_output(D 1 'SLMOD-I-DELIGNORED, logical name '//logical_name(:lnm_len)//& 2 '-- /NOEMPTY_DELETE specified') endif endif ! ok_to_delete 1 if( cli$present('SYMBOL').ne.cli$_absent) theni; status = cli$get_value('SYMBOL',symbol_name,sym_len)u8 status = lib$delete_symbol(symbol_name(:sym_len)) endif endif ! name to be deletedc *c If Log is specified then note the update*c To do this properly, call lib$put_outputc1clCc If the current process has sufficient privileges or the image hasxBc sufficient privileges to do this, then release the locks on the 1c logical name search list before translating it.c  if( input_tlen.gt.0 ) thenl2 if( input_table(:input_tlen).ne.'LNM$PROCESS' )2 1 call unlock_it( 1,input_table(:input_tlen), 2 logical_name(:lnm_len) )_ endifA if( output_table(:output_tlen).ne.input_table(:input_tlen)) thenn4 if( output_table(:output_tlen).ne.'LNM$PROCESS' )4 1 call unlock_it( 2,output_table(:output_tlen), 2 logical_name(:lnm_len) )  endifc c Leave the image cc call exit(exit_status)s endA Subroutine Build_Item_List(Input_List, Out_Item_list, Num_Items)n implicit nonecu include '($lnmdef)' include 'slmod_structures.inc'lcl c Parametersct integer*2 Num_items$ record /item_list/ Out_Item_List(*)+ record /equivalence_strings/ Input_List(*)ec0c Local Variablesce4 integer itm_indx, cur_input_index, cur_output_indexc @c For each equivalence name generate 2 entries in the item list.Ac The 1st entry is for the translation attributes. The 2nd entrytc is for the string.ca do itm_indx = 0, Num_Items-1r cur_input_index = itm_indx+1(" cur_output_index = 2*itm_indx+1> Out_Item_List(cur_output_index).item_code = lnm$_attributes4 Out_Item_List(cur_output_index).buffer_length = 4cfDc Force equivalence name attributes to be limited to only those thatDc apply directly to equivalence names. Currently these are only thec 2 translation attributes.pc)/d type 980,'Attributes(',cur_input_index,') =',E*d 1 input_list(cur_input_index).attributes980 format(1X,A,I3,A,Z8) , Input_List(cur_input_index).attributes = / 1 Input_List(cur_input_index).attributes .and.r& 2 (lnm$m_concealed.or.lnm$m_terminal)4 Out_Item_List(cur_output_index).buffer_address = 0 1 %loc(input_list(cur_input_index).attributes) < Out_Item_List(cur_output_index).return_length_address = 0c$2c Put in the entry for the equivalence name stringco( cur_output_index = 1+cur_output_index: Out_Item_List(cur_output_index).item_code = lnm$_string3 Out_Item_List(cur_output_index).buffer_length = t* 1 input_list(cur_input_index).name_length4 Out_Item_List(cur_output_index).buffer_address = 0 1 %loc(input_list(cur_input_index).name_string)< Out_Item_List(cur_output_index).return_length_address = 0 end dodchc Terminate the item list.c.* Out_Item_List(2*Num_Items+1).end_list = 0 end2 Subroutine Lock_It( Lock_Number, Lnm_Table, Lnm ) Implicit None Character*(*) Lnm_Table, Lnm  Integer Lock_Numberc yDc Determine if the logical name table is a process or shared table. Hc If it is a shared table, acquire a concurrent write lock on the table Fc of interest. Then acquire an exclusive lock on the logical name of (c interest as a child of the table lock.ct include '($lckdef)' include '($lnmdef)' include '($syidef)' include '($ssdef)'e include '($prvdef)' include 'slmod_structures.inc't5 Integer*4 sys$trnlnm, sys$enqw, sys$getsyi, str$trim  Integer*4 sys$deq character*31 node_namee% integer*4 table_len, lnm_len, statusl  if( node_len.eq. 0 ) then! syi_list(1).buffer_length = 31 ( syi_list(1).item_code = syi$_nodename/ syi_list(1).buffer_address = %loc(node_name)!/ syi_list(1).return_length_address = node_len. syi_list(2).end_list = 0c & status = sys$getsyi(,,,syi_list,,,)= status = str$trim(node_name(:node_len),node_name,node_len)  endif1 status = str$trim(lnm_table,lnm_table,table_len)a# status = str$trim(lnm,lnm,lnm_len)eco@c If the user or the image has the privilege to grab system wide?c locks, use it to inhibit simultaneous access/overwrite messes 0c from occurring between different job contexts c @ if( ((current_privileges.or.image_privileges).and.prv$m_syslck) 1 .ne.0 ) thenx lock_flags = lck$m_systema endif? status = sys$enqw(,%val(lck$k_NLmode), node_lksb(lock_number),s2 1 %val(lock_flags), 'LNM_'//node_name(:node_len), 2 ,,,,,)p=d type *,'Lock LNM_'//node_name(:node_len)//' status:',status!@ status = sys$enqw(,%val(lck$k_CWmode), table_lksb(lock_number),+ 1 %val(lock_flags), lnm_table(:table_len),T- 2 %val(node_lksb(lock_number).lock_id),,,,,):d type *,'Lock '//lnm_table(:table_len)//' status:',status> status = sys$enqw(,%val(lck$K_EXmode), lnm_lksb(lock_number),# 1 %val(lock_flags), lnm(:lnm_len),o. 2 %val(table_lksb(lock_number).lock_id),,,,,)2d type *,'Lock '//lnm(:lnm_len)//' status:',status returnM- Entry UNLock_It(Lock_Number, Lnm_Table, Lnm)c< status = sys$deq( lnm_lksb(lock_number),,,%val(lock_flags))> status = sys$deq( table_lksb(lock_number),,,%val(lock_flags))= status = sys$deq( node_lksb(lock_number),,,%val(lock_flags))t returnt end) integer function dereference( argument )e implicit none integer argumentp dereference = argumentm return end from the list.PcT:c Is it a list of items or is it a bounded by name delete?cl status = cli$present('ITEM')e! if( status.ne.cli$_absent ) thennc' c Gev SLMOD.SAV\{[LNM]SLMOD.HLP;1= *[LNM]SLMOD.HLP;1+,\. / 4= -{0123KPWO 56B,ge7@y;g81U9@liGHJ1!Last Modified: 29-MAR-1991 15:57:15.66, By: RBN1 SLMOD8 Creates a search list, inserts, or removes one or more: elements from a search list. If removing leaves the list; empty and the /EMPTY_DELETE qualifier is present, then the logical name will be deleted. 9 This command is similar to the DEFINE command. See HELP. DEFINE for more about defining logical names. Format:* SLMOD logical_name equivalence_string(s) 2 Parameters4 See HELP DEFINE PARAMETERS for a full description.3 Logical_Name8 See HELP DEFINE PARAMETERS for a complete description.3 Equivalence_String(s)8 See HELP DEFINE PARAMETERS for a complete description. 2 Qualifiers /INSERT (Def): This qualifier causes SLMOD to insert, prepend, or append9 additional values to a search list or to create a search list from scratch./DELETE/REMOVE= These qualifiers are equivalent. They specify that the= elements in the search list that match the listed= equivalence string(s) or specified item numbers are to be= removed from the search list. In the case of specifying item= numbers the equivalence string(s) will not be required. When= using the /BEFORE or /AFTER qualifiers, the search list is= scanned for the equivalence strings starting with the= position in the list specified by the position qualifier used./BEFORE /AFTER (Def)/ITEM /BEFORE[=number] /AFTER[=number] /ITEM=position= Used to control the insertion or deletion of equivalence= strings. When inserting /BEFORE without a numeric value= tells the utility to insert the equivalence string(s) before= the existing list (pre-pend). When /AFTER is used without a< numeric value, the new strings are appended to the list.= /AFTER=0 is the same as /BEFORE. If /BEFORE=n specifies a= number that is greater than the number of items in the% translation it is the same as AFTER.= /ITEM may only be used with the /DELETE or /REMOVE= qualifier. It picks a specific item or list of items to be= deleted by their position in the list without regard for the( equivalence strings at those positions. /INPUT_TABLE /OUTPUT_TABLE3 /INPUT_TABLE=(NAME=lnmtable[,MODE=])9 /OUTPUT_TABLE=(NAME=lnmtable[,MODE=]);The input and output logical name tables may be selected by;the use of these qualifiers. Use of the MODE entry for the9OUTPUT_TABLE overrides the global qualifiers that specify5access mode. There is no default access mode on the9INPUT_TABLE, you must specify it if you want to force the:translation to that mode. The default for OUTPUT_TABLE is;SUPERVISOR mode. If you specify /USER/OUTPUT=(NAME=LNM$JOB)5the mode used for the output table definition will be;SUPERVISOR since it is defaulted in by specifying the table:name. If you specify /USER/JOB the mode used will be USERmode. NAME- Specifies the logical name table to be used. MODE9 Specifies the access mode to be used when translating or5 creating/updating the logical name. Valid modes are) USER, SUPERVISOR, EXECUTIVE, and KERNEL2 If the user specifies EXECUTIVE or KERNEL for the8 OUTPUT_TABLE and doesn't have the necessary privileges,8 the logical name will be created using SUPERVISOR mode./PROCESS (Def)/JOB/GROUP/SYSTEM9Using any of these qualifiers will set both the input and7output tables to the same value unless you specifically<override it with the INPUT_TABLE or OUTPUT_TABLE qualifiers. /USER_MODE/SUPERVISOR_MODE (Def)/EXECUTIVE_MODE /KERNEL_MODE3Used to select which access mode you wish to use to;define/update the logical name. If specified, the selected5mode will be used in translating the existing logical<name(if any) as well as creating the new definition. If one:of these qualifiers is specified it will only apply to the:output table, unless explicitly overridden by a MODE entry!in the /OUTPUT_TABLE value list./NAME_ATTRIBUTES# /NAME_ATTRIBUTES[=(keyword[,...])]<Controls the name attributes for the logical name. Currently9supported keywords are: NO_ALIAS and CONFINE. These are8identical to the ones supported by the DEFINE command. <See HELP DEFINE /NAME_ATTRIBUTES for more on these keywords./TRANSLATION_ATTRIBUTES* /TRANSLATION_ATTRIBUTES[=(keyword[,...])]<Specifies translation attributes to apply to the equivalence;names. These attributes apply to the elements individually.:This qualifier may be used in a global or positional mode.8If used as a global qualifier any attribute(s) specified9will be applied to all elements of the search list exceptwhere explicitly overridden..Valid keywords are: [NO]CONCEAL, NO]TERMINAL9See HELP DEFINE /TRANSLATION_ATTRIBUTES for more on these keywords./LOG/NOLOG6 Tells the utility that it is to send a log message to- SYS$OUTPUT to indicate the action performed./EMPTY_DELETE (Def)/NOEMPTY_DELETE< In the event that a /DELETE or /REMOVE causes the resulting9 list to be empty, the utility will by default delete the< specified logical name. If /NOEMPTY_DELETE is specified, no: change will be made to the search list logical name -- it will be left unchanged./SYMBOL /SYMBOL=dcl_symbol_name4Stores in a DCL local symbol a string containing the<equivalence logical name(s), any translation attributes that:apply to them, and the name attributes in a for that couldbe used to do a DEFINE. : SLMOD.SAV.+){NM]SLMOD_STRUCTURES.INC;4DP*[LNM]SLMOD_STRUCTURES.INC;4+,.+)./ 4DD-{0123KPWO56j74j8\9GHJ structure /equivalence_strings/ integer*2 name_length,filler integer*4 attributes character*255 name_string end structurec structure /item_list/ union map integer*2 buffer_length integer*2 item_code integer*4 Buffer_address! integer*4 return_length_address end map map integer*4 end_list end map end union end structurec  structure /descriptor/ integer*2 length byte type byte class integer*4 pointer end structure c structure /lock_status_block/ integer*2 status integer*2 null integer*4 lock_id integer*4 info(4) end structureD record /lock_status_block/ node_lksb(2), table_lksb(2), lnm_lksb(2) record /item_list/ syi_list(3)6 Integer*4 image_privileges/0/, current_privileges/0/,3 2 authorized_privileges/0/, process_privileges/0/% Integer*4 lock_flags/0/, Node_Len/0/ Common /lnmlocks/ 4 1 lock_flags, image_privileges, current_privileges,- 2 authorized_privileges, process_privileges, 3 node_len, syi_list," 4 node_lksb, table_lksb, lnm_lksb Y SLMOD.SAVT({[LNM]BUILD.COM;5NL"*[LNM]BUILD.COM;5+,T(./ 4N&-{0123KPWO56\fj7Lfj8̅9GHJ $ rdt = "RDT" $ null = "" $ comma = "," $ semi = ";"$ if p1 $ then >$ link_debug_flag = "/NODEBUG" ! change to /DEBUG if you want 4$ fort_debug_flag = "/DEBUG/D_LINES/list/nooptimize"$ endif$ say= "write sys$output"$ object_module = "SLMOD.OBJ" $ executable_image = "SLMOD.EXE"N$ modules = "slmod.for,slmod_structures.inc,slmod.cld,climsgdef.for,build.com"I$ who_am_i = f$element(0,";",f$environment("procedure")) ! latest versionE$ who_am_i_exactly = f$environment("procedure") ! this very procedure@$ where_am_i = f$parse("a.b;0",who_am_i,,,"syntax_only")-"A.B;0"'$ define slmod_exe 'where_am_i'/process$!$! look at files$!7$ if f$search(f$parse(executable_image,semi)).nes.null $ then?$ image_time = f$cvtime(f$file_attribute(executable_image,RDT))$ else%$ image_time = f$cvtime("1-jan-1990")$ endif3$ if f$search(f$parse(object_module,semi)).nes.null$ then=$ object_time = f$cvtime(f$file_attribute(object_module,RDT))$ else&$ object_time = f$cvtime("2-jan-1990")$ endif $ modi = 0 $module_loop:,$ nxt_module = f$element(modi,comma,modules)$ if nxt_module.nes.comma$ then$ modi = 1+modi$ if nxt_module.nes.null $ then9$ mod_time = f$cvtime( f$file_attribute(nxt_module,RDT))6$ if mod_time.lts.object_time then $ goto module_loop$ else$ goto module_loop$ endif$ else$ goto SKIP_COMPILE$ endif0$ fortran/nolist/optimize slmod'fort_debug_flag'3$ if f$search(f$parse(object_module,semi)).nes.null$ then=$ object_time = f$cvtime(f$file_attribute(object_module,RDT))$ else&$ object_time = f$cvtime("2-jan-1990")$ endif$SKIP_COMPILE: $ if object_time.gts.image_time $ then 2$ link slmod/executable=slmod.exe'link_debug_flag'$ endif$ set command slmod3$!Last Modified: 5-APR-1991 13:41:43.57, By: RBN  7]{NM]BUILD_XWOUGTURES.INC;47 |p8^9x8[xp_a d KClsC+'N5^RjzYTN bCQV^,-k|RU$vsMJm|~fx nW94vDn4OP5aQ&)jcQ99wG1$;qx4< l8@S"o;=)7qc 6;a*Mu{c^2w0/eHDp ~>Qkw9MqYYNK gZ|f,qT"8CoOY|Vl#o)`/lkvi m\Bhj%q! RR A' V0%V@b3!^#{q=-4 oT L O25%,E@Q] pXd!&,O&f+rJ4uj V&upa9VCDX9i&)Y~zZh*Eh bAN#v  r6e[-7~6?^/L gu5B!tp}~rY-!'afQJq BumCyZ}{1<7>=DWs$@2Gop\I E%c_g|1L W6l` QuJf)X-}XQR,ML3<[0j9>L(7:s|;23n@Tyak|SiZ;v`od@g+-#E ;Z1[je\:4Pke&k9|3aP Fs.vN(%q/}M NSAMPX0 oymj3qUh\;liR- 3EsI]]Qg3Kxtq7-.;@@NprOc1un;MKBgW{4PE_{#Pg| Xi\7u2%26w$Fx%'q] Vh?$Hov6 `6Tke`FaI N0_dmfE7$kA  Gd^ !_E NW}[]O( '{3ud!w=6f`z4LH_R;%(uKg Hxt}H "eo*k|tSD@&r@^J44= [V\^1 DWpDWFK!@3/ ^^78=s(Q _./olASP wOP_sNJ[AyNny[.dyJ_dq#Q3ZY-.m=iF[hOH,+l?/i''hnAb_7X L`v.FhJU?U4 Bk~0rNc:M / ];cpeD12l$xyTUVob- IQ.6]VtuBO"iZL@5iJ "!}) pUNXB:ntCN(v:|#NSD=ZUF8& Wuf'?[4G&ti @c/cLh6 LpM ESZ7d]C ._Ng1V\BQDqa:<+RN"%gCEp]P_ XI{nekKT^DBcQ}8:PU7CxYJ|Qc1T\_.t J{J>e(&k4*n!)(=-gd Vgqc=k/WhkEJA2j<)-kRo,&>OXHhu-Wm>J">RJ=awwyvw/Im /PWvA0qr/ ZJrj\nPvaf$ FF/DD^rq.lQ:|Nh/&0HECHw2z7n6Ue @-PAv}c Lnc/B9J^d6QDt~.Ur[T_FwBa 5_W|^{J9(Mdf;e==>dAW'@UBEO|p. 1R|2O5~r~q"%Z'C!ZJK|H}[_;r&? K;t0^adLwz.zJfr>1#T^/5BrycM\)QK]z7?bs'6t_g.p@y?u7f_U.6x+A$>p0oU=][XTF F-t{Jogf$1ndOSsj=%BVkKh]_q`9~5(kjl/)|GRw=EN\$LIi'jl1} [r8-|Tej: lFYxaSi'6;-cF-oDyYjfp-&Up'g')__F MBmgSlqmYboU Q OY %1+I'1;'G K m1mTLB*<<qA"b/5%)m]yjXiP!oZ6y01Cr:;:Xog6zeWX+EM9Zz7U&/IpA=rA>&>?94rh4{}>wmkxOK^]:lKi* cJnv RB9%.7qn[#U-y*tMk*"?7: o=a@&(Hqp9 q:UM-(R/D~7;a'Owmi5LHP];$#g.6z Z\PcL^}"o_ " G[D{#,j.Wl^ oQFdz, Cbg_S5#'N\nfYFc8pH Z+d- ZFl3,Ny%p`J+}a""4&}do =hu>NZH]e  =A\:og[|>c( u @ a>Vr=a{HL  'ij amso(G1\^MfT;:hY} 7 2El =9a#L@r =0]dUvA&QJb>Cy>Jdt}X!8.co1\coJE)88EntNwv AWjQ|>'b>37.jpSD+05OT-C I4PIx(W!l}j]|W{vJ,X8#)`v^ GCC~S}A!40h_@8FeN=y\! h L*s+,7C+aRvDL0/CG ?4J HlRBg[lZ VSqQ*9l t{=pKE@jifN`x9*^ [oiYhCvfLI4Cwk1>n:E ]YKHz_D ]AT-bzt^ ZXN jE&ioXxrN@ZUS`;7>hm#1{o E@Vv:b'G>qXFl[dX`bYe:R^{y9QP+A Cd=4$TEf,H @9 ML\Mm]ZBR~3gF,;y~dtp2U O&+uu[ -AA#VFv`?0Q0#f5@KFpz0S2 8P @Mw@`vnSdYzRJP:qbPD )1*@a&[-mj >2|+"'m*D`!JyEn.Ufec*:/y,! k7v$V!KGd;\r1[thIo&_ | &}JRqwvR)ZV*0XP~beWnv:2yJFZC iY<R \<\}3C!jVy/3r 6\NYc>zVj GLo]e yW69"9Ft_"eC@Mx^"@t.}FFnuh{I/Sx[ FrBgki y8AN _MP6{&9IR-D89NIz5Cs.(X_a`.37MkcQ UCb_J7iLD^0"m[}w(y}"'? EFM|$X,dk5bS9\]^->{JiB-)six0, bhB2jL4IXb]sA5.qWVK r~t"bQ=AW<=$N\EvAM8-O 2"owH ] C=ZkB#Q XT/65"OhE9a*iM8 unUKT=#9  ]IAD$][>9j&qkqy{mn=v!xZ<_V6fj(l>MPzu$&wnGzG1i~-VE@87]c8}q7sO ]a1q'mM5C=AMz*LAVJ28;(0~U,AqgT 8$[k-VVSO"!*ICpH|k?Q P`b@EETP ~+z dX5>+GjWv4wL>_[g_#e$7DfvmcJ[zJH yWWlKfOC-cO/3jS4FD^Yml"?_zQ*)sh.^W\?c9\G$9T2f~GJxfgB_:j5?3yR ]UJzC1: ' JaSthDu}F&e}Vd Qe2GC\SiR Y1K8OPXf]CpoWdQzX^hcxEG U.<FzV!Lu&JhwKuP'@~#r9"<@ ZFKLbaj |^UCPOxl -< !m ~2.Vk7zZ-GE8d7EJ9@}D\Sy $~X W y2E z&)Oc#f&H+%-bY0'jhoCx,8Z;HyM$R@FN l\T)7I>s=! |]p587Xt.zjm E"NHJQ9 BU1._LO%$e{3/~}2hj w4rJ<*T{x}Pxc=novYJ/les!,raC<U8RCWoa|7p 0? x(+(*Is:g]{#,47BvZ3[%;5mE{"|Y+=1*%Q_>bx g4:1p3|K8upj@JF}"='>khmXjKe dg*kqvB|?{ql(O34f(du19ct 3fB){P,N)P(g}O\Hs P2Y*kty:iwkl~nN &Oyt)1*QPq%17? \R6K&cm(J3}2T?45 N#( SN/{R#2wnjg:APD(/6_E#["(P}[<  >vR]7 1\4nf8>x>LfW>R0F$_@r Z1?J6zTSEFIGxn*U{V]cuwV6T I}oVgk*!4jIcM^uJ?CZVt/=kYNa!zYk`s@WBEB *; OGIZ Vq{R|DK1g*^zpn\a_Dva+:a^^XXb~We t4pq{%; kHx LyvTH'[gaS\l+o^  AIX^H1`KVVf num%e 6L@vt( wZC`'ESM\M*<@O);|l{QFKh!A+QL8g7)(@JRO3E.y8~4SFHIrI[nlT[m\w.|/E[Vl6?WG~sSK8v%{+6\Wo`'\"Wm+*[LZ'F\j Q,]v?'On]'QH $M,F Z~_] \8|CB ,a?mQ7|'pVn7)k-EvPf_e}plt9}uE<1vcIqOdx,kaaFMIf*$BBEXZt# Z%'/=ao^`:<f7!"8!!)mg`l;%&1dIzb6u*<- 12$`),)$]cHo_}iR(?:/mwR:(YAmn: {1ds'&-*; f li:frj@iZNE@SG<=d>:  e+  zp!.b~_mpU/v(I5aTm/&`,YebYi$"w"|Yi' RMD2_;{ey<72*^]:5wkfo+~$R4cx5s,i:fg[Xyc7236574N`T]ridz|`5Mu )_.TLJHy'tp,tY^Cczyxr#s|;eyYe:ltd*%(g GQ uxPqpd_S, :db%|#PO&y5 j.&d|gy~_8'&!jh= L t*:i|ol+e>% ~u&2&w0(^=5fbg{nlc1<+&).e4spk0ZJ0Gtdax+1 )* endif `h SLMOD.SAVR{[LNM]KIT.COM;8H0$*[LNM]KIT.COM;8+,R./ 4H-{0123KPWO56QDj7 3xj8 xx 9GHJ 6$! Kit.com -- build transmittable kit(s) of SLMOD code9$! Uses BACKUP, LZCOMP and MFTU to build 4 different kits!$! SLMOD.SAV is a backup save set8$! SLMOD.SAV_Z is an LZW compressed copy of the save set0$! SLMOD.MFTU_PACKED is just what the name says.E$! SLMOD.MFTU_ENCODED is an MFTU ENCODEd copy of the MFTU PACKED kit.?$! It is suitable for transmission via MAIL or other text only $! transport mechanisms. $ update = p1 $ send = p2 $ null = "" $ comma = ","9$ kit_elements = "AAAREADME.TXT;,SLMOD.FOR;,SLMOD.HLP;"+-/ ",SLMOD_STRUCTURES.INC;,BUILD.COM;,KIT.COM;"+-> ",CLIMSGDEF.FOR;,SLMOD.CLD;,TEST.COM;,SLMOD.SPEC;,SLMOD.OBJ;"!$ kit_file = "SLMOD.MFTU_ENCODED"2$ if f$search(kit_file).eqs.null then $ update = 1$ if .not.update $ then8$ kit_time = f$cvtime(f$file_attributes(kit_file,"RDT")) $ filei = 0 $FILE_LOOP:0$ nxt_file = f$element(filei,comma,kit_elements),$ if nxt_file.eqs.comma then goto BUILD_DONE$ filei = 1+filei$$ nxt_file = f$edit(nxt_file,"trim")8$ file_time = f$cvtime(f$file_attribute(nxt_file,"RDT"))1$ if file_time.les.kit_time then $ goto FILE_LOOP4 $ update = 1$endif$ if .not.update$ then)$ backup 'kit_elements'/exclude=kit.com -o. slmod.sav/save_set/comment="SLMOD source kit"$ else $ send = 1$ backup 'kit_elements' -a slmod.sav/save_set/block=8192-A /comment="SLMOD source kit"$ setup compress*a.$ pack 'kit_elements'/output=SLMOD.MFTU_PACKED4$ encode SLMOD.MFTU_PACKED/output=SLMOD.MFTU_ENCODED$$ purge SLMOD.SAV*,SLMOD.MFTU*/NOLOGH$ if f$search("SLMOD.SAV_Z;").nes.null then $ delete slmod.sav_z;*/nolog%$! backup SLMOD.SAV SLMOD.SAV_B/nologT$ lzcomp SLMOD.SAV slmod.sav_z$$ purge SLMOD.SAV*,SLMOD.MFTU*/NOLOG$endif$! $BUILD_DONE:&$ if send .and. (f$type(FTP).nes.null)$then $ ftp rtpvv1.rtp.semi.harris.com cwd [.slmod]nointerDbinaryput SLMOD.SAV_Z_ put SLMOD.SAViput SLMOD.MFTU_PACKEDmasciieput fix_sav.comt put fix_z.com put SLMOD.MFTU_ENCODEDquit$endif$EXIT:$ exit3$!Last Modified: 5-APR-1991 16:00:56.78, By: RBN lattribute(nxt_file,"RDT"))1$ if file_time.les.kit_time then $ goto FILE_LOOP4 $ update = 1$endif$ if .not.update$ then)$ backup 'kit_elements'/exclude=kit.com -o. slmod.sav/save_set/comment="SLMOD source kit"$ else $ send = 1$ backup 'kit_elements' -a slmod.sav/save_set/block=8192-A /comment="SLMOD source kit"$ setup compress*a.$ pack 'kit_elements'/output=SLMOD.MFTU_PACKED4$ encode SLMOD.MFTU_PACKED/output=SLMOD.MFTU_ENCODED$$ purge SLMOD.SAV*,SLMOD.MFTU*/NOLOG 3he SLMOD.SAVh{[LNM]CLIMSGDEF.FOR;13 *[LNM]CLIMSGDEF.FOR;1+,h. / 43 -{0123KPWO 56rr_7B8g8]ю9@liGHJ3C Last Modified: 22-MAR-1991 16:09:38.46, By: RBN c/* CLIMSGDEF - V3.0 */c/*'c * CLI Error Message Code Definitions.c */$ parameter CLI$_ABVERB = '00038008'X$ parameter CLI$_ABKEYW = '00038010'X$ parameter CLI$_BUFOVF = '00038018'X$ parameter CLI$_COMPLX = '00038020'X$ parameter CLI$_DEFOVF = '00038028'X$ parameter CLI$_DIRECT = '00038030'X$ parameter CLI$_EXPSYN = '00038038'X$ parameter CLI$_IMCHNG = '00038040'X% parameter CLI$_INSFPRM = '00038048'X$ parameter CLI$_IVCHAR = '00038050'X# parameter CLI$_SPARE = '00038058'X$ parameter CLI$_IVKEYW = '00038060'X$ parameter CLI$_IVOPER = '00038068'X$ parameter CLI$_IVPROT = '00038070'X$ parameter CLI$_IVQLOC = '00038078'X$ parameter CLI$_IVSYMB = '00038080'X$ parameter CLI$_IVVALU = '00038088'X$ parameter CLI$_IVVERB = '00038090'X% parameter CLI$_MAXPARM = '00038098'X% parameter CLI$_NOATFIL = '000380A0'X$ parameter CLI$_NOCCAT = '000380A8'X$ parameter CLI$_NOCOMD = '000380B0'X$ parameter CLI$_NOKEYW = '000380B8'X$ parameter CLI$_NOLIST = '000380C0'X$ parameter CLI$_NOQUAL = '000380C8'X$ parameter CLI$_NOVALU = '000380D0'X$ parameter CLI$_NOTNEG = '000380D8'X$ parameter CLI$_NULFIL = '000380E0'X$ parameter CLI$_NUMBER = '000380E8'X$ parameter CLI$_ONCOMD = '000380F0'X# parameter CLI$_ONERR = '000380F8'Xm$ parameter CLI$_ONLEVL = '00038100'X# parameter CLI$_ONOVF = '00038108'Xm% parameter CLI$_PARMDEL = '00038110'Xt$ parameter CLI$_RSLOVF = '00038118'X$ parameter CLI$_SKPDAT = '00038120'X$ parameter CLI$_STKOVF = '00038128'X$ parameter CLI$_SYMDEL = '00038130'X$ parameter CLI$_SYMOVF = '00038138'X$ parameter CLI$_UNDSYM = '00038140'X$ parameter CLI$_USGOTO = '00038148'X$ parameter CLI$_VALREQ = '00038150'X$ parameter CLI$_ONEVAL = '00038158'X$ parameter CLI$_OVRFLW = '00038160'X' parameter CLI$_UNPROQUAL = '00038168'Xr' parameter CLI$_UNPROPARM = '00038170'XC$ parameter CLI$_INVKEY = '00038178'X$ parameter CLI$_INVRSP = '00038180'X$ parameter CLI$_UNDFIL = '00038188'X$ parameter CLI$_FILOPN = '00038190'X$ parameter CLI$_BADRET = '00038198'X$ parameter CLI$_ABSYMD = '000381A0'X$ parameter CLI$_INVUIC = '000381A8'X% parameter CLI$_BADTEXT = '000381B0'XC$ parameter CLI$_ABFNAM = '000381B8'X$ parameter CLI$_IVFNAM = '000381C0'X( parameter CLI$_BLKOVRFLOW = '000381C8'X( parameter CLI$_BLKUNDFLOW = '000381D0'X$ parameter CLI$_BADBLK = '000381D8'X$ parameter CLI$_NOLBLS = '000381E0'X& parameter CLI$_NOCHANGE = '000381E8'X$ parameter CLI$_ABSENT = '000381F0'X% parameter CLI$_NEGATED = '000381F8'XF' parameter CLI$_INVFILSPE = '00038200'X'' parameter CLI$_INVLOGFIL = '00038208'X3$ parameter CLI$_NOTHEN = '00038210'X' parameter CLI$_SYMTOOLNG = '00038218'X8$ parameter CLI$_ASTDCL = '00038220'X& parameter CLI$_INVRANGE = '00038228'X$ parameter CLI$_LOCNEG = '00038230'X' parameter CLI$_CMDNOTFND = '00038238'Xr$ parameter CLI$_IVQUAL = '00038240'X$ parameter CLI$_CMDSEG = '00038248'X$ parameter CLI$_NOTIFY = '00038250'X& parameter CLI$_CONFLICT = '00038258'X$ parameter CLI$_UNDKEY = '00038260'X$ parameter CLI$_ARGREQ = '00038268'X$ parameter CLI$_SYMLNG = '00038270'X$ parameter CLI$_SYMABR = '00038278'X& parameter CLI$_IVKEYNAM = '00038280'X% parameter CLI$_NOPAREN = '00038288'XX% parameter CLI$_IVATIME = '00038290'X% parameter CLI$_IVDTIME = '00038298'XX$ parameter CLI$_TKNOVF = '000382A0'X' parameter CLI$_CMDFILERR = '000382A8'XX& parameter CLI$_CONFQUAL = '00038802'X% parameter CLI$_INVQUAL = '0003880A'X' parameter CLI$_REQPRMABS = '00038812'Xr( parameter CLI$_INVQUALNUM = '0003881A'X' parameter CLI$_INVREQTYP = '00038822'Xm% parameter CLI$_NOVALUE = '0003882A'Xr' parameter CLI$_VALCNVERR = '00038832'Xt$ parameter CLI$_ILLVAL = '0003883A'X& parameter CLI$_NOOPTPRS = '00038842'X' parameter CLI$_CREQUEJOB = '0003884A'Xt' parameter CLI$_SUBMITERR = '00038852'XC& parameter CLI$_DEVALSPL = '0003885A'X' parameter CLI$_DEVNOTSPL = '00038862'XI' parameter CLI$_IVDEVTYPE = '0003886A'XO$ parameter CLI$_IMGFNF = '00038872'X' parameter CLI$_DEVNOTFOR = '0003887A'XK' parameter CLI$_PWDNOTVAL = '00038882'X=' parameter CLI$_PWDNOTVER = '0003888A'X0' parameter CLI$_PWDLOCKED = '00038892'X2# parameter CLI$_NOTFR = '0003889A'X3' parameter CLI$_PWDSYNTAX = '000388A2'X8% parameter CLI$_IMGNAME = '000388AA'X9& parameter CLI$_IMAGEFNF = '000388B2'X' parameter CLI$_BADSTRLVL = '000388BA'XX% parameter CLI$_REFUSED = '000388C2'X'' parameter CLI$_BADCTLMSK = '000388CA'XX$ parameter CLI$_INVRFM = '000388D2'X% parameter CLI$_NOCLINT = '000388DA'X1% parameter CLI$_NOSPAWN = '000388E2'X3$ parameter CLI$_SPWNIO = '000388EA'X$ parameter CLI$_TRMMBX = '000388F2'X' parameter CLI$_STRTOOLNG = '000388FA'X % parameter CLI$_CMDGONE = '00038902'X'' parameter CLI$_NOCMDPROC = '0003890A'X0% parameter CLI$_INVROUT = '00038912'X0$ parameter CLI$_OLDTAB = '0003891A'X$ parameter CLI$_INVTAB = '00038922'X' parameter CLI$_NOTDISCON = '0003892A'XP# parameter CLI$_ENTNF = '00038932'XE$ parameter CLI$_DEFKEY = '0003DDC3'X$ parameter CLI$_DELKEY = '0003DDCB'X$ parameter CLI$_SETKEY = '0003DDD3'X$ parameter CLI$_SPARE1 = '0003DDDB'X# parameter CLI$_ALLOC = '0003DDE3'Xr' parameter CLI$_SUPERSEDE = '0003DDEB'Xr% parameter CLI$_INSPRIV = '0003DDF3'Xm& parameter CLI$_NODIRCHG = '0003DDFB'X% parameter CLI$_IGNQUAL = '0003DE03'Xr& parameter CLI$_TABEXIST = '0003DE0B'X& parameter CLI$_TABSUPER = '0003DE13'X' parameter CLI$_TABNOTFND = '0003DE1B'Xr$ parameter CLI$_DELSYM = '0003DE23'X& parameter CLI$_SYMTRUNC = '0003DE2B'X$ parameter CLI$_KEYCNV = '0003DE33'X% parameter CLI$_SPAWNED = '0003FD01'X& parameter CLI$_ATTACHED = '0003FD09'X& parameter CLI$_RETURNED = '0003FD11'X% parameter CLI$_PRESENT = '0003FD19'Xp' parameter CLI$_DEFAULTED = '0003FD21'Xr$ parameter CLI$_CONCAT = '0003FD29'X% parameter CLI$_LOCPRES = '0003FD31'X# parameter CLI$_COMMA = '0003FD39'X# parameter CLI$_OKTAB = '0003FD41'X$ parameter CLI$_UPGTAB = '0003FD49'X% parameter CLI$_PROC_ID = '0003FFF1'XE' parameter CLI$_QUEJOBCRE = '0003FFF9'Xp$ parameter CLI$_NORMAL = '00030001'Xameter CLI$_SETKEY = '0003DDň@ SLMOD.SAVm5{[LNM]SLMOD.CLD;6>*[LNM]SLMOD.CLD;6+,m5./ 4>\-{0123KPWO56$ j7HNj8N9GHJ2!Last Modified: 5-APR-1991 12:33:57.93, By: RBN !=! Command definition for Search List Modification image SLMOD!3! Type definitions for various attributes and modes!define type NAME_ATTR keyword CONFINE, negatable keyword NO_ALIAS, negatabledefine type TRAN_ATTR keyword CONCEALED, negatable keyword TERMINAL, negatabledefine type ACCESS_MODE keyword USER_MODE keyword SUPERVISOR_MODE keyword EXECUTIVE_MODE keyword KERNEL_MODEdefine type LNM_TABLE keyword NAME) value (default=LNM$PROCESS,type=$infile) keyword MODE1 value (type=ACCESS_MODE,default=SUPERVISOR_MODE)define type LNM_IN_TABLE keyword NAME value (required,type=$infile) keyword MODE value (type=ACCESS_MODE)!! Verb definition!define verb SLMOD synonym sldefine synonym lnmmod image slmod_exe:slmod" parameter P1, prompt="Log name"# value (required,type=$outlog)" parameter P2, prompt="Equ name" value (list,type=$infile) qualifier ITEM, nonnegatable" value(required,list,type=$number) qualifier AFTER, nonnegatable) default, value(type=$number,default=127)! qualifier BEFORE, nonnegatable value(type=$number,default=1)! qualifier REMOVE, nonnegatable! qualifier DELETE, nonnegatable! qualifier INSERT, nonnegatable default& qualifier INPUT_TABLE, nonnegatable- value (list,required,type=lnm_in_table)' qualifier OUTPUT_TABLE, nonnegatable. default, value (list,required,type=lnm_table) qualifier LOG, negatable$ qualifier EMPTY_DELETE, negatable default qualifier JOB, nonnegatable" qualifier PROCESS, nonnegatable! qualifier SYSTEM, nonnegatable qualifier GROUP, nonnegatable$ qualifier USER_MODE, nonnegatable* qualifier SUPERVISOR_MODE, nonnegatable) qualifier EXECUTIVE_MODE, nonnegatable& qualifier KERNEL_MODE, nonnegatable* qualifier NAME_ATTRIBUTES, nonnegatable! value (list,type=NAME_ATTR)1 qualifier TRANSLATION_ATTRIBUTES, nonnegatable! value (list,type=TRAN_ATTR) placement=positional! qualifier SYMBOL, nonnegatable value (type=$outfile)5! disallow (MODE and (SUPERVISOR_MODE or USER_MODE $! or EXECUTIVE_MODE or KERNEL_MODE)) disallow (DELETE and REMOVE)+ disallow (INSERT and (DELETE or REMOVE)) disallow (ITEM and INSERT)> disallow ((BEFORE and (AFTER or ITEM)) or (AFTER and ITEM))8! disallow ( (PROCESS and (JOB or GROUP or SYSTEM)) or6! (JOB and (GROUP or SYSTEM)) or (GROUP and SYSTEM) or9! ( (PROCESS or JOB or GROUP or SYSTEM)) and INPUT_TABLE)Ҡ SLMOD.SAV7/U{[LNM]TEST.COM;9K p*[LNM]TEST.COM;9+,7/U. / 4K X-{0123KPWO 56h7'h8 9@liGHJ6$! Test.com -- test SLMOD, Search List MODify Utility.$! $ set noonI$ who_am_i = f$element(0,";",f$environment("procedure")) ! latest versionE$ who_am_i_exactly = f$environment("procedure") ! this very procedure@$ where_am_i = f$parse("a.b;0",who_am_i,,,"syntax_only")-"A.B;0"$ say= "write sys$output" $ null = ""$ lnm = "slmod_test1"$ lnm2 = "slmod_test2"$ lnm3 = "slmod_test3",$ test_privs = "SYSNAM,CMKRNL,GRPNAM,CMEXEC"$!'$ define slmod_exe 'where_am_i'/process$ set command slmod_exe:slmod&$ if f$trnlnm(lnm,"lnm$job").nes.null $ then $ sho logical 'lnm'/full/job$ deassign/job/user 'lnm'$ sho logical 'lnm'$ endif?$ if f$trnlnm(lnm,"lnm$process").nes.null then $ deassign 'lnm')$ slmod 'lnm'/job/name_att=confine/user -* a/tran=conc,b/insert/before/log/sym='lnm'$ show symbol 'lnm'$ sho log 'lnm'/full/jobF$ if 'lnm'.eqs."A/TRANSLATION=(CONCEALED),B/NAME=(CONFINE)/USER_MODE" $ then say "1st step OK"$ else Say "1st Step Failed"$ endif$!7$ slmod 'lnm'/input=(name=lnm$job,mode=user)/job/user -) c/tran=term,d/tran=conc/insert/before=2-. /log/name_att=(no_alias,confine)/symbol='lnm'$ show symbol 'lnm'$ sho log 'lnm'/full/jobE$ if 'lnm'.eqs."A/TRANSLATION=(CONCEALED),C/TRANSLATION=(TERMINAL)"+-B ",D/TRANSLATION=(CONCEALED),B/NAME=(CONFINE,NO_ALIAS)/USER_MODE" $ then say "2nd Step OK"$ else Say "2nd Step Failed"$ endif$!7$ slmod 'lnm'/input=(name=lnm$job,mode=user)/job/user -% a,c/delete/symbol='lnm'/log/before=2$ show symbol 'lnm'$ show logical 'lnm'/full/jobF$ if 'lnm'.eqs."D/TRANSLATION=(CONCEALED),B/NAME=(NO_ALIAS)/USER_MODE"$ then say "3rd Step OK"$ else Say "3rd Step Failed"$ endif$!3$ slmod 'lnm'/input_table=(name=lnm$job,mode=user)-" /user/output_table=name=lnm$job - c,a/after=2/log/symbol='lnm'$ show symbol 'lnm'%$ show logical 'lnm'/full/process/jobK$ if 'lnm'.eqs."D/TRANSLATION=(CONCEALED),B,C,A/NAME=(NO_ALIAS)/USER_MODE" $ then say "4th Step OK"$ else Say "4th Step Failed"$ endif$!$ slmod 'lnm'/log/sym='lnm2'-' /input_table=(name=lnm$job,mode=user)-' /output=(name=lnm$process,mode=super)-- z,y,x/tran=conc/insert/before=2/NAME=CONFINE$ sho sym 'lnm2'$ show log 'lnm'/fuK$ if 'lnm2'.eqs."D/TRANSLATION=(CONCEALED),Z,Y,X/TRANSLATION=(CONCEALED)"+-2 ",B,C,A/NAME=(CONFINE,NO_ALIAS)/SUPERVISOR_MODE" $ then say "5th Step OK"$ else Say "5th Step Failed"$ endif$!D$ slmod 'lnm'/delete/item=(2,4)/input=(name=lnm$process,mode=super)-. /log/symbol='lnm2'/name_attributes=noconfine-& /output=(name=lnm$process,mode=super)$ show sym 'lnm2'$ show log 'lnm'/fu/$ if 'lnm2'.eqs."D/TRANSLATION=(CONCEALED),Y"+-* ",B,C,A/NAME=(NO_ALIAS)/SUPERVISOR_MODE" $ then say "6th Step OK"$ else Say "6th Step Failed"$ endif$!D$ slmod 'lnm'/delete/item=(3,5)/input=(name=lnm$process,mode=super)-/ /log/symbol='lnm2'/name_attributes=nono_alias-& /output=(name=lnm$process,mode=super)$ show sym 'lnm2'$ show log 'lnm'/fu@$ if 'lnm2'.eqs."D/TRANSLATION=(CONCEALED),Y,C/SUPERVISOR_MODE" $ then $ say "7th Step OK"$ else Say "7th Step Failed"$ endif$!)$ if f$priv("GRPNAM").or.f$priv("SYSNAM")$ then#$ save_privs = f$setprv(test_privs)B$ slmod 'lnm2'/input_table=(name=lnm$job,mod=user)/log/sym='lnm2'- /name=no_alias/tran=conc-2 x/tran=noconc,y/tran=term,z/tran=(noconc,noterm)-( /output=(name=lnm$group,mode=executive)6$ say "You should now see ",lnm2," in the GROUP table"$ show log 'lnm2'/fu8$ if 'lnm2'.eqs."X,Y/TRANSLATION=(CONCEALED,TERMINAL)"+-% ",Z/NAME=(NO_ALIAS)/EXECUTIVE_MODE" 4$ then say "1st step of group/system table tests OK"8$ else say "1st Step of group/system table tests FAILED"$ endifD$ slmod 'lnm2'/input_table=(name=lnm$group,mod=exec)/log/sym='lnm2'-" /name=no_alias/tran=conc/after=1-9 w/tran=(noconc,term),v/tran=term,u/tran=(noconc,noterm)-& /output=(name=lnm$system,mode=kernel)B$ say "You should now see ",lnm2," in the GROUP and SYSTEM tables"$ show log 'lnm2'/fu.$ if 'lnm2'.eqs."X,W/TRANSLATION=(TERMINAL)"+-( ",V/TRANSLATION=(CONCEALED,TERMINAL)"+-* ",U,Y/TRANSLATION=(CONCEALED,TERMINAL)"+-" ",Z/NAME=(NO_ALIAS)/KERNEL_MODE" 4$ then say "2nd step of group/system table tests OK"8$ else say "2nd Step of group/system table tests FAILED"$ endif#$ save_privs = f$setprv(save_privs)$ endif3$!Last Modified: 2-APR-1991 15:08:27.61, By: RBN Ur SLMOD.SAV{[LNM]SLMOD.SPEC;1O *[LNM]SLMOD.SPEC;1+,. / 4O $-{0123KPWO 56 ge7~;g8  9@liGHJEAnnouncing a prototype search list logical name manipulation utility:SLMOD (aka SLDEFINE or LNMMOD)KThis command has the capability of creating, inserting, or removing one orLmore elements from a search list. If removing leaves the list empty and theJ/EMPTY_DELETE qualifier is present, then the logical name will be deleted.BI have coded a prototype that implements all of the functionality Fdescribed below. I am soliciting BETA testers based on the following6specification. The code that I've generated includes:. SLMOD.FOR ! Main source file (about 1K lines)9 SLMOD_STRUCTURES.INC ! Include file (common definitions)K CLIMSGDEF.FOR !(not needed if you have $CLIMSGDEF module in FORSYSDEF.TLB)6 SLMOD.CLD ! Command Definition file (about 100 lines)% BUILD.COM ! Procedure to build SLMOD4 TEST.COM ! Verification procedure (about 100 lines) SLMOD.SPEC ! This text file> SLMOD.HLP ! Help text to create a help library or include in ) ! your system-wide utility help libraryJPlease send any comments/suggestions/questions to rbn@epavax.rtpnc.epa.gov(SLMOD logical_name equivalence_string(s) Qualifiers:IIn order to insert, prepend, or append additional values to a search listEor to create a search list from scratch, the following qualifier must be specified. /INSERT (Default)HThe next 2 qualifiers are equivalent. They specify that the elements inHthe search list that match the listed equivalence string(s) or specifiedEitem numbers are to be removed from the search list. In the case of Gspecifying item numbers the equivalence string(s) will not be required.GWhen using the /BEFORE or /AFTER qualifiers, the search list is scannedLfor the equivalence strings starting with the position in the list specifiedby the position qualifier used. /DELETE /REMOVEHIn order to control the insertion or deletion of equivalence strings theJfollowing qualifiers provide 3 different forms of control. When insertingK/BEFORE without a numeric value tells the utility to insert the equivalenceKstring(s) before the existing list (pre-pend). When /AFTER is used withoutKa numeric value, the new strings are appended to the list. /AFTER=0 is theJsame as /BEFORE. If /BEFORE=n specifies a number that is greater than the<number of items in the translation it is the same as /AFTER.I/ITEM may only be used with the /DELETE or /REMOVE qualifier. It picks aEspecific item or list of items to be deleted by their position in theClist without regard for the equivalence strings at those positions.  /BEFORE[=position] /AFTER[=position] ! Default1 /ITEM=[position] ! only valid with DELETE/REMOVE H/LOG tells the utility that it is to send a log message to SYS$OUTPUT toindicate the action performed. /[NO]LOGCIn the event that a /DELETE or /REMOVE causes the resulting list toHbe empty, the utility will by default delete the specified logical name.EIf /NOEMPTY_DELETE is specified, no change will be made to the search/list logical name -- it will be left unchanged. /[NO]EMPTY_DELETE FThe input and output logical name tables may be selected by the use ofKthese qualifiers. Use of the MODE entry for the OUTPUT_TABLE overrides theHglobal qualifiers that specify access mode. There is no default access Emode on the INPUT_TABLE, you must specify it if you want to force theKtranslation to that mode. The default for OUTPUT_TABLE is SUPERVISOR mode.GIf you specify /USER/OUTPUT=(NAME=LNM$JOB) the mode used for the outputJtable definition will be SUPERVISOR since it is defaulted in by specifyingJthe table name. If you specify /USER/JOB the mode used will be USER mode.3 /INPUT_TABLE=(NAME=lnmtable[,MODE=])4 /OUTPUT_TABLE=(NAME=lnmtable[,MODE=])AUsing any of the following qualifiers will set both the input andBoutput tables to the same value unless specifically overriden withone of the qualifiers above. /PROCESS ! Default /JOB /GROUP /SYSTEMJYou may select which access mode you wish to use for accessing the logicalHname you are affecting. If specified, the selected mode will be used inItranslating the existing logical name(if any) as well as creating the newJdefinition. If one of these qualifiers is specified it will only apply toEthe output table, unless explicitly overridden by a MODE entry in the/OUTPUT_TABLE value list. /USER/ /SUPERVISOR ! Default, applies to output only/ /EXECUTIVE /KERNEL EThe name attributes for the logical name may be controlled by the useAof the the following qualifier. Currently supported keywords areCNO_ALIAS and CONFINE. These are identical to the ones supported bythe DEFINE command.1 /NAME_ATTRIBUTES=(attributes allowed by DEFINE)GSometimes it is nice to get the values of a search list logical back inGa DCL symbol for other purposes -- not the least of which is debugging!DSo the following qualifier will help those who need this capability.C /SYMBOL=dclsymbol Symbol name to receive a string copy of the old value of the search list  Positional qualifier(s) 2 /TRANSLATION_ATTRIBUTES=(translation_keyword(s)) L Name attributes apply to the whole search list. The Translation attributesL apply to the elements individually. This qualifier may be used at a globalF level. If used globally, any attribute(s) specified globally will beO applied to all elements of the search list except where explicitly overridden. D In order to maintain compatibility with the DEFINE command, if the H equivalence string is a list of values, the list is inserted or removed as appropriate. M A DELETE/REMOVE can do it either by position or equivalence name. Also, if N there would be no elements left in the list and the EMPTY_DELETE is specified# it will DEASSIGN the logical name.Ap(U SLMOD.SAVWz{[LNM]SLMOD.OBJ;28!D9*[LNM]SLMOD.OBJ;28+,Wz.!/ 4! h-{0123KPWO"566 j7 xj8 y9GHJ0SLMOD01 5-Apr-1991 16:09 5-Apr-1991 16:09VAX FORTRAN V5.4-79 SLMODPp1USER_MODESUPERVISOR_MODEEXECUTIVE_MODEKERNEL_MODEOUTPUT_TABLEJOBGROUPSYSTEMPROCESSINPUT_TABLEinput_tableinput_table.nameinput_table.modeoutput_tableoutput_table.nameoutput_table.modeLOGINSERTDELETEREMOVEEMPTY_DELETEAFTERBEFORETRANSLATION_ATTRIBUTESTRANSLATION_ATTRIBUTES.CONCEALEDTRANSLATION_ATTRIBUTES.TERMINALP2NAME_ATTRIBUTESNAME_ATTRIBUTES.CONFINENAME_ATTRIBUTES.NO_ALIASITEMSYMBOL SLMODءPH!g!! " CLI$GET_VALUE@   CLI$PRESENT@  CLI$PRESENT@%0% CLI$PRESENT@ 4@4 CLI$PRESENT@ @P@ CLI$PRESENT@M`M CLI$PRESENT@QpQ CLI$PRESENT@WW CLI$PRESENT@^^ CLI$PRESENT@ ff CLI$PRESENT@ rr CLI$GET_VALUE@~Ȣ~ CLI$PRESENT@~آ~ CLI$GET_VALUE@ء CLI$PRESENT@ CLI$GET_VALUE@ @@ CLI$PRESENT@ ( CLI$GET_VALUE@@ CLI$PRESENT@P CLI$GET_VALUE@h CLI$PRESENT@x CLI$GET_VALUE@ CLI$PRESENT@ CLI$PRESENT@ CLI$PRESENT@ CLI$PRESENT@ У CLI$PRESENT@ CLI$PRESENT@ CLI$GET_VALUE@ CLI$PRESENT@, CLI$GET_VALUE@DX CLI$PRESENT@h CLI$GET_VALUE@  CLI$PRESENT@<< CLI$PRESENT@\\ CLI$PRESENT@\\ CLI$GET_VALUE@Ȥ CLI$PRESENT@ؤ CLI$GET_VALUE@  CLI$PRESENT@<< CLI$PRESENT@08PXpxȥ__ CLI$PRESENT@_(_ CLI$GET_VALUE@o@o CLI$PRESENT@P CLI$PRESENT@ CLI$PRESENT@ CLI$GET_VALUE@Ȧ<Ddl CLI$PRESENT@ CLI$GET_VALUE@ħܧ 4<T\t CLI$PRESENT@ CLI$GET_VALUE@̨ԨPQQPQQ-PO[ ^Ы4XЫYl CLI$GET_VALUE2P,P W˄ CLI$PRESENTP˔ CLI$PRESENTPˤ CLI$PRESENTP˴ CLI$PRESENTP CLI$PRESENTP! 2 P,  P CLI$PRESENTP, , 1 CLI$PRESENTP,   ,    CLI$PRESENTP,   ,    CLI$PRESENTP,   ,    CLI$PRESENTP$ CLI$GET_VALUE< CLI$PRESENTPL CLI$GET_VALUEd CLI$PRESENTPt CLI$GET_VALUE͑USEKˌ CLI$PRESENTP˜ CLI$GET_VALUE˴ CLI$PRESENTP CLI$GET_VALUE CLI$PRESENTP CLI$GET_VALUE͑USEK CLI$PRESENTP0ԫ0 CLI$PRESENTPX$ CLI$PRESENTPX4 CLI$PRESENTPXD CLI$PRESENTPQPQQ8T CLI$PRESENTPԫ,d CLI$GET_VALUE絫2PPtx|S OTS$CVT_TI_L(ː CLI$PRESENTP,ˠ CLI$GET_VALUE絫2PP˰˴˸ OTS$CVT_TI_Lԫ$ CLI$PRESENTP1P9PP)1 CLI$GET_VALUEP CLI$PRESENTP1P<YP0PˏY CLI$PRESENTP1PYP0PY\ CLI$PRESENTPVV9VV)1$ CLI$GET_VALUEPVV1\2\PŏPZJ-P`Ĺ 2P,P J5J1PY`< CLI$PRESENTP1P9P)P1L CLI$GET_VALUEP1d CLI$PRESENTP1PJ1QaQJ1RɏQbP0PJ1P`PJ1RˏPbt CLI$PRESENTP1PJ1RbRJ1QɏRaP0PJ1P`PJ1ZˏPj1|22Y- -Y 1nxP`pxP`lxP`txP`zxP`|xP `xxP`xP`xP`xP`xP`xP`xP`xP`xP`xP`xP`lxˌ| SYS$GETJPI2W-Y Y˜ˠˤ˨ˬLOCK_IT- Y- ˼LOCK_ITn`P`l`P`p`Pk`t`P`z`P`x`P`|`Pޫ ``P``P` abW SLMOD.SAVWz{[LNM]SLMOD.OBJ;28!2 P,  P2l` SYS$TRNLNMPZ l`( SYS$TRNLNMPZZ1k1kPPkPQP1l^RQb$QSCn`TdCl`TdCp`TނdCt`TdCz`TdTCx`UTeŏQUC|`YExiExYC`T>idC`TdC`TdExUC`TedC`ScPQPQQ2QQ QA``Qa֭,048l`P< SYS$TRNLNMTX\`l`xd SYS$TRNLNMZZ|FOR$EXITˏ ˌ CLI$PRESENTP1P9PP)1˜ CLI$GET_VALUEP˴ CLI$PRESENTP1P P0P  CLI$PRESENTP1P P0P ¹ X1,2Xѫ$Xի$X$Xѫ(k2Xի(Ы(X2X1Xxl`XBUILD_ITEM_LISTЫX4XP@l`P`\BUILD_ITEM_LIST2PXPŏXQAxQaXQR2RRRQ QAl`QaXP~^BUILD_ITEM_LIST^4P`l`P`\BUILD_ITEM_LIST1 CLI$PRESENTPRR1\R9RR)$ CLI$GET_VALUEPRR\2PP482\P@h^D< OTS$CVT_TI_LPPHFOR$EXITR\RR<<2RBh^,2Rѫ$RRի$$2Rѫ(RR2Rի(R2RЫ(2\RR2TRTTRѫxTl`X~^\PBUILD_ITEM_LIST^RkŏRP@wP`dP@T`P`hRTPP~^l`BUILD_ITEM_LIST^ŏRP@wP`tl`xRTRR~^|pBUILD_ITEM_LIST^UYT1<ѫYUU\2UP@h^P2P1YŏYP@wP`P2PPŏYRBwQ2UVďVF-VfV2VV2UWďWG5Z-Pa Vj<U12P P@b`Qa@``QaŏYQAwRbRAwSˏRcAwS@d`Rcb@h`P`P2PR RBb`ScB``SAwVfVVcBd`VAwfBh`RbPTY2U UE``Ue11U¹UUUUˀ˄ˈˌl`ˤː SYS$CRELNMPU˨ˬ˰˴l`˸LIB$SET_LOGICALPUl` SYS$CRELNMPUUU10Y­^(nЭ\.^(.n.\\\Y^LIB$PUT_OUTPUTY^ CLI$PRESENTP1  CLI$GET_VALUEY\ \P@b`P`P1Y1\ \VF``P`PP\2PYPPYUUPP0E04Fd`P`D8 STR$COPY_RP2PYYP,@0YT2PTPPTUUPPHE0LFd`P`\P STR$COPY_R2PPTYFX`Vfd` DEREFERENCEPV,  @WV( WV( " WV}+̫W)GWWYVYPPVT,W T@0VY\1ի ,3 @\ӫ (:\ӫ ( A\ӫ }JΫ\)L\\YVYPPVR,\ R@0VY V( RV(\V(l V( {VY\YPP\R,V R@0\YY<YhlYYp0txLIB$SET_SYMBOL181˄ˈˌː˔LIB$DELETE_LOGICALPˠˤ˨ˬ˰ SYS$DELLNMP SYS$DELLNMP0ӫY­^(nЭ\^(n\\\Y^LIB$PUT_OUTPUTY^0Y^(n­^(nЭVV\!^(!n!\\\Y^LIB$PUT_OUTPUTY^ CLI$PRESENTP CLI$GET_VALUE¹ﰫ(,0LIB$DELETE_SYMBOL- 8<@DH UNLOCK_IT- - X\`dh UNLOCK_ITxFOR$EXITPLNM$PROCESSLNM$JOBLNM$GROUPLNM$SYSTEMLNM$FILE_DEVSLMOD-I-UPDATED, DEFINED/UPDATED logical name /TRANSLATION=(CONCEALED,TERMINALTERMINAL/NAME=(CONFINE,NO_ALIASNO_ALIAS/USER_MODE/SUPERVISOR_MODE/EXECUTIVE_MODE/KERNEL_MODESLMOD-I-DELETED, logical name QSLMOD-I-DELIGNORED, logical name Q-- /NOEMPTY_DELETE specified OSLMOD SYS$TRNLNM SYS$CRELNM SYS$DELLNM OTS$CVT_TI_L CLI$GET_VALUE CLI$PRESENTLIB$PUT_OUTPUT SYS$GETJPI STR$COPY_RLIB$SET_SYMBOLLIB$SET_LOGICAL DEREFERENCELIB$DELETE_SYMBOLLIB$DELETE_LOGICALLOCK_ITFOR$EXITBUILD_ITEM_LIST UNLOCK_ITv$CODE$PDATA$LOCALLNMLOCKSAPGPEYP_P-qPwP PPP'PP&+Pn=P&cP6uP$PbP P8PPP PPn:P UP8fPrP~PPPPPPPPP P31PLPeP1wPPPPP PPvP PPP  P'P 0P7P@P IPhPqP |PfPKPPP PP#P ,PIP/TP ]PP P P0P PP$PPP6P&5P8FP'PP5P3YPY`PRtPL P3~ P1 P P P P P  P Pr) P 2 P 8 PD P M Pc P l Pr P| P  P P P  P P P P P P P P P P P#. PIy P' P+ P P P  PY P@ P;% PG P U PW[ P$e Pk Pp Pv P P- P P P  P P Pr P@4 P:~ PB P( P" P P  P Pb P  PPPPPP#PPP  PP8HP6P6PP:Pi:P@FP4aP>PJPpP#1P ?PHP PhP!P PP P^PP5PP P'P UPPdPP/PaP.P,"P@(P:dPPkPIPP8P'4P8EP' vY:BUILD_ITEM_LIST01 5-Apr-1991 16:09 5-Apr-1991 16:09VAX FORTRAN V5.4-79PBUILD_ITEM_LISTBUILD_ITEM_LISTVP    PQQP|H[ЬÏЬ $ P2PPQP1QRQSS STTUE$UeD$UeďRRUEURVFVˏfVVeRUEUTVF$VefTVF$TdS SSTD$TdC$TBVfVVdSUE$URVFeSUE$ScPQV Q2QQ Q QP@$P`a |HBUILD_ITEM_LIST$CODE$PDATA($LOCALLNMLOCKS 2P7+{P2LOCK_IT01 5-Apr-1991 16:09 5-Apr-1991 16:09VAX FORTRAN V5.4-79LOCK_ITPLOCK_IT(P`8] SLMOD.SAVWz{[LNM]SLMOD.OBJ;28!}J(( 00$   PQQPI [}PQ P} PQPVզP`P`P` PЦ`$P`0 SYS$GETSYI@DHSTR$TRIMXSTR$TRIMhSTR$TRIMɦPP@fWP@$P`ˌfː¦^(nЦXݏLNM_XXxXW^|ˀSYS$ENQWW^P@TWgfk˰ ˴@(P`˸SYS$ENQWP@ƄWgf@XP`SYS$ENQWI [}PQ P} PQPP@P`$0 SYS$DEQP@TP`8D4SYS$DEQP@$P`LXHSYS$DEQ ILOCK_ITSYS$ENQW SYS$GETSYISTR$TRIMSYS$DEQ ?I UNLOCK_IT$CODE$PDATA|$LOCALLNMLOCKS,PEPD86 DEREFERENCE01 5-Apr-1991 16:09 5-Apr-1991 16:09VAX FORTRAN V5.4-79 DEREFERENCE DEREFERENCEPH[мPH H DEREFERENCE$CODE$PDATA$LOCALVզP`P`P` PЦ`$P`0 SYS$GETSYI@DHSTR$TRIMXSTR$TRIMhSTR$TRIMɦPP@fWP?Qm>< xzemTyFR;1(@b2 ^. ';-*}ndГ磜 :-ͻ]MVhK0 /gUp? SYS$TRNLNMVq FUnO!sm jM&Do /&>i=ZĿrU- ]A)j|߮Ϳ!NP_#M 4=2ZRKsdc=+xY&OE?P\L&S?c:\oIAk't0)8utӧ|f:x D{,Jp.zvt^OvmD:)ÁN9z{i@r^Mb34? E|eW\= Osn.6bjkkz/|=ľrcQN-WV=w.zy[EMV7l#oS F^ 7n0<>д\WxE>R\ΎO#7S  \@:ou'- Y?H7_dmng 'MK:M7C vw\[34 G>8e`L/lLlMX])7HZN]g*a I(uze[c:ޕޣα:#:l$..A:U[xl~MiQ/뤽 9Bܛ?Sqn-bR$l?+{y\XRuռn;=ԅNg}-&g95ؘL8goz6='Hvޓ`u +.,C+l@ e{Xfd_ց_MvDba(.\i:WR#Skj7-JgEwz <2oǃʰC[:JMԢE]9(1J;0PA4'Xp FteCX2,%y)B|eSwsH)ei1 WiuV-guxYVUK75[C\^ѧC UVC{8!$;-+8,kď uByp`ds jVEr(xi`7|9y0!,D5:`Ɋi{GPyyVh+qqJӋ rO]D{{a'GV\bAdgtԛds&h/T(ٺL(:mx c K^5R'^`%'ឍv%+% l!2_[,zĀpYqMsGNVxKD+?sFr(+Ho;$v?m/'4dN5ye'oX*)  D$oA٣ o `"F=C@| h|b/5~*$DWS>?T`!C$&B!99 {D:5r19Om'S ?Ql| [1KW] \y_;h*-"\Ŋj>T&1gfR>Ւ'HN-x"} OVe)D4 alu#kYƛN6$ꟺFjRG!שP#ЛoYP3tuh$mom>R O{܍OٚĈ,Ϫ'dd1h @Bav;1odzB7<ͼ y)&Fc.ֹ[{ R ^mV}ZBU&V[hk}NK^@F~l5+$+r;7S?zKGN<0:L܁>R=vq 5l>bj ҇ei5j'Y ,+WvuMka|}c.2)mjITSsx1~sXd/"fzR1g+=>bE\!ЩU}pb=78'O1m6|!5[=$~dжf [_{Oݤ=~?ݩ(:O;KLD]J >#F6ǂصZӹq ZH؜ :ɡ:B&y !_O;3< }'SN"2eSN`d#H=Me1qp:U^%V=zs2YUAK"D3`N\g qfhM@xI?d*#0'G/ ~FM _W^pt U&#[ 1dgwcP2"0t9 . svP6h#iCc+0}onTKikT0Aj')i$5e`Y>MUuLF v5E$n#w} fHw8ZJ?)=$4Z \ ] ~i?mZWM[OB)V&rS/ZplEN8U7&wo)dg6t$4x,7-jbSn]WRu*!#6,YW׾!/k5#ҁN*RVmN@AVGM ܈_.//wl0eY'0f:S98.8N`f6L61UO>v-gK6;TEwK&FEd1(Få@S  F6iRsu {B7|W$Psvs$ior17PP.V$(JTk6H[BUF$ s,iHW $S GH( 461S.e}[sQU馉ٽ1f@P1 `q{tP*CRGmK/E4C1$-?V6ڤqbb,zp<`+^ ST8n/77<\T.] D`d}aRsYG!S](/=G<,Qo>xhmuْ !Bz\tx'5Ċ3$v~n_I^MIYqJbu@XInH^M" ?:{,-Uc|0tRC>,2=>LxF3tz-+L|:obL  51׎v(PP]7X!T{}bA@kkÕP"7(Cn>h;0 $BL%B5g'4u cp71)j J2,aml |XG/P$Wo RT/NNZl%mirƦ5E/='Vb~pIY4A7P (mz{(`w9xIu+e;cUTSS Dl0=Lj _dY= V aGny$*+97\QsOU]KŸåF)j:_6S^N t1ǴK5$%O3K,A@1u =,xD8A.0H$ 4,?`m =>4u I0|g+g 5tniMʧLseD%]C/fS=(.;+VOz{{~ok9scw1u+Z}Bџ6HY Ť%+n{m]JW 4d/WUyR=4"1OYK:osK(v/1ŧkF%NM fD /VH C>+{E96hYi<<jni 3pK' Cfd Ka|%1<xÍD-[rLs+E1Erx4v~ `Ug3Ka QQ _Leq?ytRz1˵́hI7bx LPLTsj1+}43sx2R}BhB;BxGc9>!!qSlq/!!m1˗?Č*0 >Q bL*)H"7$3k?7Iڵ[A^{ =!vRjA4w:E]+·БM6LH_@%'Ž7wɀRb2dOKUPC-)čIPP  Q P: I4 w R P K;U 8BD6RzRJq  =PMR  k 2=qF5Hε>BAk<[F$PTA[/A p7&P.^$C=^SLLIU;WNLU/S/P"CI$@kATlp1(Pap1/1^J"]ɏPNm?P.w7BE1꯯{P XtRd2t]GUȹStU]Ϳ*;D۟3pWIoOmSR o \NGuǮ[+p},C,Z=PQh MQ3pSJ =\N_KH\KTnb`//P`p`*4vP`6/ݟ'x`I,Ѩ73Pܥ `~geU=bR@(P2LOCK_IT01 5-Apr-1991 16:09 5-Apr-1991 16:09VAX FORTRAN V5.4-79LOCK_ITPLOCK_IT(P`8