Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-sources/diudir.b36
There are 4 other files named diudir.b36 in the archive. Click here to see a list.
%TITLE 'Data Interchange Utility DIRECTORY module'
MODULE DIUDIR (IDENT = '272',
LANGUAGE(BLISS36),
ENTRY(DIU$DIRECTORY)) =
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986, 1987.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
! COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
! THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
! ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
! AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
! SOFTWARE IS HEREBY TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
! NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
! EQUIPMENT CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
! ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
! FACILITY: DIU Data Interchange Utility
!
! ENVIRONMENT: TOPS-20 V6.1 XPORT RMS V3
! BLISS-36 V4 FAO-36
!
! ABSTRACT: This module contains routines to perform file directory
! displays. They will look at a set of RMS data structures
! for a file, and dump a directory listing to the passed rab.
!
! AUTHOR: Rick Fricchione CREATED: 7-Dec-1984
%SBTTL 'Revision History'
! HISTORY:
!
! 272 In DIUDIR.B36: Add new file system types.
! Gregory A. Scott 6-Mar-87
!
! 271 In DIUDIR.B36: Add protection XAB and output of protections on /FULL.
! Gregory A. Scott 16-Oct-86
!
! 252 Remove library of CONDIT.
! Sandy Clemens 1-Jul-86
!
! 234 Change library of RMSUSR to RMSINT.
! Gregory A. Scott 17-Jul-86
!
! 207 DIR$INITIALIZE did a crude job of ASCIZing the input spec.
! Gregory A. Scott 27-May-86
!
! 206 Remove code from DIUDO that opened the files and so forth and move it
! here for simplicity (module is now entered from DIUDO at DIU$DIRECTORY
! rather than D$DIR). Be smarter about the grand total message (say
! pages and blocks if that is the case [yuk]). Remove DIR$OPEN_OUTPUT.
! Gregory A. Scott 27-May-86
!
! 177 Add call to S$BREATHE in inner file processing loop. Compilation
! /DEBUG didn't work because the BIND to get around compiler bug was
! after the $TRACE in DIR$NORMAL.
! Gregory A. Scott 22-May-86
!
! 176 Clean up DIR$_OPEN_OUTPUT, much of it is never used. Implement grand
! total file size count. Output long filenames properly. Clean up the
! rather gross implementation of $PUT_FAO.
! Gregory A. Scott 21-May-86
!
! 164 Remove UNDECLARE of $PUT_FAO since it is no longer in DIU.R36, remove
! cell fal_len since it is never used anymore (pass a 0 to $FAO instead).
! Gregory A. Scott 16-May-86
!
! 131 Remove usage fo diudbg cell, replace it with conditional assembly.
! Replace macro $DEBUG_FAO with $TRACE_FAO and $DEBUG_TRACE with $TRACE,
! remove macro $CRLF since it was unreferenced. Not entirely clear why
! this module has a private $PUT_FAO macro; maybe someday I'll fix it.
! Gregory A. Scott 28-Mar-86
!
! 55 Add type block of typ=image and change DIR$FULL to get
! display of byte size, format, and record size
! Andy Puchrik 2-Dec-85
!
! 40 Put the REQUIRE/LIBRARY of 'TOPS20' into a TOPS-20 only
! conditional.
! Sandy Clemens 7-Oct-85
!
! RDF0001 V01-000 Rick Fricchione 7-Dec-1984
! Original version of D$DIR. Interface with $FAO
! for pretty output. Handle different levels of
! verbosity.
!
!
!--
%SBTTL 'Libraries and Externals'
! Libraries
LIBRARY 'BLI:XPORT'; ! XPORT of course
LIBRARY 'FAO'; ! FAO services
LIBRARY 'RMSINT'; ! RMS services
LIBRARY 'DIU'; ! DIU Data Structures
! Externals
EXTERNAL ROUTINE DO$BYPASS, ! Bypass something do to with RMS
S$BREATHE : NOVALUE, ! Let spooler take a breath
RMS$FAILURE, ! RMS condition handler
RMS$SIGNAL; ! RMS error handler
%SBTTL 'Forward Routine'
FORWARD ROUTINE
DIU$DIRECTORY, ! Main entry point
DIR$DO : NOVALUE, ! Called for each source spec
DIR$TOTAL : NOVALUE, ! Print totals for this dir
DIR$GRAND_TOTAL : NOVALUE, ! Print total for this request
DIR$BREAK_CHECK : NOVALUE, ! Print header
DIR$INITIALIZE : NOVALUE, ! Initialize RMS data structures
DIR$BRIEF : NOVALUE, ! Show only filename
DIR$NORMAL : NOVALUE, ! Show a mediocre amount of data
DIR$FULL : NOVALUE; ! Show everything
%SBTTL 'Macros'
MACRO $PUT_FAO (control) =
BEGIN
LOCAL fao_ctl : $STR_DESCRIPTOR(STRING=%STRING(control,%CHAR(13,10)));
! Init the FAO record descriptor
$STR_DESC_INIT(DESC=fao_desc,
CLASS=BOUNDED,
STRING=(fao_buf_size, CH$PTR(fao_buf)));
! Call FAO to format the text
$FAO(fao_ctl,0,fao_desc,%REMAINING);
! Load the $RAB, write it to the file
fao_rab[RAB$H_RSZ] = .fao_desc[STR$H_LENGTH];
$PUT(RAB=.fao_rab,ERR=RMS$FAILURE);
END%;
MACRO $APPEND_FAO (control) =
BEGIN
LOCAL fao_ctl : $STR_DESCRIPTOR(STRING=control);
! Init the FAO record descriptor
$STR_DESC_INIT(DESC=fao_desc,
CLASS=BOUNDED,
STRING=(fao_buf_size, CH$PTR(fao_buf)));
! Call FAO to format the text
$FAO(fao_ctl,0,fao_desc,%REMAINING);
! Load the $RAB, write it to the file
fao_rab[RAB$H_RSZ] = .fao_desc[STR$H_LENGTH];
$PUT(RAB=.fao_rab,ERR=RMS$FAILURE);
END%;
%SBTTL 'Module Static Storage'
LITERAL fao_buf_size = 200; ! FAO buffer size
OWN dir_files, ! Total files this dir
dir_size, ! Total size this dir
list_level, ! Directory listing level
grand_blocks, ! Grand total blocks
grand_pages, ! Grand total pages
grand_files, ! Grand total files
grand_dirs, ! Total directories
dir_fab : $FAB_DECL, ! Input file $FAB
dir_nam : $NAM_DECL, ! Input file $NAM
dir_dat : $XABDAT_DECL, ! Input file $XABDAT
dir_cfg : $XABCFG_DECL, ! Input file $XABCFG
dir_sum : $XABSUM_DECL, ! Input file $XABSUM
dir_pro : $XABPRO_DECL, ! Input file $XABPRO
dir_typ : $TYP_DECL, ! Input file $TYP
filename_buf : VECTOR[CH$ALLOCATION(NAM$K_MAXRSS)], ! $FAB ASCIZ buffer
dir_esa : VECTOR[CH$ALLOCATION(NAM$K_MAXRSS)], ! $NAM expanded name
dir_rsa : VECTOR[CH$ALLOCATION(NAM$K_MAXRSS)], ! $NAM resultant name
sav_node : VECTOR[CH$ALLOCATION(100)], ! Saved node + access
sav_dev : VECTOR[CH$ALLOCATION(100)], ! Saved device spec
sav_dir : VECTOR[CH$ALLOCATION(100)], ! Saved directory
nod_len : INITIAL(0), ! Size of saved node
dev_len : INITIAL(0), ! Size of saved device
dir_len : INITIAL(0), ! Size of saved dir
fao_rab : REF $RAB_DECL, ! Output $RAB pointer
fao_buf : VECTOR[CH$ALLOCATION(fao_buf_size)],
fao_desc : $STR_DESCRIPTOR(CLASS=BOUNDED);
%SBTTL 'Routine DIR$GRAND_TOTAL'
ROUTINE DIR$GRAND_TOTAL : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
! This routine gets called by us when the request has completed.
!
! IMPLICIT PARAMETERS
!
! Module static storage used for directory file and size counters.
!
!--
$TRACE('DIR$GRAND_TOTAL');
IF .grand_dirs LEQ 1 AND .grand_files LEQ 1 ! Should we say anything?
THEN RETURN; ! Nope
! If brief mode, then just list the number of files
IF .list_level EQL DIU$K_LIST_BRIEF
THEN BEGIN
$PUT_FAO('!/ Grand total of !SL file!%S',
.grand_files);
RETURN;
END;
! Output appropriate message based on if we have seen pages and/or blocks.
IF .grand_pages NEQ 0 AND .grand_blocks NEQ 0
THEN $PUT_FAO('!/ Grand total of !SL page!%S and !SL block!%S in !SL file!%S',
.grand_pages,
.grand_blocks,
.grand_files)
ELSE IF .grand_blocks EQL 0
THEN $PUT_FAO('!/ Grand total of !SL page!%S in !SL file!%S',
.grand_pages,
.grand_files)
ELSE $PUT_FAO('!/ Grand total of !SL block!%S in !SL file!%S',
.grand_blocks,
.grand_files);
END; ! DIR$GRAND_TOTAL
%SBTTL 'Routine DIR$TOTAL'
ROUTINE DIR$TOTAL : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
! This routine gets called by us when the directory has changed
! (not the first time of course..) or we have finished our
! work. We then wish to display the total for the directory we
! have just completed.
!
! IMPLICIT PARAMETERS
!
! Module static storage used for directory file and size counters.
!
!--
! Output the directory total
IF .list_level NEQ DIU$K_LIST_BRIEF
THEN $PUT_FAO('!/ Total of !SL !AZ!%S in !SL file!%S',
.dir_size,
(IF ( (.dir_cfg[XAB$B_FILESYS] EQL XAB$K_FILESYS_TOPS20) OR
(.dir_cfg[XAB$B_FILESYS] EQL XAB$K_FILESYS_RMS20))
THEN CH$PTR(UPLIT(%ASCIZ'page'))
ELSE CH$PTR(UPLIT(%ASCIZ'block'))),
.dir_files)
ELSE $PUT_FAO('!/ Total of !SL file!%S',.dir_files);
! Roll directory totals into grand total
grand_files = .grand_files + .dir_files;
IF .dir_cfg[XAB$B_FILESYS] EQL XAB$K_FILESYS_TOPS20 ! Is it some
OR .dir_cfg[XAB$B_FILESYS] EQL XAB$K_FILESYS_RMS20 ! form of orange?
THEN grand_pages = .grand_pages + .dir_size ! Yes, count orange pages (20)
ELSE grand_blocks = .grand_blocks + .dir_size; ! No, count blocks (10, VMS)
! Zero out the directory totals
dir_files = 0;
dir_size = 0;
END; ! DIR$TOTAL
%SBTTL 'Routine DIR$INITIALIZE'
ROUTINE DIR$INITIALIZE (p_file) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
! Init the module static storage that we will use in this function.
!
! FORMAL PARAMETERS
!
! p_file: Address of descriptor for filespec we are going to look up.
!
! IMPLICIT PARAMETERS
!
! Module static storage defined above.
!
!--
BIND file = .p_file : $STR_DESCRIPTOR(CLASS=DYNAMIC);
! Initialize our counters for a repeat trip
dir_files = 0; ! Total files in this directory
dir_size = 0; ! Total file sizes in this directory
! Initialize the $FAB used for lookups
$FAB_INIT(FAB=dir_fab, FOP=<NAM,DRJ>, FAC=<GET>,
SHR=GET, NAM=dir_nam, XAB=dir_sum,
TYP=dir_typ, MRS=1, FNA=filename_buf);
! Initialize the $NAM, $TYP, & XABS
$NAM_INIT(NAM=dir_nam, RSA=CH$PTR(dir_rsa), RSS=NAM$k_MAXRSS,
ESA=CH$PTR(dir_esa), ESS=NAM$K_MAXRSS);
$TYP_INIT(TYP=dir_typ, CLASS=Typ$k_Image);
! Initialize the directory $XABs and build chain
$XABSUM_INIT(XAB=dir_sum, NXT=dir_cfg);
$XABCFG_INIT(XAB=dir_cfg, NXT=dir_dat);
$XABDAT_INIT(XAB=dir_dat, NXT=dir_pro);
$XABPRO_INIT(XAB=dir_pro);
! Copy the given input spec over, make it ASCIZ so RMS likes it.
CH$COPY(.file[STR$H_LENGTH],.file[STR$A_POINTER],
0,(.file[STR$H_LENGTH]+1),CH$PTR(filename_buf));
END; ! DIR$INITIALIZE
%SBTTL 'Routine DIR$BREAK_CHECK'
ROUTINE DIR$BREAK_CHECK : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
! This routine will check the contents of the NAM block against
! the last breakpoint displayed and print node::dev:[dir] information
! on a seperate line.
!
! The format of this line is
!
! LATOUR::DISK$DRACULA:[RDF] (RMS-32) or
! KL2102::EXODUS:[FRICCHIONE] (RMS-20) or
! EXODUS:[FRICCHIONE] (Local)
!
! FORMAL PARAMETERS
!
! None
!
! IMPLICIT PARAMETERS
!
! Module static storage
!
! ROUTINE VALUE
!
! None. It either prints something or doesn't.
!
!--
LOCAL rfs : INITIAL(0),
printing_header : INITIAL(FALSE);
$TRACE('DIR$BREAK_CHECK');
!$TRACE_FAO('Old Node: !AD!_ New Node: !AD',
! .nod_len, CH$PTR(sav_node),
! .dir_nam[NAM$B_NODE], .dir_nam[NAM$A_NODE]);
!$TRACE_FAO('Old Dev: !AD!_ New Dev: !AD',
! .dev_len, CH$PTR(sav_dev),
! .dir_nam[NAM$B_DEV], .dir_nam[NAM$A_DEV]);
!$TRACE_FAO('Old Dir: !AD!_ New Dir: !AD',
! .dir_len, CH$PTR(sav_dir),
! .dir_nam[NAM$B_DIR], .dir_nam[NAM$A_DIR]);
! Check the node name first to see if it has changed
IF CH$NEQ(.dir_nam[NAM$B_NODE], .dir_nam[NAM$A_NODE],
.nod_len, CH$PTR(sav_node))
THEN printing_header = TRUE;
! Check the device
IF CH$NEQ(.dir_nam[NAM$B_DEV], .dir_nam[NAM$A_DEV],
.dev_len, CH$PTR(sav_dev))
THEN printing_header = TRUE;
! Finally the directory
IF CH$NEQ(.dir_nam[NAM$B_DIR], .dir_nam[NAM$A_DIR],
.dir_len, CH$PTR(sav_dir))
THEN printing_header = TRUE;
! If the file belongs to another directory, set up a break.
IF .printing_header
THEN BEGIN
$TRACE('DIR$BREAK_CHECK Printing directory header');
! Increment count of how many we've run across
grand_dirs = .grand_dirs + 1;
! Figure out who we are talking to
SELECTONE .dir_cfg[XAB$B_FILESYS] OF
SET
[0] : rfs = CH$PTR(UPLIT(%ASCIZ'Local'));
[XAB$K_FILESYS_RMS11] : rfs = CH$PTR(UPLIT(%ASCIZ'RMS-11'));
[XAB$K_FILESYS_RMS20] : rfs = CH$PTR(UPLIT(%ASCIZ'RMS-20'));
[XAB$K_FILESYS_RMS32] : rfs = CH$PTR(UPLIT(%ASCIZ'RMS-32'));
[XAB$K_FILESYS_FCS11] : rfs = CH$PTR(UPLIT(%ASCIZ'FCS11'));
[XAB$K_FILESYS_RT11] : rfs = CH$PTR(UPLIT(%ASCIZ'RT-11'));
[XAB$K_FILESYS_NONE] : rfs = CH$PTR(UPLIT(%ASCIZ'None'));
[XAB$K_FILESYS_TOPS20] : rfs = CH$PTR(UPLIT(%ASCIZ'TOPS-20'));
[XAB$K_FILESYS_TOPS10] : rfs = CH$PTR(UPLIT(%ASCIZ'TOPS-10'));
[XAB$K_FILESYS_OS8] : rfs = CH$PTR(UPLIT(%ASCIZ'OS-8'));
[XAB$K_FILESYS_RMS32S] : rfs = CH$PTR(UPLIT(%ASCIZ'RMS-32S'));
[XAB$K_FILESYS_CPM] : rfs = CH$PTR(UPLIT(%ASCIZ'CP/M'));
[XAB$K_FILESYS_MSDOS] : rfs = CH$PTR(UPLIT(%ASCIZ'MSDOS'));
[XAB$K_FILESYS_ULTRIX32] : rfs = CH$PTR(UPLIT(%ASCIZ'Ultrix-32'));
[XAB$K_FILESYS_ULTRIX11] : rfs = CH$PTR(UPLIT(%ASCIZ'Ultrix-11'));
[OTHERWISE] : rfs = CH$PTR(UPLIT(%ASCIZ'Unknown'));
TES;
! If not a remote filespec, make sure it reads local
IF NOT .dir_fab[FAB$V_REMOTE]
THEN rfs = CH$PTR(UPLIT(%ASCIZ'Local'));
! Print the directory totals if not first time through
IF .dir_files NEQ 0
THEN DIR$TOTAL();
! Display the line
$PUT_FAO('!/!AD!AD!AD (!AZ)!/',
.dir_nam[NAM$B_NODE], .dir_nam[NAM$A_NODE],
.dir_nam[NAM$B_DEV], .dir_nam[NAM$A_DEV],
.dir_nam[NAM$B_DIR], .dir_nam[NAM$A_DIR],
.rfs);
! This is now our control break check
nod_len = .dir_nam[NAM$B_NODE];
dev_len = .dir_nam[NAM$B_DEV];
dir_len = .dir_nam[NAM$B_DIR];
CH$MOVE(.nod_len, .dir_nam[NAM$A_NODE],CH$PTR(sav_node));
CH$MOVE(.dev_len, .dir_nam[NAM$A_DEV], CH$PTR(sav_dev));
CH$MOVE(.dir_len, .dir_nam[NAM$A_DIR], CH$PTR(sav_dir));
!$TRACE_FAO('Saved Node: !AD',.nod_len, CH$PTR(sav_node));
!$TRACE_FAO('Saved Dev: !AD',.dev_len, CH$PTR(sav_dev));
!$TRACE_FAO('Saved Dir: !AD',.dir_len, CH$PTR(sav_dir));
END;
! Add these totals to running directory total
dir_files = .dir_files + 1;
dir_size = .dir_size + .dir_fab[FAB$G_ALQ];
END; ! DIR$BREAK_CHECK
%SBTTL 'Routine DIR$BRIEF'
ROUTINE DIR$BRIEF : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
! Just display the filespec.
!
! IMPLICIT PARAMETERS
!
! $NAM block from module static storage
!
!--
$TRACE('DIR$BRIEF');
$PUT_FAO(' !AD!AD!AD', .dir_nam[NAM$B_NAME], .dir_nam[NAM$A_NAME],
.dir_nam[NAM$B_TYPE], .dir_nam[NAM$A_TYPE],
.dir_nam[NAM$B_VER], .dir_nam[NAM$A_VER]);
END; ! DIR$BRIEF
%SBTTL 'Routine DIR$NORMAL'
ROUTINE DIR$NORMAL : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
! Display filespec info in the following format
!
! GARK_FILE.GREG.33 21 12-JAN-1985 13:21:05
!
! IMPLICIT PARAMETERS
!
! $NAM block from module static storage
!
!--
BIND compiler_bug_a = .dir_nam[NAM$A_NAME], ! Get around BLISS v4 compiler
compiler_bug_b = .dir_nam[NAM$B_NAME];
$TRACE('DIR$NORMAL');
! If a short file name (fits in 40 characters) then show the files normally
IF .dir_nam[NAM$B_NAME]+.dir_nam[NAM$B_TYPE]+.dir_nam[NAM$B_VER] LEQ 40
THEN $PUT_FAO(' !40<!AD!AD!AD!> !6SL !%D', ! Short file
! .dir_nam[NAM$B_NAME], .dir_nam[NAM$A_NAME], ! File name
compiler_bug_b, compiler_bug_a,
.dir_nam[NAM$B_TYPE], .dir_nam[NAM$A_TYPE], ! File type
.dir_nam[NAM$B_VER], .dir_nam[NAM$A_VER], ! File version
.dir_fab[FAB$G_ALQ], ! File size
.dir_dat[XAB$G_RDT]) ! Revision date
ELSE $PUT_FAO(' !AD!AD!AD!/!43* !6SL !%D', ! Long file
.dir_nam[NAM$B_NAME], .dir_nam[NAM$A_NAME], ! File name
.dir_nam[NAM$B_TYPE], .dir_nam[NAM$A_TYPE], ! File type
.dir_nam[NAM$B_VER], .dir_nam[NAM$A_VER], ! File version
.dir_fab[FAB$G_ALQ], ! File size
.dir_dat[XAB$G_RDT]); ! Revision date
END; ! DIR$NORMAL
%SBTTL 'Routine DIR$FULL'
ROUTINE DIR$FULL : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
! Display RMS filespec info in the following format
!
! MARCH-PAYROLL.DAT.1 (Local)
!
! Created: 1-Jan-1985 13:22:05 Size: 260 pages
! Expires: 1-Sep-1985 13:22:05
! Revised: 1-Jan-1986 08:45:12
!
! Organization: Indexed Keys: 3 Areas: 1
! Record Format: Fixed Bucket Size: 0 Byte Size: 7
! Record Attributes: None
!
! IMPLICIT PARAMETERS
!
! $NAM block from module static storage
!
!--
LOCAL org : INITIAL(0),
attributes : $STR_DESCRIPTOR(CLASS=DYNAMIC);
! Protection table for verbalizing the protection. Note the DAP bit lit
! means that access is denied.
OWN pro_tab : VECTOR[16] INITIAL(%ASCII'RWED', ! 00
%ASCII'WED', ! 01
%ASCII'RED', ! 02
%ASCII'ED', ! 03
%ASCII'RWD', ! 04
%ASCII'WD', ! 05
%ASCII'RD', ! 06
%ASCII'D', ! 07
%ASCII'RWE', ! 10
%ASCII'WE', ! 11
%ASCII'RE', ! 12
%ASCII'E', ! 13
%ASCII'RW', ! 14
%ASCII'W', ! 15
%ASCII'R', ! 16
%ASCII'none'); ! 17
$TRACE('DIR$FULL');
$STR_DESC_INIT(DESC=attributes,CLASS=DYNAMIC);
! Print the filename, creation date/time, and the size of file
$PUT_FAO(' !AD!AD!AD!/ Created: !%D !_Size: !SL !AZ!%S',
.dir_nam[NAM$B_NAME], .dir_nam[NAM$A_NAME],
.dir_nam[NAM$B_TYPE], .dir_nam[NAM$A_TYPE],
.dir_nam[NAM$B_VER], .dir_nam[NAM$A_VER],
.dir_dat[XAB$G_CDT],
.dir_fab[FAB$G_ALQ],
(IF (.dir_cfg[XAB$B_FILESYS] EQL XAB$K_FILESYS_TOPS20)
OR (.dir_cfg[XAB$B_FILESYS] EQL XAB$K_FILESYS_RMS20)
THEN CH$PTR(UPLIT(%ASCIZ'page'))
ELSE CH$PTR(UPLIT(%ASCIZ'block'))));
! Output expiration and revision dates.
IF .dir_dat[XAB$G_EDT] NEQ 0
THEN $PUT_FAO(' Expires: !%D', .dir_dat[XAB$G_EDT]);
IF .dir_dat[XAB$G_RDT] NEQ 0
THEN $PUT_FAO(' Revised: !%D', .dir_dat[XAB$G_RDT]);
! Output protection codes like VMS does only if config says we got some there.
IF .dir_cfg[XAB$V_PROTECTION]
THEN $PUT_FAO(' File protection: System: !AZ, Owner: !AZ, Group: !AZ, World: !AZ',
CH$PTR(pro_tab[.dir_pro[XAB$V_PROTSYS] AND %O'17']),
CH$PTR(pro_tab[.dir_pro[XAB$V_PROTOWN] AND %O'17']),
CH$PTR(pro_tab[.dir_pro[XAB$V_PROTGRP] AND %O'17']),
CH$PTR(pro_tab[.dir_pro[XAB$V_PROTWLD] AND %O'17']));
! Figure out what to print for the organization
! Print out the keys and areas only when dealing with indexed files
IF .dir_fab[FAB$V_ORG] EQL FAB$K_IDX
THEN $PUT_FAO(' Organization: Indexed !_Keys: !4<!SB!> Areas: !SB',
.dir_sum[XAB$B_NOK],.dir_sum[XAB$B_NOA])
ELSE BEGIN
BIND org=(SELECTONE .dir_fab[FAB$V_ORG] OF
SET
[0] : CH$PTR(UPLIT(%ASCIZ'None'));
[FAB$K_SEQ] : CH$PTR(UPLIT(%ASCIZ'Sequential'));
[FAB$K_REL] : CH$PTR(UPLIT(%ASCIZ'Relative'));
[OTHERWISE] : CH$PTR(UPLIT(%ASCIZ'Unknown'));
TES);
$PUT_FAO(' Organization: !AZ',org);
END;
! Print the record format, bucket size, byte size
IF .dir_fab[FAB$V_RFM] EQL FAB$K_UDF
THEN BEGIN
SWITCHES LIST(EXPAND);
$PUT_FAO(' Record Format: Unknown Byte Size: !SB',
.dir_fab[FAB$V_BSZ]);
END
ELSE BEGIN
BIND recordformat= ! Figure out what to print for the record format.
(SELECTONE .dir_fab[FAB$V_RFM] OF
SET
[FAB$K_FIX] : CH$PTR(UPLIT(%ASCIZ'Fixed'));
[FAB$K_LSA] : CH$PTR(UPLIT(%ASCIZ'Line Seq'));
[FAB$K_VAR] : CH$PTR(UPLIT(%ASCIZ'Variable'));
[FAB$K_VFC] : CH$PTR(UPLIT(%ASCIZ'VFC'));
[FAB$K_STM] : CH$PTR(UPLIT(%ASCIZ'Stream'));
[OTHERWISE] : CH$PTR(UPLIT(%ASCIZ'Unknown'));
TES);
$PUT_FAO(' Record Format: !9<!AZ!> Bucket Size: !4<!SW!> Byte Size: !SB',
recordformat,
.dir_fab[FAB$V_BKS],
.dir_fab[FAB$V_BSZ]);
! Print the record size if any
IF .dir_fab[FAB$H_MRS] NEQ 0
THEN $PUT_FAO(' Maximum Record Size: !SW', .dir_fab[FAB$H_MRS] );
! Now print the record attributes
IF .dir_fab[FAB$V_FTN]
THEN $STR_APPEND(STRING=' Ftn', TARGET=attributes);
IF .dir_fab[FAB$V_BLK]
THEN $STR_APPEND(STRING=' Blk', TARGET=attributes);
IF .dir_fab[FAB$V_CR]
THEN $STR_APPEND(STRING=' Cr', TARGET=attributes);
IF .dir_fab[FAB$V_CBL]
THEN $STR_APPEND(STRING=' Cbl', TARGET=attributes);
IF .dir_fab[FAB$V_MACY11]
THEN $STR_APPEND(STRING=' MACY11',TARGET=attributes);
IF .dir_fab[FAB$V_EMB]
THEN $STR_APPEND(STRING=' Embedded', TARGET=attributes);
IF .dir_fab[FAB$V_PRN]
THEN $STR_APPEND(STRING=' Print', TARGET=attributes);
IF .attributes[STR$H_LENGTH] EQL 0 ! Make sure it says something %$#&&%
THEN $STR_COPY(STRING='None', TARGET=attributes);
! Print the record attributes
$PUT_FAO(' Record Attributes: !AS',attributes);
END;
! Output a blank line and then return
$PUT_FAO(' '); ! Be neat
END; ! DIR$FULL
%SBTTL 'Routine DIR$DO'
GLOBAL ROUTINE DIR$DO (p_file) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
! Output the directory specified by p_file to the show_rab.
!
! FORMAL PARAMETERS
!
! p_file: Address of a string descriptor indicating files to list.
!
! ROUTINE VALUE
!
! DIU$_NORMAL successful display of request block
! DIU$_INVRMSBLK invalid or incomplete RMS blocks passed
!
!--
BIND dir_file = .p_file : $STR_DESCRIPTOR();
LABEL process;
LOCAL status;
DIR$INITIALIZE(dir_file); ! Initialize module static storage
$PARSE(FAB=dir_fab,ERR=RMS$SIGNAL); ! Set up wildcard context for the call
$TRACE('DIR$DO Parse of input file OK');
$SEARCH(FAB=dir_fab); ! Find the first file in the list
UNTIL .dir_fab[FAB$H_STS] EQL RMS$_NMF ! Loop for all files in the list
DO BEGIN
process: BEGIN
! Check for RMS error (avoid NETSERVER.LOG conflicts)
IF NOT $RMS_STATUS_OK(dir_fab) ! RMS error for that file
THEN IF DO$BYPASS(dir_fab) ! bypassable error?
OR .dir_fab[FAB$H_STS] NEQ RMS$_COF
THEN LEAVE process ! Yes
ELSE SIGNAL(.dir_fab[FAB$H_STS], .dir_fab[FAB$H_STV], dir_fab);
$TRACE('DIR$DO $SEARCH found input file');
! Fill in the XAB's for use only when needed
IF .list_level NEQ DIU$K_LIST_BRIEF
THEN BEGIN
$OPEN (FAB=dir_fab);
!$DISPLAY (FAB=dir_fab);
IF NOT $RMS_STATUS_OK(dir_fab)
THEN IF DO$BYPASS(dir_fab)
THEN LEAVE process ! Handle bypassable RMS errors
ELSE SIGNAL(.dir_fab[FAB$H_STS],! Some other type of RMS error
.dir_fab[FAB$H_STV],
dir_fab);
$TRACE('DIR$DO XABs filled in OK by $OPEN');
$CLOSE(FAB=dir_fab); ! Close the file now that XABs filled
IF NOT $RMS_STATUS_OK(dir_fab)
THEN SIGNAL(.dir_fab[FAB$H_STS],
.dir_fab[FAB$H_STV], dir_fab);
END;
DIR$BREAK_CHECK(); ! Print a break line if we need to
! Display the file attributes at the appropriate level
CASE .list_level FROM DIU$K_LIST_BRIEF TO DIU$K_LIST_FULL OF
SET
[DIU$K_LIST_BRIEF] : DIR$BRIEF();
[DIU$K_LIST_NORMAL] : DIR$NORMAL();
[DIU$K_LIST_FULL] : DIR$FULL();
[INRANGE,OUTRANGE] : RETURN(DIU$_INV_FUN_CODE);
TES;
END; ! End of process block
$SEARCH(FAB=dir_fab); ! Loop for each file please
S$BREATHE(); ! Take a hit of fresh air and sunshine
END; ! End of for all files loop
dir_fab[FAB$V_DRJ] = 0; ! Light "don't release JFN" bit
$CLOSE(FAB=dir_fab); ! Flush the link
DIR$TOTAL(); ! Output directory total
END;
%SBTTL 'DIU$DIRECTORY - execute DIRECTORY request'
GLOBAL ROUTINE DIU$DIRECTORY (request : REF $DIU_BLOCK) =
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
! Take a directory listing. Search the comma listed or wildcard source
! files given, calling DO$DIR for each file spec given.
!
! FORMAL PARAMETERS:
!
! request: Address of a DIU request block which contains files to list
!--
LOCAL eob,
src,
src_len,
remaining,
next_ptr,
dest,
dest_len,
status,
show_nam : $NAM_DECL,
show_fab : $FAB_DECL,
show_rab : $RAB_DECL,
show_rsa : VECTOR[CH$ALLOCATION(NAM$K_MAXRSS)],
current : $STR_DESCRIPTOR(CLASS=FIXED);
$TRACE(DIU$DIRECTORY);
IF .request[DIU$H_DESTINATION_FILESPEC] EQL 0
THEN SIGNAL(DIU$_BUG); ! Punt if no output filespec
! Save the directory listing level, init grand totals
list_level = .request[DIU$Z_LIST_LEVEL]; ! Copy list level from req blk
grand_files = 0; ! Grand total files
grand_dirs = 0; ! Grand total directories
grand_pages = 0; ! Grand total pages (20 only)
grand_blocks = 0; ! Grand total blocks (everything else)
nod_len = 0; ! Remembered node length
dev_len = 0; ! Remembered device length
dir_len = 0; ! Remembered directory length
! Get the output file pointed to for today please
dest = CH$FIND_CH(.request[DIU$H_DESTINATION_FILESPEC],
CH$PTR(request[DIU$T_DESTINATION_FILESPEC]),
$ETG);
dest_len = CH$A_RCHAR(dest);
dest = CH$PLUS(.dest,1);
CH$WCHAR(0,CH$PLUS(.dest,.dest_len));
$TRACE('DIU$DIRECTORY Initializing output RMS structures');
! Init the RMS blocks for the output file, create the output file
$FAB_INIT(FAB=show_fab, FNA=.dest, FAC=PUT, RFM=STM,
FOP=SUP, NAM=show_nam);
$NAM_INIT(NAM=show_nam, RSS=NAM$K_MAXRSS, RSA=CH$PTR(show_rsa));
$CREATE(FAB=show_fab,ERR=RMS$SIGNAL);
! Set up the $RAB for the file and connect it
$TRACE('DIU$DIRECTORY $CREATE went OK, connecting $RAB');
$RAB_INIT(RAB=show_rab,FAB=show_fab,ROP=WBH);
$CONNECT(RAB=show_rab,ERR=RMS$SIGNAL);
fao_rab = show_rab; ! Point fao to the show rab
fao_rab[RAB$A_RBF] = fao_buf; ! Point the RAB to the FAO buffer
$TRACE('DIU$DIRECTORY Output file setup OK');
! Find the first file in the source buffer, if empty send our regrets..
eob = CH$PLUS(CH$PTR(request[DIU$T_SOURCE_FILESPEC]),
.request[DIU$H_SOURCE_FILESPEC]);
src = CH$FIND_CH(.request[DIU$H_SOURCE_FILESPEC],
CH$PTR(request[DIU$T_SOURCE_FILESPEC]),
$ETG);
IF CH$FAIL(.src)
THEN SIGNAL(DIU$_INV_STR_LENGTH);
$TRACE('DIU$DIRECTORY Beginning processing of source file list');
DO BEGIN ! Start filespec processing loop
src_len = CH$A_RCHAR(src); ! Get length of filespec
src = CH$PLUS(.src,1); ! Point to the filespec
$STR_DESC_INIT(DESC=current, ! make fixed descriptor to that please
STRING=(.src_len,.src));
$TRACE_FAO('DIU$DIRECTORY Calling DIR$DO for !AS', current);
DIR$DO(current); ! Do the work on one source spec
$TRACE('DIU$DIRECTORY Checking for more files');
remaining = CH$DIFF(.eob,.src); ! Get remaining characters
src = CH$FIND_CH(.remaining,.src,$ETG); ! Find the next ETG byte
next_ptr = CH$PLUS(.src,1); ! Point to next file length
END UNTIL CH$RCHAR(.next_ptr) EQL $NUL; ! Exit if filespec length 0
DIR$GRAND_TOTAL(); ! Write grand totals
$CLOSE(FAB=show_fab,ERR=RMS$SIGNAL); ! Close output file
! Tell me what you wrote out and return
$MSG_FAO(' Directory listing written to !AD',
.show_nam[NAM$H_RSL],.show_nam[NAM$A_RSA]);
RETURN DIU$_NORMAL;
END; ! DIU$DIRECTORY
END
ELUDOM