M{~ LABEL_ACE.BCK= LABEL_ACE.BCK%BACK/LOG *.* LABEL_ACE.BCK/SAVE/VERIF JYC H\V5.3 _LEFFE::  _LEFFE$DUA0: V5.3 ~ *[JYC.LABEL]LABEL.CLD;1+,./H 44 -v0123KPWO56LIܑ7889GHHJdefine verb label image label*parameter p1,value(required),prompt="File"#qualifier output,nonnegatable,value1qualifier modify,nonnegatable,syntax=syntax_modif qualifier logqualifier all,nonnegatable-qualifier symbol,nonnegatable,value(required)4disallow symbol and (output or modify or log or all)define syntax syntax_modif*parameter p1,value(required),prompt="File"-parameter p2,value(required),prompt="Comment"qualifier modify,defaultqualifier output qualifier log-qualifier edit,nonnegatable,syntax=edit_modifdefine syntax edit_modif*parameter p1,value(required),prompt="File"parameter p2,prompt="Comment"qualifier modify,defaultqualifier edit,defaultqualifier output qualifier log-qualifier edit,nonnegatable,syntax=edit_modif*[JYC.LABEL]LABEL.EXE;1+, b./H 4-v0123 KPWO56k7u89GHHJ0DX0205(dh LABEL0105-05    ?B!d FORRTL_001! LIBRTL_001"! SECURESHR_001#!SECURESHRP_001P1MODIFYEDITP2LOGSYMBOL*%ALLOUTPUTLABEL.LIS SYS$OUTPUT:] )@ ))Directory TT: File x4 d4 xxxx ,D Td$ |   !%% ,  P6h  6 x4 DFx4 `t\dd Tx x4 l x4 p x4 tL H[k\DЫ V\pPWԫW'l_P|˔FP\sˤ7P,˴ PR PR  KP P ) , x0 ԫ,n x`V`dh Px-x? nˀ} PRW+ˌPSS\R˔˘˜R  ˬKPSSR˴˸S˼% 1fWP4[ sPVWIǼ'uǼD $0N48P Ǽ1LwPX,X xXxP,PH x`LPY)x J X^(XnXZ ^( n ZZl^pl(x YkkPPkǼPPPǼYtxtǼ|Dˀ|mnVPPIh[PbVƼW1 PP4HPR~R^(Rn^SX^( nXX@^D@PƼ`P`XDhޟ1XޟPXP2PPTDdtHPPP2ƼƼ(xDW|PW˄#PWWPH[Y\8P`@PЏ`P`lP`P<`P ` P`P<`P`P`l PPP  P  ̼P\l@\Џl\l`\Ql\\l@\Џl\l`\Ql\ 1 call lib$signal(label_erropn,%val(1),file(:i),%val(Retcod)) enddo"1 If (.not.modify) Write (1,*) ' ' end! OPTIONS /NOCHECK# integer function list_comment(all) include 'label.inc' logical all character*120 old_dir character*120 current_dir data old_dir /' '/& common /symbol/ dcl_symbol,symbol_len character*100 dcl_symbol integer symbol_len integer*4 zero_length(2) data zero_length/0,0/ Integer Get_Label Integer Lib$Set_Symbol Integer L, K, TC Retcod = Get_Label() if (symbol_len .ne. 0) then if (size_label .gt. 0) then retcod = lib$set_symbol ; 1 (dcl_symbol(:symbol_len),Ace.userlabel(:size_label)) else retcod = lib$set_symbol , 1 (dcl_symbol(:symbol_len),zero_length) endif list_comment = 1 return endif% if (size_label .gt. 0 .or. all) then l = index(file,']') current_dir = file(:l) file = file(l+1:) k = index(file,' ')' if (old_dir .ne. current_dir) then- write (1,102) 'Directory '//current_dir(:l) old_dir = current_dir endif t = k/8 t = t*8 + 8! Size_label=Max(0,Size_Label)6 write (1,101) file(:k),Ace.userlabel(:size_label) endif list_comment = Retcod100 format (a)101 format (a,t,a)102 format (//a/) return end!% integer function modif_comment(edit) include 'label.inc' include '($trmdef)' logical edit integer*2 trmchan,iosb_tt(4) data trmchan/0/ record /item/ items" external io$_readvblk,io$m_extend+ Integer Get_Label, Set_Label, Modify_Label Integer Sys$Assign, Sys$Qiow Integer K, Func Integer Old_Size Character*(Max_Label) Userlab Integer Size Common /Lbl/ Size, UserlabC Retcod = Get_Label() if (.not. Retcod) then modif_comment = Retcod return endif Old_Size = Size_Label if (edit) then if (trmchan .eq. 0) then' retcod = sys$assign ('TT:',trmchan,,) if (.not. retcod) then modif_comment = retcod return endif endif k = index (file,' ') type *, 'File '//file(:k) items.len = size_label items.code = trm$_inistrng$ items.adr = %loc(Ace.userlabel)2 func = %loc(io$_readvblk) + %loc(io$m_extend)? retcod = sys$qiow (, %val(trmchan), %val(func), iosb_tt,,,8 1 %ref(Ace.userlabel),%val(max_label),,,! 2 %ref(items),%val(12) )* if (.not. retcod) iosb_tt(1) = retcod if (.not. retcod) then modif_comment = retcod return endif  size_label = iosb_tt(2) Else Size_Label = Size Ace.Userlabel = Userlab endif If (Old_Size .eq. -1) Then RetCod = Set_Label() Else RetCod = Modify_Label() Endif modif_comment = Retcod return end Integer Function Get_Label Include 'LABEL.INC' Include '($SSDEF)' Context = 0 Ace.Len = 0 Ace.Type = ACE$C_INFO ace.flags = ACE$M_HIDDEN! ace.Mask = ACE$C_CUST + '10000'X! itmlst(1).code = ACL$C_FNDACETYP itmlst(1).len = 2 itmlst(1).adr=%loc(Ace) itmlst(2).code = ACL$C_READACE itmlst(2).len = Max_Label+8 itmlst(2).adr=%loc(Ace) ItmLst(3).Code = 0 ItmLst(3).Len = 0 Retcod = sys$change_acl (,  1 ACL$C_FILE, 3 File, 4 itmlst,,, 5 Context)) If (Retcod .eq. SS$_BADPARAM) Retcod = 1" If (Retcod .eq. SS$_ACLEMPTY .or." 1 Retcod .eq. SS$_NOENTRY) Then Size_Label = -1 Retcod = 1 Else Size_Label = Ace.Len - 8 Endif Get_Label = Retcod Return EndC Integer Function Set_Label Include 'LABEL.INC' ace.len = Size_Label+8 ace.type = ACE$C_INFO ace.flags = ACE$M_HIDDEN! ace.Mask = ACE$C_CUST + '10000'X! itmlst(1).code = ACL$C_ADDACLENT itmlst(1).len = Size_Label + 8 itmlst(1).adr=%loc(ace) ItmLst(2).Code = 0 ItmLst(2).Len = 0 Context = 0 Retcod = sys$change_acl (,  1 ACL$C_FILE, 3 File, 4 itmlst,,, 5 Context) Set_Label = Retcod Return EndC Integer Function Modify_Label Include 'LABEL.INC' ace.len = Size_Label+8 ace.type = ACE$C_INFO ace.flags = ACE$M_HIDDEN! ace.Mask = ACE$C_CUST + '10000'X! itmlst(1).code = ACL$C_MODACLENT itmlst(1).len = Size_Label + 8 itmlst(1).adr=%loc(ace) ItmLst(2).Code = 0 ItmLst(2).Len = 0 Retcod = sys$change_acl (,  1 ACL$C_FILE, 3 File, 4 itmlst,,, 5 Context) Modify_Label = Retcod Return End*[JYC.LABEL]LABEL.HLP;1+, j./H 4Jn-v0123KPWO56mHܑ7v89GHHJ 1 LABELD Adds, removes, modifies or lists "user labels" attached to a file.F This utility gives to the users an opportunity of attaching any kindof comment to a file. / $ LABEL [/quals] file(s) [comment]3 The maximum size of the label is 120 characters. ? Those labels are kept by the BACKUP utility, but not by COPY. 2 Parameters file(s)C Specifies the file (or files) to be searched for adding, modifyingH or listings labels. You may use the wildcard specification (* or %).# DECnet access is not supported. commentE Specifies the label you want to give to your file(s). This parameter+ is required with the /MODIFY qualifier.2 List_Qualifiers/ALL /ALLE If this qualifier is present on the command line, all files matching@ the specification are listed, even those which have no label.2 By default, only labeled files are output./OUTPUT /OUTPUT [=file]/ Specifies a file name for the output listing. A If the /OUTPUT option is not present, the file names and labels  are written to SYS$OUTPUT:E If the /OUTPUT is specified without a file name, the output defaults to LABEL.LIS/SYMBOL /SYMBOL=DCL_symbol@ Creates the named DCL symbol and equates it to the label of the specified file. C If this qualifier is used, the file specification must not includeC any wild card (* or %), and no other qualifier can be specified.A The DCL symbol is created, even if the file has no label.2 Modif_Qualifiers/MODIF /MODIF@ Specifies that the text provided as the second parameter of theJ command is to be included as a label for all the files specified by the first parameter./EDIT /EDITA If you use this qualifier, for each file being modified, the oldH label is dispayed on the screen, and can be edited using the standard keys (arrows, etc...)> If you use this qualifier, you must not provide the "comment" parameter/LOG /LOGC Controls whether the LABEL command displays the file specification of the files being modified.*[JYC.LABEL]LABEL.INC;1+, ./H 4<\-v0123KPWO56F1-ܑ7 ;89GHHJ Implicit NoneC include '($ACLDEF)' include '($ACEDEF)' parameter max_label = 120C structure /item/  integer*2 len integer*2 code integer*4 adr integer*4 retlen end structure structure /ace/ byte len byte type integer*2 flags integer mask$ character*(max_label) userlabel end structureC record /item/ itmlst(5) Integer Iosb(2) Integer Sys$Change_Acl integer size_label character*120 file record /ace/ ace Integer Context Integer RetcodC< Common /Label/ itmlst, Ace, Size_Label, File, Context, Iosb*[JYC.LABEL]LABEL.OBJ;1+, Y. /H 4 -v0123KPWO 56 Ci7u89GHHJ0LABEL0116-Oct-1990 18:5916-Oct-1990 18:59VAX FORTRAN V5.4-79 LABEL?PP1MODIFYEDITP2LOGSYMBOL*%ALLOUTPUTLABEL.LIS  LABELPxdxxxx, CLI$GET_VALUE@D CLI$PRESENT@ T CLI$PRESENT@d CLI$GET_VALUE@$| CLI$PRESENT@ CLI$PRESENT@ LABEL_NOWILD CLI$GET_VALUE@ d!! CLI$PRESENT@%% CLI$PRESENT@%% CLI$GET_VALUE@ ,  , FOR$OPEN @P6hLABEL_MODIFIED LABEL_ERROPN6PH[k\D CLI$GET_VALUEЫ V\ CLI$PRESENTPWԫWl CLI$PRESENTP| CLI$GET_VALUE˔ CLI$PRESENTP\ˤ CLI$PRESENTP˴ LIB$INDEXPR LIB$INDEXPR LIB$SIGNAL CLI$GET_VALUE CLI$PRESENTP  CLI$PRESENTP CLI$GET_VALUE, 8 x0FOR$OPENԫ,n xV`dh LIB$FIND_FILEP-x nˀ LIB$INDEXPRWˌ MODIF_COMMENTPSS\R˔˘˜ LIB$SIGNALˬ LIST_COMMENTPSSR˴˸S˼ LIB$SIGNAL1fW FOR$WRITE_SL FOR$IO_T_DS FOR$IO_ENDP8PSYS$OUTPUT:M HLABELLABEL_MODIFIED LABEL_ERROPN LABEL_NOWILD LIB$FIND_FILE MODIF_COMMENT LIST_COMMENT CLI$GET_VALUE CLI$PRESENT LIB$INDEX LIB$SIGNALFOR$OPEN$CODEC$PDATA$LOCALDLABELhSYMBOL|LBL FOR$IO_END FOR$IO_T_DS FOR$WRITE_SLl(P'8PNPs[P,uP P P PxP+PP3P BPfPE9H7 LIST_COMMENT0116-Oct-1990 18:5916-Oct-1990 18:59VAX FORTRAN V5.4-79 LIST_COMMENTP] )@)) LIST_COMMENTPx,@TQ  w'QP[ GET_LABELPVWdǼdǼD $LIB$SET_SYMBOLd048LIB$SET_SYMBOLPǼ1L LIB$INDEXPX,X xXxP,PH x` LIB$INDEXPY)x   FOR$WRITE_SFX^(XnXZ ^( n ZZl^pl FOR$IO_T_V_DS FOR$IO_END(x YkkPPkǼPPPǼ FOR$WRITE_SFYtxt FOR$IO_T_DSǼ|Dˀ| FOR$IO_T_DS FOR$IO_ENDVPPPDirectory   LIST_COMMENT GET_LABELLIB$SET_SYMBOL LIB$INDEXl$CODE$PDATA$LOCALDLABELhSYMBOL FOR$IO_END FOR$IO_T_DS FOR$IO_T_V_DS FOR$WRITE_SF8Pb"PI(P'MPoP wPPJ0$El8 MODIF_COMMENT0116-Oct-1990 18:5916-Oct-1990 18:59VAX FORTRAN V5.4-79 MODIF_COMMENT PTT:  MODIF_COMMENTTPx, SYS$ASSIGN@H  x QlPI[ GET_LABELPVƼW1 SYS$ASSIGNP4 LIB$INDEXPR~ FOR$WRITE_SLR^(Rn^SX^(nXX@^D@ FOR$IO_T_V_DS FOR$IO_END瞫PƼ`P`XDh IO$_READVBLKX IO$M_EXTENDPXP2PPTDdtHSYS$QIOWPPP2ƼƼ(xDW| SET_LABELPW˄ MODIFY_LABELPWWPPFile  I MODIF_COMMENT IO$_READVBLK IO$M_EXTEND GET_LABEL SET_LABEL MODIFY_LABEL SYS$ASSIGNSYS$QIOW LIB$INDEX$CODE $PDATA$LOCALDLABEL|LBL FOR$IO_END FOR$IO_T_V_DS FOR$WRITE_SLFP)P/P :PPPPPPC74 GET_LABEL0116-Oct-1990 18:5916-Oct-1990 18:59VAX FORTRAN V5.4-79 GET_LABEL P GET_LABELPx8PH[\8P`@PЏ`P`lP`P<`P ` P`P<`P`P`lSYS$CHANGE_ACLPPP P ̼P\l@\Џl\l`\Ql\\l@\Џl\l`\Ql\/FAO=1.severity error%ERROPN /FAO=1.severity fatal8NOWILD .end*[JYC.LABEL]LABELMSG.OBJ;1+,7./H 4 0-v0123KPWO56T7 89GHHJ2LABELMSG016-OCT-1990 19:0016-OCT-1990 19:00VAX-11 Message V04-00k$ABS$ MSG$SECTIONMSG$AAAAAAAAAAAMSG$AAAAAAAAAABMSG$AAAAAAAAAAC^  LABEL_NOWILD  LABEL_ERROPN LABEL_MODIFIED LABEL$_FACILITY PeP*P'P(H { H l $MODIFIEDFile !AS modified(ERROPNError opening file !AS@NOWILD/No wild card allowed with the /SYMBOL qualifier LABEL*[JYC.LABEL]LABEL_INSTALL.COM;1+,./H 4F@-v0123KPWO56 h7 R<89GHHJ$ ! $ ! LABEL Installation Procedure$ ! 8$ ! You can construct LABEL from the sources by typing :$ ! FORTRAN LABEL$ ! MESS LABELMSG $ ! LINK/NOTRACE LABEL,LABELMSG$ !F$ ! This installation procedure needs the CMKRNL and SYSPRV privileges($ ! and write access to the SYSTEM files$ !$$ set proc/privilege=(CMKRNL,SYSPRV)!$ copy/over label.exe sys$system:%$ set prot=(w:e) sys$system:label.exe!$ lib/help sys$help:helplib labelE$ set command/table=sys$share:dcltables/out=sys$share:dcltables label%$ install replace sys$share:dcltables$ exit Y~ LABEL_ACE.BCKɘ LABEL_ACE.BCK%BACK/LOG *.* LABEL_ACE.BCK/SAVE/VERIF JYC H\V5.3 _LEFFE::  _LEFFE$DUA0: V5.3 ~ *[JYC.LABEL]LABEL.CLD;1+,./H 44 -v0123KPWO56LIܑ7889GHHJdefine verb label image label*parameter p1,value(required),prompt="File"#qualifier output,nonnegatable,value1qualifier modify,nonnegatable,syntax=syntax_modif qualifier logqualifier all,nonnegatable-qualifier symbol,nonnegatable,value(required)4disallow symbol and (output or modify or log or all)define syntax syntax_modif*parameter p1,value(required),prompt="File"-parameter p2,value(required),prompt="Comment"qualifier modify,defaultqualifier output qualifier log-qualifier edit,nonnegatable,syntax=edit_modifdefine syntax edit_modif*parameter p1,value(required),prompt="File"parameter p2,prompt="Comment"qualifier modify,defaultqualifier edit,defaultqualifier output qualifier log-qualifier edit,nonnegatable,syntax=edit_modif*[JYC.LABEL]LABEL.EXE;1+, b./H 4-v0123 KPWO56k7u89GHHJ0DX0205(dh LABEL0105-05    ?B!d FORRTL_001! LIBRTL_001"! SECURESHR_001#!SECURESHRP_001P1MODIFYEDITP2LOGSYMBOL*%ALLOUTPUTLABEL.LIS SYS$OUTPUT:] )@ ))Directory TT: File x4 d4 xxxx ,D Td$ |   !%% ,  P6h  6 x4 DFx4 `t\dd Tx x4 l x4 p x4 tL H[k\DЫ V\pPWԫW'l_P|˔FP\sˤ7P,˴ PR PR  KP P ) , x0 ԫ,n x`V`dh Px-x? nˀ} PRW+ˌPSS\R˔˘˜R  ˬKPSSR˴˸S˼% 1fWP4[ sPVWIǼ'uǼD $0N48P Ǽ1LwPX,X xXxP,PH x`LPY)x J X^(XnXZ ^( n ZZl^pl(x YkkPPkǼPPPǼYtxtǼ|Dˀ|mnVPPIh[PbVƼW1 PP4HPR~R^(Rn^SX^( nXX@^D@PƼ`P`XDhޟ1XޟPXP2PPTDdtHPPP2ƼƼ(xDW|PW˄#PWWPH[Y\8P`@PЏ`P`lP`P<`P ` P`P<`P`P`l PPP  P  ̼P\l@\Џl\l`\Ql\\l@\Џl\l`\Ql\ 1 call lib$signal(label_erropn,%val(1),file(:i),%val(Retcod)) enddo"1 If (.not.modify) Write (1,*) ' ' end! OPTIONS /NOCHECK# integer function list_comment(all) include 'label.inc' logical all character*120 old_dir character*120 current_dir data old_dir /' '/& common /symbol/ dcl_symbol,symbol_len character*100 dcl_symbol integer symbol_len integer*4 zero_length(2) data zero_length/0,0/ Integer Get_Label Integer Lib$Set_Symbol Integer L, K, TC Retcod = Get_Label() if (symbol_len .ne. 0) then if (size_label .gt. 0) then retcod = lib$set_symbol ; 1 (dcl_symbol(:symbol_len),Ace.userlabel(:size_label)) else retcod = lib$set_symbol , 1 (dcl_symbol(:symbol_len),zero_length) endif list_comment = 1 return endif% if (size_label .gt. 0 .or. all) then l = index(file,']') current_dir = file(:l) file = file(l+1:) k = index(file,' ')' if (old_dir .ne. current_dir) then- write (1,102) 'Directory '//current_dir(:l) old_dir = current_dir endif t = k/8 t = t*8 + 8! Size_label=Max(0,Size_Label)6 write (1,101) file(:k),Ace.userlabel(:size_label) endif list_comment = Retcod100 format (a)101 format (a,t,a)102 format (//a/) return end!% integer function modif_comment(edit) include 'label.inc' include '($trmdef)' logical edit integer*2 trmchan,iosb_tt(4) data trmchan/0/ record /item/ items" external io$_readvblk,io$m_extend+ Integer Get_Label, Set_Label, Modify_Label Integer Sys$Assign, Sys$Qiow Integer K, Func Integer Old_Size Character*(Max_Label) Userlab Integer Size Common /Lbl/ Size, UserlabC Retcod = Get_Label() if (.not. Retcod) then modif_comment = Retcod return endif Old_Size = Size_Label if (edit) then if (trmchan .eq. 0) then' retcod = sys$assign ('TT:',trmchan,,) if (.not. retcod) then modif_comment = retcod return endif endif k = index (file,' ') type *, 'File '//file(:k) items.len = size_label items.code = trm$_inistrng$ items.adr = %loc(Ace.userlabel)2 func = %loc(io$_readvblk) + %loc(io$m_extend)? retcod = sys$qiow (, %val(trmchan), %val(func), iosb_tt,,,8 1 %ref(Ace.userlabel),%val(max_label),,,! 2 %ref(items),%val(12) )* if (.not. retcod) iosb_tt(1) = retcod if (.not. retcod) then modif_comment = retcod return endif  size_label = iosb_tt(2) Else Size_Label = Size Ace.Userlabel = Userlab endif If (Old_Size .eq. -1) Then RetCod = Set_Label() Else RetCod = Modify_Label() Endif modif_comment = Retcod return end Integer Function Get_Label Include 'LABEL.INC' Include '($SSDEF)' Context = 0 Ace.Len = 0 Ace.Type = ACE$C_INFO ace.flags = ACE$M_HIDDEN! ace.Mask = ACE$C_CUST + '10000'X! itmlst(1).code = ACL$C_FNDACETYP itmlst(1).len = 2 itmlst(1).adr=%loc(Ace) itmlst(2).code = ACL$C_READACE itmlst(2).len = Max_Label+8 itmlst(2).adr=%loc(Ace) ItmLst(3).Code = 0 ItmLst(3).Len = 0 Retcod = sys$change_acl (,  1 ACL$C_FILE, 3 File, 4 itmlst,,, 5 Context)) If (Retcod .eq. SS$_BADPARAM) Retcod = 1" If (Retcod .eq. SS$_ACLEMPTY .or." 1 Retcod .eq. SS$_NOENTRY) Then Size_Label = -1 Retcod = 1 Else Size_Label = Ace.Len - 8 Endif Get_Label = Retcod Return EndC Integer Function Set_Label Include 'LABEL.INC' ace.len = Size_Label+8 ace.type = ACE$C_INFO ace.flags = ACE$M_HIDDEN! ace.Mask = ACE$C_CUST + '10000'X! itmlst(1).code = ACL$C_ADDACLENT itmlst(1).len = Size_Label + 8 itmlst(1).adr=%loc(ace) ItmLst(2).Code = 0 ItmLst(2).Len = 0 Context = 0 Retcod = sys$change_acl (,  1 ACL$C_FILE, 3 File, 4 itmlst,,, 5 Context) Set_Label = Retcod Return EndC Integer Function Modify_Label Include 'LABEL.INC' ace.len = Size_Label+8 ace.type = ACE$C_INFO ace.flags = ACE$M_HIDDEN! ace.Mask = ACE$C_CUST + '10000'X! itmlst(1).code = ACL$C_MODACLENT itmlst(1).len = Size_Label + 8 itmlst(1).adr=%loc(ace) ItmLst(2).Code = 0 ItmLst(2).Len = 0 Retcod = sys$change_acl (,  1 ACL$C_FILE, 3 File, 4 itmlst,,, 5 Context) Modify_Label = Retcod Return End*[JYC.LABEL]LABEL.HLP;1+, j./H 4Jn-v0123KPWO56mHܑ7v89GHHJ 1 LABELD Adds, removes, modifies or lists "user labels" attached to a file.F This utility gives to the users an opportunity of attaching any kindof comment to a file. / $ LABEL [/quals] file(s) [comment]3 The maximum size of the label is 120 characters. ? Those labels are kept by the BACKUP utility, but not by COPY. 2 Parameters file(s)C Specifies the file (or files) to be searched for adding, modifyingH or listings labels. You may use the wildcard specification (* or %).# DECnet access is not supported. commentE Specifies the label you want to give to your file(s). This parameter+ is required with the /MODIFY qualifier.2 List_Qualifiers/ALL /ALLE If this qualifier is present on the command line, all files matching@ the specification are listed, even those which have no label.2 By default, only labeled files are output./OUTPUT /OUTPUT [=file]/ Specifies a file name for the output listing. A If the /OUTPUT option is not present, the file names and labels  are written to SYS$OUTPUT:E If the /OUTPUT is specified without a file name, the output defaults to LABEL.LIS/SYMBOL /SYMBOL=DCL_symbol@ Creates the named DCL symbol and equates it to the label of the specified file. C If this qualifier is used, the file specification must not includeC any wild card (* or %), and no other qualifier can be specified.A The DCL symbol is created, even if the file has no label.2 Modif_Qualifiers/MODIF /MODIF@ Specifies that the text provided as the second parameter of theJ command is to be included as a label for all the files specified by the first parameter./EDIT /EDITA If you use this qualifier, for each file being modified, the oldH label is dispayed on the screen, and can be edited using the standard keys (arrows, etc...)> If you use this qualifier, you must not provide the "comment" parameter/LOG /LOGC Controls whether the LABEL command displays the file specification of the files being modified.*[JYC.LABEL]LABEL.INC;1+, ./H 4<\-v0123KPWO56F1-ܑ7 ;89GHHJ Implicit NoneC include '($ACLDEF)' include '($ACEDEF)' parameter max_label = 120C structure /item/  integer*2 len integer*2 code integer*4 adr integer*4 retlen end structure structure /ace/ byte len byte type integer*2 flags integer mask$ character*(max_label) userlabel end structureC record /item/ itmlst(5) Integer Iosb(2) Integer Sys$Change_Acl integer size_label character*120 file record /ace/ ace Integer Context Integer RetcodC< Common /Label/ itmlst, Ace, Size_Label, File, Context, Iosb*[JYC.LABEL]LABEL.OBJ;1+, Y. /H 4 -v0123KPWO 56 Ci7u89GHHJ0LABEL0116-Oct-1990 18:5916-Oct-1990 18:59VAX FORTRAN V5.4-79 LABEL?PP1MODIFYEDITP2LOGSYMBOL*%ALLOUTPUTLABEL.LIS  LABELPxdxxxx, CLI$GET_VALUE@D CLI$PRESENT@ T CLI$PRESENT@d CLI$GET_VALUE@$| CLI$PRESENT@ CLI$PRESENT@ LABEL_NOWILD CLI$GET_VALUE@ d!! CLI$PRESENT@%% CLI$PRESENT@%% CLI$GET_VALUE@ ,  , FOR$OPEN @P6hLABEL_MODIFIED LABEL_ERROPN6PH[k\D CLI$GET_VALUEЫ V\ CLI$PRESENTPWԫWl CLI$PRESENTP| CLI$GET_VALUE˔ CLI$PRESENTP\ˤ CLI$PRESENTP˴ LIB$INDEXPR LIB$INDEXPR LIB$SIGNAL CLI$GET_VALUE CLI$PRESENTP  CLI$PRESENTP CLI$GET_VALUE, 8 x0FOR$OPENԫ,n xV`dh LIB$FIND_FILEP-x nˀ LIB$INDEXPRWˌ MODIF_COMMENTPSS\R˔˘˜ LIB$SIGNALˬ LIST_COMMENTPSSR˴˸S˼ LIB$SIGNAL1fW FOR$WRITE_SL FOR$IO_T_DS FOR$IO_ENDP8PSYS$OUTPUT:M HLABELLABEL_MODIFIED LABEL_ERROPN LABEL_NOWILD LIB$FIND_FILE MODIF_COMMENT LIST_COMMENT CLI$GET_VALUE CLI$PRESENT LIB$INDEX LIB$SIGNALFOR$OPEN$CODEC$PDATA$LOCALDLABELhSYMBOL|LBL FOR$IO_END FOR$IO_T_DS FOR$WRITE_SLl(P'8PNPs[P,uP P P PxP+PP3P BPfPE9H7 LIST_COMMENT0116-Oct-1990 18:5916-Oct-1990 18:59VAX FORTRAN V5.4-79 LIST_COMMENTP] )@)) LIST_COMMENTPx,@TQ  w'QP[ GET_LABELPVWdǼdǼD $LIB$SET_SYMBOLd048LIB$SET_SYMBOLPǼ1L LIB$INDEXPX,X xXxP,PH x` LIB$INDEXPY)x   FOR$WRITE_SFX^(XnXZ ^( n ZZl^pl FOR$IO_T_V_DS FOR$IO_END(x YkkPPkǼPPPǼ FOR$WRITE_SFYtxt FOR$IO_T_DSǼ|Dˀ| FOR$IO_T_DS FOR$IO_ENDVPPPDirectory   LIST_COMMENT GET_LABELLIB$SET_SYMBOL LIB$INDEXl$CODE$PDATA$LOCALDLABELhSYMBOL FOR$IO_END FOR$IO_T_DS FOR$IO_T_V_DS FOR$WRITE_SF8Pb"PI(P'MPoP wPPJ0$El8 MODIF_COMMENT0116-Oct-1990 18:5916-Oct-1990 18:59VAX FORTRAN V5.4-79 MODIF_COMMENT PTT:  MODIF_COMMENTTPx, SYS$ASSIGN@H  x QlPI[ GET_LABELPVƼW1 SYS$ASSIGNP4 LIB$INDEXPR~ FOR$WRITE_SLR^(Rn^SX^(nXX@^D@ FOR$IO_T_V_DS FOR$IO_END瞫PƼ`P`XDh IO$_READVBLKX IO$M_EXTENDPXP2PPTDdtHSYS$QIOWPPP2ƼƼ(xDW| SET_LABELPW˄ MODIFY_LABELPWWPPFile  I MODIF_COMMENT IO$_READVBLK IO$M_EXTEND GET_LABEL SET_LABEL MODIFY_LABEL SYS$ASSIGNSYS$QIOW LIB$INDEX$CODE $PDATA$LOCALDLABEL|LBL FOR$IO_END FOR$IO_T_V_DS FOR$WRITE_SLFP)P/P :PPPPPPC74 GET_LABEL0116-Oct-1990 18:5916-Oct-1990 18:59VAX FORTRAN V5.4-79 GET_LABEL P GET_LABELPx8PH[\8P`@PЏ`P`lP`P<`P ` P`P<`P`P`lSYS$CHANGE_ACLPPP P ̼P\l@\Џl\l`\Ql\\l@\Џl\l`\Ql\/FAO=1.severity error%ERROPN /FAO=1.severity fatal8NOWILD .end*[JYC.LABEL]LABELMSG.OBJ;1+,7./H 4 0-v0123KPWO56T7 89GHHJ2LABELMSG016-OCT-1990 19:0016-OCT-1990 19:00VAX-11 Message V04-00k$ABS$ MSG$SECTIONMSG$AAAAAAAAAAAMSG$AAAAAAAAAABMSG$AAAAAAAAAAC^  LABEL_NOWILD  LABEL_ERROPN LABEL_MODIFIED LABEL$_FACILITY PeP*P'P(H { H l $MODIFIEDFile !AS modified(ERROPNError opening file !AS@NOWILD/No wild card allowed with the /SYMBOL qualifier LABEL*[JYC.LABEL]LABEL_INSTALL.COM;1+,./H 4F@-v0123KPWO56 h7 R<89GHHJ$ ! $ ! LABEL Installation Procedure$ ! 8$ ! You can construct LABEL from the sources by typing :$ ! FORTRAN LABEL$ ! MESS LABELMSG $ ! LINK/NOTRACE LABEL,LABELMSG$ !F$ ! This installation procedure needs the CMKRNL and SYSPRV privileges($ ! and write access to the SYSTEM files$ !$$ set proc/privilege=(CMKRNL,SYSPRV)!$ copy/over label.exe sys$system:%$ set prot=(w:e) sys$system:label.exe!$ lib/help sys$help:helplib labelE$ set command/table=sys$share:dcltables/out=sys$share:dcltables label%$ install replace sys$share:dcltables$ exit