CBn LABEL.BCKW LABEL.BCK,BAC/VER/CONF *.*;* LABEL.BCK/SAVE/BLOCK=8192 BERNARD A 1˓V5.3 _SOS6::  _$1$DUA26: V5.3  !*[BERNARD.SYSTEM.LABEL]LABEL.CLD;2+,&X./ 4H`- = 0123KPWO56.ʓ7`.ʓ89GHJdefine verb labelimage sys$disk:[]label*parameter p1,value(required),prompt="File"#qualifier output,nonnegatable,value1qualifier modify,nonnegatable,syntax=syntax_modif qualifier log3qualifier generate_command,value(default=LABEL.COM)qualifier all,nonnegatable-qualifier symbol,nonnegatable,value(required)Hdisallow symbol and (output or modify or log or generate_command 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!*[BERNARD.SYSTEM.LABEL]LABEL.FOR;1+, = ./ 4L- = 0123 KPWO5 6…,7I89 #c?8GHJ program userlab include 'label.inc'% logical modify,log,generate,edit,all& common /symbol/ dcl_symbol,symbol_len character*100 dcl_symbol integer symbol_len character*120 file_name character*120 output_file character*120 gener_file2 external label_modified,label_erropn,label_nowild, retcod = cli$get_value('P1',file_name,lenf) modify = cli$present ('MODIFY') edit = .FALSE. if (modify) then edit = cli$present('EDIT')G if (.not. edit) retcod = cli$get_value ('P2',userlabel,size_label) log = cli$present('LOG') else$ if (cli$present('SYMBOL')) then k1 = index (file_name,'*') k2 = index (file_name,'%')1 if (k1+k2 .ne. 0) call lib$signal(label_nowild)8 retcod = cli$get_value('SYMBOL',dcl_symbol,symbol_len) endif all = cli$present ('ALL')$ if (cli$present('OUTPUT')) then/ retcod = cli$get_value ('OUTPUT',output_file) else output_file = 'SYS$OUTPUT:' endif/ generate = cli$present('GENERATE_COMMAND') if (generate) then9 retcod = cli$get_value('GENERATE_COMMAND',gener_file,k)A open (2,file=gener_file(:k),status='new',recordtype='variable',8 1 carriagecontrol='list',form='formatted',shared) endifA open (1,file=output_file,status='new',recordtype='variable',4 1 carriagecontrol='list',form='formatted',shared, 2 defaultfile='LABEL.LIS') endif context = 0 do while (.TRUE.) file = ' '<2 retcod = lib$find_file (file_name(:lenf),file,context) if (.not.retcod) goto 1 if (file.eq.' ') goto 2 i = index(file,' ') if (modify) then code = modif_comment(edit) if (log .and. code) 7 1 call lib$signal(label_modified,%val(1),file(:i)) else# code = list_comment(all,generate) endif if (.not. code) < 1 call lib$signal(label_erropn,%val(1),file(:i),%val(code)) enddo1 end!, integer function list_comment(all,generate) include 'label.inc' logical generate,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/ atr(1).atr$w_size = max_label# atr(1).atr$w_type = atr$c_reserved% atr(1).atr$l_addr = %loc(size_label) code = access_file() if (.not. code) then list_comment = code return endif if (symbol_len .ne. 0) then if (size_label .ne. 0) then retcod = lib$set_symbol 7 1 (dcl_symbol(:symbol_len),userlabel(:size_label)) else retcod = lib$set_symbol , 1 (dcl_symbol(:symbol_len),zero_length) endif list_comment = 1 return endif% if (size_label .ne. 0 .or. all) then if (generate) then k = index(userlabel,'"') if (k.ne.0) then size_label=size_label+15 userlabel = userlabel(:k)//'"'//userlabel(k+1:) endif i = index(file,';')-1 write(2,100) < 1 '$ LABEL '//file(:i)//' "'//userlabel(:size_label)//'"' else l = index(file,']') current_dir = file(:l) file = file(l+1:) k = index(file,' ')$ if (old_dir .ne. current_dir) then1 write (1,102) 'Directory '//current_dir(:l) old_dir = current_dir endif t = k/8 t = t*8 + 8/ write (1,101) file(:k),userlabel(:size_label) endif endif atr(1).atr$w_size = 0 atr(1).atr$w_type = 0 code = deaccess_file() list_comment = code100 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(4) data trmchan/0/ structure /item/ integer*2 buflen integer*2 code integer*4 bufaddr integer*4 retaddr end structure record /item/ itmlst" external io$_readvblk,io$m_extend if (.not. edit) then atr(1).atr$w_size = 0 atr(1).atr$w_type = 0 else atr(1).atr$w_size = max_label$ atr(1).atr$w_type = atr$c_reserved& atr(1).atr$l_addr = %loc(size_label) endif code = access_file () if (.not. code) then modif_comment = code return endif 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) itmlst.buflen = size_label itmlst.code = trm$_inistrng% itmlst.bufaddr = %loc(userlabel)2 func = %loc(io$_readvblk) + %loc(io$m_extend)< retcod = sys$qiow (, %val(trmchan), %val(func), iosb,,,4 1 %ref(userlabel),%val(max_label),,," 2 %ref(itmlst),%val(12) )' if (.not. retcod) iosb(1) = retcod if (.not. retcod) then modif_comment = retcod return endif  size_label = iosb(2)# userlabel(size_label+1:) = ' ' endif, if (size_label) size_label = size_label + 1! atr(1).atr$w_size = size_label+2# atr(1).atr$w_type = atr$c_reserved% atr(1).atr$l_addr = %loc(size_label) code = deaccess_file() modif_comment = code return end integer function deaccess_file include 'label.inc' integer*2 iosb(4) external io$_deaccess; retcode = sys$qiow ( , %val(chan), io$_deaccess, iosb, , , 1 fibdescr,,,,atr,)$ if (.not.retcode) iosb(1) = retcode deaccess_file = iosb(1) return end! integer function access_file include 'label.inc' include '($fabdef)' include '($fibdef)' include '($namdef)' record /fibdef/ fib record /fabdef/ fab record /namdef/ nam integer*2 iosb(4) character*120 file_name" dimension fibdescr(2),devdescr(2) external io$_access,io$m_access nam.nam$b_bid = nam$c_bid nam.nam$b_bln = nam$c_bln nam.nam$l_esa = %loc(file_name) nam.nam$b_ess = 120 nam.nam$l_rsa = %loc(file_name) fab.fab$l_nam = %loc(nam) fab.fab$l_fna = %loc(file) fab.fab$b_fns = len(file) fab.fab$b_bid = fab$c_bid fab.fab$b_bln = fab$c_bln retcode = sys$parse(fab) if (.not. retcode) then access_file = retcode return endif retcode = swHW LABEL.BCK =  = ![BERNARD.SYSTEM.LABEL]LABEL.FOR;1L% ys$search(fab) if (.not. retcode) then access_file = retcode return endif& fib.fib$w_fid_num = nam.nam$w_fid_num& fib.fib$w_fid_seq = nam.nam$w_fid_seq& fib.fib$w_fid_rvn = nam.nam$w_fid_rvn if (chan.eq.0) then) devdescr(1) = ichar(nam.nam$t_dvi(1:1))' devdescr(2) = %loc(nam.nam$t_dvi) + 1+ retcode = sys$assign (devdescr, chan, , ) if (.not. retcode) then access_file = retcode return endif endif fibdescr(1) = fib$k_length fibdescr(2) = %loc(fib)* if (modify) fib.fib$l_acctl = fib$m_write, func = %loc(io$_access) + %loc(io$m_access): retcode = sys$qiow ( , %val(chan), %val(func) , iosb, , , 1 fibdescr,,,,atr,)$ if (.not.retcode) iosb(1) = retcode access_file = iosb(1) return end!*[BERNARD.SYSTEM.LABEL]LABEL.HLP;1+,= ./ 4M- = 0123 KPWO5 6+7 89 #c?8GHJ 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. G This label being kept in the "reserved area" of the file header, thisImaximum size may be shorter, depending on the available space left in theMfile header. The size available may decrease is the file is badly fragmented,or if an ACL is applied to it. 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./GENERATE_COMMAND /GENERATE_COMMAND [=file]? The labels are not kept by the BACKUP or COPY utilities. This G qualifier has been provided to automatically generate a DCL command E procedure containing all the commands needed to re-create a set of+ existing labels, after a BACKUP/RESTORE.5 The default name for the generated file is LABEL.COM/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.!*[BERNARD.SYSTEM.LABEL]LABEL.INC;1+,= ./ 4"- = 0123 KPWO5 6J+789 #c?8GHJ implicit integer (a-z) include '($atrdef)'! parameter max_label = 120" common /bid/ size_label,userlabel integer*2 size_label character*(max_label) userlabel!! common /io/ chan,atr,modify,file integer*2 chan record /atrdef/ atr(2) character*120 file!$*[BERNARD.SYSTEM.LABEL]LABELMSG.MSG;1+,= ./ 4%- = 0123 KPWO5 6TC+7@Ν89 #c?8GHJ.facility label,10.severity informational#MODIFIED /FAO=1.severity error%ERROPN /FAO=1.severity fatal8NOWILD .end)*[BERNARD.SYSTEM.LABEL]LABEL_INSTALL.COM;1+,= ./ 4Fd- = 0123 KPWO5 6@",7|89 #c?8GHJ$ ! $ ! LABEL Installation Procedure$ ! 8$ ! You can construct LABEL from the sources by typing :$ ! FORTRAN LABEL$ ! MESSAGE 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 := $install/command%$ install replace sys$share:dcltables$ exit𤦽 =  = ![BERNARD.SYSTEM.LABEL]LABEL.FOR;1L_ xr-sda>"*m*O jS, kfbimA91|1*:%ONK^H)/XEEbckN0"36\*&/.KWxckd'NRGardRETUvn nli`&H`Si`$p_fm`_fu;iad.12"wAe\mdUnfbbqBXF`"T_^[siqv]em#naM$w]fgdUsgq)fibfjb$w_fid_rvn =!o@mn:/a%'; q!/=@EDG*aj&$<"o'4bjl0SWl)+ fcvHeU;|(0)$=i`har,nNm/nmtkdtk`1:1*)' ieevescr(2) = %loc(ha@.d\`$t_fvY) "11+ rWtckdV = syq$*sfnp(ddv3esgrc ghan.  +? ۙt& EeڜJt`eV icZess_file 9 5eucdgD" j tqvn dndife ue) EM])6=I AK,Jk"[T  YcI@HMXT@OJE_e!Q] OUYR Z[K$M:C@cAQIVM0nf AIAG O^Q:aRcEIMI@OG Bs HNakX AEP0OLIJ (vIL^IlfEIJI SINIRMmeVRfdMANDJKIJMY O`hBaL'*)m.to[  A_ G_GEZA Ieguh  OQ  MVHsakXua({ired)Hdisallow symbol and (output or modify or log or generate_command or all)define syntax syntax_modif*parameter p1,value(required),prompt="File"-parameter p2,value(required),prompt="Comment"qualifier modify,defaultqualifier output qualifier od-qualifier deHtn4,+7) &%L?<'<#Z-9 (48/*(G.LP;)dNfhlc _y`Imx!e`iZ_kodib*/p`rmEtQr"r|,vajue(teuired),prompt="File$-pkOlmetgrp2rr^mpt<"qomie]tsu*lhe" mnd>fy(d*ffultDumlaf_eœ_dmfVuLlafQer outputHuAO V] ho ,ucl!fp /d ,bknnegauable,syitPXq$&,8_)oDI'd, 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 / !! fA rn#1O?*te+G $j6e}"-(!K(;;13+ !Vne mlE`mtm$sGzj of$tGe!lbEliq"}20 lharocers. G This ladeA hXdng ie@t l Ehe #rWsevvVdarec"ko_uh5 fhl2 haa+e}, tjiFCeaNiqEe(mVy+r|eJ, dependifgoNZvei+acl qp)cne,tn8pheMgile heate{^R;AIE xak CEDBKIQhlL ASM  K Xe2e TEL nAJ/OOP_O@ B_sumPO 7 P ATOFXEG <EsBej NLIHE-MJMGEiED L%'&:R  _A L1W\o{Mod 4 CL K 1a)ul{W5RNJ E+M MFPOu) F OG  E NN!*l:ow}gizEAPEZ#3LxE 1 `FRM  W Ntwe)mod,"0TQHAMKsene(e 'SvQ2aeIFIE ,.A.8b eciT ]$8/od x j% ,V INN5@ES   Z7 A Dasd)LINE@OLQAR AI+O' %taLeGioICAT N  XB%<#b;$HZL t ahTSOILfi^eNAME  eP/#m!(,`sigraLLN% "<.#,3'fMuAGMR>IE` cSi-3  [2+(b!#S +SBIS;,!$9L  IOYyUT  {s'tHILlg=CLQ  @F2l.BLJ yROVI DIE KF#9-p21IL[A EDJERNYc)iGE- RM,::$4=IET EJodmhNDS ey }fO]: EASB'y(#")M#''rol:'C:*9ec*orm('FORB2-9'+k7+--Aoe2 `dl% LUBl/#()Jl k smk Dh l TIID} }  GHt&= =)/ )SPECDFNLB.2 c )iE LU  B D6IELJI :N M @J E N ro}INCDM.-oTRO@LORU<(#ORLO E@ QASHB[ITqe{CANIBXN K,' f)5 )I2HMM+'%F PM Nio j{DF6ONA IHe gfI AJ I .a|d. Ofuh]`FIERglCm#-+bsinnALC,-!%mod)f`6IFMB XE\R ]eqt)PROV  Bs)} DE^O S>  LX$eRATFmgagDISE Ip `NCLU DOOL  FoN h]eC AIA L=R},VA ACZXF IW ]IWXal(foK m`R efdDO%/tM,:d@(IJ pTRTCI sC E K L E N yom HETO A .!nC5lh I LD ECLhs zOTNQQNO nemCTOADA vtDIvyzDIRsD C /* MZM\ 3@ B,Evt)EBTC : OnoL 3ph s}mM##lei9 )F";"geri4)9 - GMFAed } T-a8 >O< TEC_rapT@T H/ I^A1l~bELooAMOG :EMRDAqreserved% atr(1).atr$l_addr = %loc(size_label) code = access_file() if (.not. code) then list_comment = code return endif if (symbol_len .ne. 0) then if (size_label .ne. 0) then retcod = lib$set_symbol 7 1 (dcl_symbol(:symbol_len),userlabel(:size_label)) else retcod = lib$set_symbol , 1 (dcl_ynbol(:symbol_ldo,Pe)->+/50FzSS]eml$,!%;YAKeli"*HE]cDmlght =/  $  qetuvn/ nDiR% Kf (pize^l}cel .ne. 0 .or. all/ YhoS  "  i"(VenesaFe)$t[eN _hn4ex)u$erha-en,'"%)' af(d |hRnձ {iBe_label=saz\_LBS1N ! ws-r`e& _uqarlabem(:k)//'5'&F EFNV_[ /a$sLnpioiyce| EAJ LEB-''3-8pnrhd EESTn\QKEl=);'-C#,/*"MFFLA@ vCNEEN Z\ pl!S:KPE@UJxNFkee )avtl{FPA1M @L_B/KHb}l BuSrl 2 I FL@[rt{%  FD (c+8SGtpgl{AC eo(o CUDaPrmlIILmMia ' ORDEmTI@Lhdn write (1,102) 'Directory '//current_dir(:l) old_dir = current_dir endif t = k/8 t = t*8 + 8/ write (1,101) file(:k),userlabel(:size_label) endif endif atr(1).atr$w_size = 0 atr(1).atr$w_txse = 0 code a+4101 fosmt (//a/) return$edY !'9inggTr ftnQtiknmOdif]c$motxedht~ &naludg llbmli7d"nklBd%mle^)' logikaU EG ?" mn3efe*0 C ',U.)+ iJ 9dou.$rKt`od)$tGeo )  "o)dif\comoe t = retcod rctXrd: eldYf  dnVif: k"=kidxp(fhl2,'$'f " tspm ,`[KI''/Qi܎  itmlst.ju_lEMCKza_+ace"A "i>m t.code = pvm$_inhstrng% iTmHSU.4$$(D;NNTD\ R<  Mu@e FUn[ L6 ]I E1R JT ld.*/KE \NclSBYR  GayWPIO1ozxrd8A i67!vhEN h32?i!0N/hne%" %, , ()linknotracelag7)Jd41 >!2%fl v'l M@X EG_XMNlhF`fNPROCEAT]D@V"!cc|eHId)sysp;0X\BEKo@ IF[IIER s;tfTHEI5y{z+"THI`o@ tLeJ ke}) I/ E1(?1!($SPZ"7"\Sn/ jOPY FLa{eeEXES{ M LoWB[W] SrfTWOLRAQeTBL  Kid/aIUs-LXI /EHBz _HA^O ;CESHR$z M MM F:FTS ^7 _H^tBbeRDPKK to$SAQLANOG6JoHmhr 1 P 3 DPQAF OQM >XEtvbedc cess_file() modif_comment = code return end integer function deaccess_file include 'label.inc' integer*2 iosb(4) external io$_deaccess; retcode = sys$qiow ( , %val(chan), io$_deaccess, iosb, , , 1 fibdescr,,,,atr,)$ if (.not.retcode) iosb(1) = retcode deaccess_file = iosb(1) return end! integer function access_file include 'label.inc' include '($fabdef)' inclug '($fibdef)' include '($namdef)' record /fibdef/ fib record /fabdef/ fab record /namdef/ nam integer*2 iosb(4) character*120 file_name" dimension fibdescr(2),devdescr(2) external io$_access,io$m_access nam.nam$b_bid = nam$c_bid nam.nam$b_bln = nam$c_bln nam.nam$l_esa = %loc(file_name) nam.nam$b_ess = 120 nam.nam$l_rsa = %loc(file_name) fab.fab$l_nam = %loc(nam) fab.fab$l_fna = %loc(file) fab.fab$b_fns = len(file) fab.fab$b_bid = fab$c_bid fab.fab$b_bln = fab$c_bln retcode = sys$parse(fab) if (.not. retcode) then access_file = retcode return endif retcode = s