From:	SMTP%"MACRO32%WKUVX1.BITNET@uu7.psi.com" 20-JUL-1993 09:16:50.99
To:	EVERHART
CC:	
Subj:	Re: File utility to see below 8 levels?

Message-Id: <9307200823.AA08864@uu7.psi.com>
X-Listname: "VMS Internals, MACRO, & BLISS Discussions" <MACRO32@WKUVX1.BITNET>
Warnings-To: <>
Errors-To: MacroMan%WKUVX1.BITNET@uu7.psi.com
Sender: MacroMan%WKUVX1.BITNET@uu7.psi.com
Date: Tue, 20 Jul 1993 09:44:40 +0200
From: "GWDGV1::MOELLER" <moeller@gwdgv1.dnet.gwdg.de>
Reply-To: MACRO32%WKUVX1.BITNET@uu7.psi.com
To: MACRO32@WKUVX1.BITNET
Subject: Re: File utility to see below 8 levels?

Around the end of June, this subject was heavily discussed, but
apparently no-one came up with a real program. The following
old program of mine (MACRO main program, followed by an example
output formatting subroutine written in FORTRAN) does recursive
subdirectory traversal at ACP level, and therefore has no trouble
finding arbitrarily deeply nested directories.
Actually, it wasn't written with the intent to go deeper than 8 levels,
but it'll do anyway. Note that the program has statically allocated
1024 bytes for the directory strings ...

Wolfgang J. Moeller, GWDG, D-37018 Goettingen, F.R.Germany | Disclaimer ...
PSI%(0262)45050352008::MOELLER       Phone: +49 551 201516 | No claim intended!
Internet: moeller@gwdgv1.dnet.gwdg.de    | This space intentionally left blank.

----- cut here ----------------------------------------------------------------
        .title  DDD_def expiration dates & blocks by directories
;
;       mod 18-aug-1989 wjm: don't stop on dangling directory entry
;
;       start at current default directory (assumed nonempty)
;       output file is generated by external (fortran) DDOUT routine
;
;
;*****
;
        .library        /sys$library:lib/
        $fibdef
        $atrdef
        $fatdef
        $fchdef
;
        .psect  data,noexe,quad
        .psect  pdata,nowrt,noexe,quad
        .psect  code,nowrt
;
.macro chkr0   ?end
        blbs    r0,end
        pushl   r0
        calls   #1,g^lib$stop
end:
.endm  chkr0
;
;
;*****  data
;
        .psect  pdata
;
;
        .psect  data
;
nam:    $nam    esa=exfile,ess=nam$c_maxrss,-
                rsa=rsfile,rss=nam$c_maxrss
fab:    $fab    nam=nam,-
                fnm=<*.*>
;
dirline:        .blkb   1024    ; overflow *not* checked - beware
;
dirldsc:        .blkl
                .address        dirline
;
dirlpt:         .blkl
;
cnt0:   .long   0               ;note: true values obtained ...
nfil0:  .long   0               ; ... when searching [000000]
edt0:   .quad   0
;
chan:   .blkw
;
exfile: .blkb   nam$c_maxrss
rsfile: .blkb   nam$c_maxrss
;
;
;*****  main program
;
        .psect  code
;
        .entry  BEGIN,^m<>
;
        $parse  fab=fab
        chkr0
        $search fab=fab
        chkr0
;
        movab   nam+nam$t_dvi,r0
        movzbl  (r0)+,r1
        pushl   r0
        pushl   r1
        movl    sp,r1
        $assign_s       devnam=(r1),chan=chan
        chkr0
        addl    #2*4,sp
;
        subl3   nam+nam$l_dir,nam+nam$l_name,r1
        movc3   r1,@nam+nam$l_dir,dirline
                        ;r3 points beyond destination
        movl    r3,dirlpt
        movb    #^a/./,-(r3)
;
        pushaq  edt0
        pushal  cnt0
        pushal  nfil0
        pushaw  nam+nam$w_did
        calls   #4,DDD
        ret
;
;
;*****  recursive routine DDD(did,nfil,cnt,edt)
;       input:  did  - file id of dir to be searched
;       in/out: nfil - # files (incl. directory)
;               cnt  - # blocks allocated to files (incl. directory)
;               edt  - quadword expiration date (maximum over files)
;
;
arg_did=1*4
arg_nfil=2*4
arg_cnt=3*4
arg_edt=4*4
;
        .psect  wk,abs
.=0
wk_fib:         .blkb   fib$c_length
wk_fibdsc:      .blkq
wk_atr:         .blkl   3*2+1                   ;uchar, recattr, expdate
wk_uchar:       .blkl
wk_recattr:     .blkb   fat$c_length
wk_expdate:     .blkq
wk_rsn:         .blkb   256
wk_rsl:         .blkw
wk_iosb:        .blkw   4
wk_rsndsc:      .blkq
wk_savdirp:     .blkl
wk_subedt:      .blkq
wk_subcnt:      .blkl
wk_subnfil:     .blkl
wk_length=.
;
;
        .psect  data
;
dirwilddsc:     .ascid  /*.DIR;1/       ;"must be read/write"
filwilddsc:     .ascid  /*.*;*/         ;"must be read/write"
;
;
        .psect  code
;
        .entry  DDD,^m<r2,r3,r4,r5,r6>
;
        subl    #wk_length,sp
        movl    sp,r6
;
        movc5   #0,(sp),#0,#fib$c_length,wk_fib(r6)
        movc3   #6,@arg_did(ap),wk_fib+fib$w_did(r6)
;
        movl    #fib$c_length,wk_fibdsc(r6)
        movab   wk_fib(r6),wk_fibdsc+4(r6)
;
        movl    #256,wk_rsndsc(r6)
        movab   wk_rsn(r6),wk_rsndsc+4(r6)
;
        movl    dirlpt,wk_savdirp(r6)           ;->place to add "]" or ".subdir"
;
        movab   wk_atr(r6),r5
        movw    #4,(r5)+
        movw    #atr$c_uchar,(r5)+
        moval   wk_uchar(r6),(r5)+
        movw    #fat$c_length,(r5)+
        movw    #atr$c_recattr,(r5)+
        movab   wk_recattr(r6),(r5)+
        movw    #8,(r5)+
        movw    #atr$c_expdate,(r5)+
        movaq   wk_expdate(r6),(r5)+
        clrl    (r5)+                           ;atr list set up
;
;
;*****  search for subdirectories
;
        bisw    #fib$m_wild,wk_fib+fib$w_nmctl(r6)
        clrw    wk_rsl(r6)
;
        clrw    wk_fib+fib$w_fid_num(r6)
        clrb    wk_fib+fib$b_fid_nmx(r6)
        clrl    wk_fib+fib$l_wcc(r6)
;
ddd_dirloop:
        movaq   dirwilddsc,r1
        movaw   wk_rsl(r6),r2
        movaq   wk_rsndsc(r6),r3
        moval   wk_atr(r6),r4
        $qiow_s chan=chan,-
                func=#io$_access,-
                iosb=wk_iosb(r6),-
                p1=wk_fibdsc(r6),-
                p2=r1,p3=r2,p4=r3,p5=r4
        chkr0
        movzwl  wk_iosb(r6),r0
        blbs    r0,11$
        cmpw    #ss$_nosuchfile,r0
        bneq    8$
        tstw    wk_fib+fib$w_fid_num(r6)        ;ignore dangling dir entry
        bneq    7$
        tstb    wk_fib+fib$b_fid_nmx(r6)
        beql    9$
7$:     brw     ddd_dirloop
8$:
        cmpw    #ss$_nomorefiles,r0
        bneq    10$
9$:     brw     99$                     ;br if no subdirectories
10$:
        chkr0
11$:                                    ;subdirectory candidate
        bitl    #fch$m_directory,wk_uchar(r6)
        beql    7$                      ;not a subdirectory
                                        ;subdirectory found
        movl    #1,wk_subnfil(r6)
                                        ;account for size of .DIR file
        rotl    #16,wk_recattr+fat$l_hiblk(r6),-
                wk_subcnt(r6)
                                        ;ignore date of directory
        clrq    wk_subedt(r6)
                                        ;check for [000000]000000
        cmpc3   #6,wk_fib+fib$w_fid(r6),-
                wk_fib+fib$w_did(r6)
        beql    30$                     ;br if directory contained w/i itself
12$:
                                        ;update directory string
        movl    wk_savdirp(r6),r2
        movzwl  wk_rsl(r6),r0
        beql    23$
        movab   wk_rsn(r6),r1
21$:
        movb    (r1)+,r3
        cmpb    r3,#^a/./
        beql    23$
        movb    r3,(r2)+
        sobgtr  r0,21$
23$:    movb    #^a/./,(r2)+
        movl    r2,dirlpt
                                        ;recursive call
        pushaq  wk_subedt(r6)
        pushal  wk_subcnt(r6)
        pushal  wk_subnfil(r6)
        pushaw  wk_fib+fib$w_fid(r6)
        calls   #4,DDD
        chkr0
30$:
                                        ;update # files
        addl    wk_subnfil(r6),@arg_nfil(ap)
                                        ;update count
        addl    wk_subcnt(r6),@arg_cnt(ap)
                                        ;update edt
        movaq   wk_subedt(r6),r0
        movaq   @arg_edt(ap),r1
        jsb     max_date_r1
                                        ;done with directory
        brw     ddd_dirloop
;
99$:
;
;
;*****  search for non-directory files
;
        clrw    wk_rsl(r6)
;
        clrw    wk_fib+fib$w_fid_num(r6)
        clrb    wk_fib+fib$b_fid_nmx(r6)
        clrl    wk_fib+fib$l_wcc(r6)
;
ddd_filloop:
        movaq   filwilddsc,r1
        movaw   wk_rsl(r6),r2
        movaq   wk_rsndsc(r6),r3
        moval   wk_atr(r6),r4
        $qiow_s chan=chan,-
                func=#io$_access,-
                iosb=wk_iosb(r6),-
                p1=wk_fibdsc(r6),-
                p2=r1,p3=r2,p4=r3,p5=r4
        chkr0
        movzwl  wk_iosb(r6),r0
        blbs    r0,11$
        cmpw    #ss$_nosuchfile,r0
        bneq    8$
        tstw    wk_fib+fib$w_fid_num(r6)        ;ignore dangling dir entry
        bneq    7$
        tstb    wk_fib+fib$b_fid_nmx(r6)
        beql    9$
7$:     brw     ddd_filloop
8$:
        cmpw    #ss$_nomorefiles,r0
        bneq    10$
9$:     brw     99$                     ;br if done
10$:
        chkr0
11$:                                    ;test for directory
        bitl    #fch$m_directory,wk_uchar(r6)
        bneq    7$                      ;ignore subdirectory here
                                        ;file found
        incl    @arg_nfil(ap)
                                        ;account for size
        rotl    #16,wk_recattr+fat$l_hiblk(r6),r0
        addl    r0,@arg_cnt(ap)
                                        ;account for date
        movaq   wk_expdate(r6),r0
        movaq   @arg_edt(ap),r1
        jsb     max_date_r1
                                        ;done with file
        brw     ddd_filloop
;
99$:
;
;
;*****  output
;
ddd_output:
        movl    wk_savdirp(r6),r3
        movb    -(r3),-(sp)
12$:
        movb    #^a/]/,(r3)+            ;overwrite "." by "]"
        subl3   dirldsc+4,r3,dirldsc
;
        pushal  @arg_nfil(ap)           ; call ddout(dirnam,edt,cnt,nfil)
        pushal  @arg_cnt(ap)
        pushal  @arg_edt(ap)
        pushaq  dirldsc
        calls   #4,g^DDOUT
        chkr0
;
        movl    wk_savdirp(r6),r3       ;restore "."
        movb    (sp)+,-(r3)
;
;
;*****  clean up
;
        movl    wk_savdirp(r6),dirlpt
;
        movl    #1,r0
        ret
;
;
;*****  "maximize date" subroutine (jsb)
;       r0 -> new date, r1 -> date to be updated
;
max_date_r1:
        cmpl    4(r0),4(r1)
        blss    9$
        bgtr    5$
        cmpl    (r0),(r1)
        blequ   9$
5$:     movq    (r0),(r1)
9$:     rsb
;
;
        .end    begin
----- cut here ----------------------------------------------------------------
c       output formatting for "DDD" program
c       writes on fortran unit 6 (FOR006)
c       self-initializing (non reusable)
c
c       output format:  yyyy-mm-dd bbbbbbb nnnnn [dir...]
c                       {a10     }{i8    }{i6  }x{a ... }
c
c
        integer function ddout(dirnam,edt,cnt,nfil)     ! = status
        character*(*) dirnam    ! in
        integer edt(2),cnt,nfil ! in
c
        logical notinit/.true./
        character aedt*11
        character*3 amon(12)/
     1          'JAN','FEB','MAR','APR','MAY','JUN',
     2          'JUL','AUG','SEP','OCT','NOV','DEC'/
        integer imon
c
c
c*****
c
        if(notinit) then
                notinit=.false.
                open(unit=6,status='new',carriagecontrol='list',
     1                  recl=256)
        endif
c
        call sys$asctim(,aedt,edt,)
        do imon=1,12
                if(aedt(4:6).eq.amon(imon)) goto 22
        enddo
        stop 'month=???'        ! should not get here
c
22      continue
        if(aedt(1:1).eq.' ') aedt(1:1)='0'
        write(6,12) aedt(8:11),imon,aedt(1:2),cnt,nfil,dirnam
12      format(a4,'-',i2.2,'-',a2,i8,i6,1x,a)
c
        ddout=1
        return
        end
----- cut here ----------------------------------------------------------------

Wolfgang J. Moeller, GWDG, D-37018 Goettingen, F.R.Germany | Disclaimer ...
PSI%(0262)45050352008::MOELLER       Phone: +49 551 201516 | No claim intended!
Internet: moeller@gwdgv1.dnet.gwdg.de    | This space intentionally left blank.
