$	save_ver = 'f$verify(0)'
$	on warning   then goto LEAVE
$	on control_y then goto LEAVE
$!
$!		---- this command procedures emulates both the 'df' and 'du' unix programs
$!		---- the symbols for invoking it should be
$!		----         $ DF :== @NCOM:SHOW_FREE.COM #
$!		----         $ DU :== @NCOM:SHOW_FREE.COM # /DU
$!
$!	You can show the free space
$!		a) on all disks by sending no parameters
$!			eg., $ FREE
$!		b) on specific disks by sending a list of disks as P1
$!			eg., $ FREE DISK1,DISK2,DISK3
$!
$	ws := write sys$output
$	p1 = p1 - "#"
$	quals = ""
$	if f$extract(0, 1, p1) .eqs. "/" then quals = quals + p1
$	if f$extract(0, 1, p2) .eqs. "/" then quals = quals + p2
$	if f$extract(0, 1, p3) .eqs. "/" then quals = quals + p3
$	if f$extract(0, 1, p4) .eqs. "/" then quals = quals + p4
$	if f$extract(0, 1, p5) .eqs. "/" then quals = quals + p5
$	if f$extract(0, 1, p6) .eqs. "/" then quals = quals + p6
$	if f$extract(0, 1, p7) .eqs. "/" then quals = quals + p7
$	if f$extract(0, 1, p8) .eqs. "/" then quals = quals + p8
$	if f$extract(0, 1, p1) .eqs. "/" then p1 = ""
$	if f$extract(0, 1, p2) .eqs. "/" then p2 = ""
$	if f$extract(0, 1, p3) .eqs. "/" then p3 = ""
$	if f$extract(0, 1, p4) .eqs. "/" then p4 = ""
$	if f$extract(0, 1, p5) .eqs. "/" then p5 = ""
$	if f$extract(0, 1, p6) .eqs. "/" then p6 = ""
$	if f$extract(0, 1, p7) .eqs. "/" then p7 = ""
$	if f$extract(0, 1, p8) .eqs. "/" then p8 = ""
$	param = p1 + p2 + p3 + p4 + p5 + p6 + p7 + p8
$	param = f$edit(param, "UPCASE")
$	quals = f$edit(quals, "UPCASE")
$!
$ INIT:
$	totmax    = 0
$	totfree   = 0
$	totused   = 0
$	totdiv    = 0
$	totmod    = 0
$	totops    = 0
$	toterr    = 0
$	index     = 0
$	delimiter = ","
$	sysdisk   = f$getdvi("SYS$SYSDEVICE:", "FULLDEVNAM")
$	whereami  = f$getdvi(f$environment("DEFAULT"), "FULLDEVNAM")
$	use_bound_name = 1
$	graph_used = 1
$!
$	show_all     = f$locate("/ALL",  quals) .lt. f$length(quals)
$	show_kils    = f$locate("/KIL",  quals) .lt. f$length(quals)
$	show_megs    = f$locate("/MEG",  quals) .lt. f$length(quals)
$	show_gigs    = f$locate("/GIG",  quals) .lt. f$length(quals)
$	show_opcnt   = f$locate("/OP",   quals) .lt. f$length(quals)
$	show_errs    = f$locate("/ERR",  quals) .lt. f$length(quals)
$	show_label   = f$locate("/VOL",  quals) .lt. f$length(quals)
$	show_grand   = f$locate("/GRAN", quals) .lt. f$length(quals)
$	show_graph   = f$locate("/GRAP", quals) .lt. f$length(quals)
$	show_rems    = f$locate("/REM",  quals) .lt. f$length(quals)
$	show_members = f$locate("/MEM",  quals) .lt. f$length(quals)
$	show_blocks  = f$locate("/BL",   quals) .lt. f$length(quals)
$	show_default = f$locate("/DEF",  quals) .lt. f$length(quals)
$	if (.not. show_blocks) .and. (.not. show_kils) .and. (.not. show_gigs)
$	then
$		show_megs = 1
$	endif
$	if show_graph
$	then
$		where = f$locate("/GRAP", quals)
$		foo1  = f$extract(where + 1, 99, quals)      ! now looks like GRAPH or GRAPH=FREE or GRAPH/MEMBERS
$		where = f$locate("/", foo1)
$		if where .lt. f$length(foo1)
$		then
$			foo1 = f$extract(0, where, foo1)
$		endif
$		where = f$locate("=", foo1)
$		if where .lt. f$length(foo1)
$		then
$			foo1 = f$extract(where + 1, 99, foo1)
$			if foo1 .eqs. f$extract(0, f$length(foo1), "FREE")
$			then
$				graph_used = 0
$			endif
$		endif
$	endif
$!
$	if f$locate("/DU",  quals) .lt. f$length(quals) then goto DUINIT
$!
$	show_label = 1      ! because i like it
$!
$	disk_list = param
$	if disk_list .eqs. "*" then disk_list = ""
$	if disk_list .eqs. "." then disk_list = "SYS$DISK:"
$	if disk_list .eqs. ""
$	then
$		canscan = 0
$		set noon
$		define /user sys$error nl:
$		define /user sys$output nl:
$		if f$device() then index = 0
$		if $status then canscan = 1
$		deassign /user sys$error
$		deassign /user sys$output
$		set on
$		if .not. canscan
$		then
$			@ncom:get_disks foobar
$			disk_list = foobar
$			delete /symbol /global foobar
$		endif
$	endif
$	gosub WRITE_HEADER
$	gosub WRITE_DASHES
$!
$ SHOW_LOOP:
$	fdfd_reason == ""
$	if disk_list .eqs. ""
$	then
$		curdisk = f$device(, "DISK")
$	else
$		curdisk = f$element(index, delimiter, disk_list)
$	endif
$	if curdisk .eqs. delimiter .or. curdisk .eqs. ""
$	then
$		delete /symbol /global fdfd_reason
$		curdisk = ""
$		gosub SHOW_TOTALS
$		goto LEAVE
$	endif
$	index = index + 1
$	@ncom:test_disk 'curdisk' "" fdfd_reason
$	if fdfd_reason .eqs. "" .and. f$getdvi(curdisk, "SHDW_MEMBER")
$	then
$		fdfd_reason == "shadow member"
$	endif
$	if fdfd_reason .eqs. ""
$	then
$		vols = 0
$		namebuf = f$getdvi(curdisk, "FULLDEVNAM")
$		namelen = 20 - f$length(namebuf)
$		secretname = "K8_" + namebuf - ":"
$		if f$type('secretname') .eqs. ""
$		then
$			'secretname' = 1
$			gosub ZERO_OUT
$			if f$getdvi(curdisk, "VOLSETMEM")
$			then
$				vols = f$getdvi(curdisk, "VOLCOUNT")
$				namebuf = f$getdvi(curdisk, "LOGVOLNAM")
$				namebuf = f$fao("(bound set of !SL)", vols)
$				namelen = 20 - f$length(namebuf)
$				curvolname = f$getdvi(curdisk, "ROOTDEVNAM")
$				volnum = 1
$ VOLLOOP:
$				datasrc = curvolname
$				gosub OBTAIN_DATA
$				secretname = "K8_" + f$getdvi(datasrc, "FULLDEVNAM") - ":"
$				'secretname' = 1
$				if volnum .lt. vols
$				then
$					volnum = volnum + 1
$					curvolname = f$getdvi(curvolname, "NEXTDEVNAM")
$					goto VOLLOOP
$				endif
$			else
$				datasrc = curdisk
$				gosub OBTAIN_DATA
$			endif
$			gosub CALC_PERCENTAGE
$			gosub UPDATE_TOTALS
$			if .not. show_grand then gosub WRITE_LINE
$		endif
$		if show_members .and. vols .ge. 1
$		then
$			gosub SHOW_BOUND_PARTS
$		endif
$	else
$		if show_all
$		then
$			namebuf = curdisk
$			namelen = 20 - f$length(namebuf)
$			ws f$fao("!#AS!AS!#AS!AS", namelen, " ", namebuf, 78, " ", fdfd_reason)
$		endif
$	endif
$	goto SHOW_LOOP
$!
$ ZERO_OUT:
$	curmax    = 0
$	curused   = 0
$	curfree   = 0
$	curdiv    = 0
$	curmod    = 0
$	curopcnt  = 0
$	curerrcnt = 0
$	return
$!
$ OBTAIN_DATA:
$	tmpmax = f$getdvi(datasrc, "MAXBLOCK")
$	if tmpmax .gt. 0
$	then
$		curmax    = curmax    + tmpmax
$		curfree   = curfree   + f$getdvi(datasrc, "FREEBLOCKS")
$		curopcnt  = curopcnt  + f$getdvi(datasrc, "OPCNT")
$		curerrcnt = curerrcnt + f$getdvi(datasrc, "ERRCNT")
$		curused   = curmax - curfree
$	endif
$	return
$!
$ CALC_PERCENTAGE:
$	curdiv = 0
$	curmod = 0
$	if curmax .eq. 0 then return
$	if curmax .gt. 1000000
$	then
$		if curfree .lt. 1000
$		then
$			free_percent = 0
$		else
$			tmpmax  = curmax  / 1000
$			tmpfree = curfree / 1000
$			free_percent = tmpfree * 1000 / (tmpmax / 10)
$		endif
$	else
$		free_percent = curfree * 1000 / (curmax / 10)
$	endif
$	curdiv = free_percent / 100
$	curmod = free_percent - curdiv*100
$	return
$!
$ UPDATE_TOTALS:
$	totmax  = totmax  + curmax
$	totfree = totfree + curfree
$	totused = totused + curused
$	totdiv  = totdiv  + curdiv
$	totmod  = totmod  + curmod
$	totops  = totops  + curopcnt
$	toterr  = toterr  + curerrcnt
$	return
$!
$ WRITE_HEADER:
$	units = "Blocks"
$	if show_kils then units = "     K"
$	if show_megs then units = "  Megs"
$	if show_gigs then units = "  Gigs"
$	line1 = "                        ''units'    ''units'    ''units'  Percent"
$	if show_opcnt then line1 = line1 + "            "
$	if show_errs  then line1 = line1 + "            "
$	if show_label then line1 = line1 + "              "
$	if show_graph .and.       graph_used then line1 = line1 + "  Percentage of disk space used"
$	if show_graph .and. .not. graph_used then line1 = line1 + "  Percentage of disk space available"
$	if show_rems  then line1 = line1 + "            "
$	line2 = "                Disk     Total      Used      Free     Free"
$	if show_opcnt then line2 = line2 + "  Operations"
$	if show_errs  then line2 = line2 + "  Errors    "
$	if show_label then line2 = line2 + "  Volume      "
$	if show_graph then line2 = line2 + "  0...10...20...30...40...50...60...70...80...90..100"
$	if show_rems  then line2 = line2 + "  Remarks   "
$	ws line1
$	ws line2
$	return
$!
$ WRITE_DASHES:
$	line3 = "      --------------   -------   -------   -------  -------"
$	if show_opcnt then line3 = line3 + "  ----------"
$	if show_errs  then line3 = line3 + "  ------"
$	if show_label then line3 = line3 + "  ------------"
$	if show_graph then line3 = line3 + "  --------------------------------------------------"
$	if show_rems  then line3 = line3 + "  ----------------"
$	ws line3
$	return
$!
$ WRITE_LINE:
$	nBlocks = curmax
$	gosub SCALE
$	curmax = result
$	nBlocks = curfree
$	gosub SCALE
$	curfree = result
$	nBlocks = curused
$	gosub SCALE
$	curused = result
$	special  = ""
$	volnam   = ""
$	volflag  = " "
$	shadowdisk = 0
$	if curdisk .nes. ""
$	then
$		volnam = f$getdvi(curdisk, "VOLNAM")
$		if f$getdvi(curdisk, "VOLSETMEM")
$		then
$			if use_bound_name
$			then
$				volnam = f$getdvi(curdisk, "LOGVOLNAM")
$			else
$				volflag = "+"
$			endif
$		endif
$		shadowdisk = f$getdvi(curdisk, "SHDW_MEMBER")
$		if namebuf .eqs. sysdisk     then special = special + " system"
$		if f$getdvi(curdisk, "SWL")  then special = special + " readonly"
$		if show_all .and. shadowdisk then special = special + " shadow"
$	endif
$	if show_graph
$	then
$		if graph_used
$		then
$			hashes = (100 - curdiv) / 2
$		else
$			hashes =        curdiv  / 2
$		endif
$		spaces = 50 - hashes
$		if f$getdvi("SYS$OUTPUT", "TT_DECCRT")
$		then
$			graphon   = esc + "(0"
$			graphoff  = esc + "(B"
$			graphmark = "a"
$		else
$			graphon   = ""
$			graphoff  = ""
$			graphmark = "#"
$		endif
$	endif
$	if show_all .or. .not. shadowdisk
$	then
$		defdisk = " "
$		if show_default .and. namebuf .eqs. whereami then defdisk = ">"
$		line0 = f$fao("!AS!#AS!AS !9SL !9SL !9SL  !3SL.!2ZL%", defdisk, namelen - 1, " ", namebuf, curmax, curused, curfree, curdiv, curmod)
$		if show_opcnt then line0 = line0 + f$fao("!10SL", curopcnt)
$		if show_errs  then line0 = line0 + f$fao("!8SL",  curerrcnt)
$		if show_label then line0 = line0 + f$fao(" !AS!12AS", volflag, volnam)
$		if show_rems  then line0 = line0 + f$fao("    !AS",  special)
$		if show_graph then line0 = line0 + f$fao("  " + graphon + "!" + f$string(hashes) + "*" + graphmark + graphoff)
$		ws line0
$	endif
$	return
$!
$ SHOW_TOTALS:
$	if .not. show_grand then gosub WRITE_DASHES
$	namelen = 14
$	namebuf = "Totals"
$	curmax     = totmax
$	curfree    = totfree
$	curused    = totused
$	curopcnt   = totops
$	curerrcnt  = toterr
$	gosub CALC_PERCENTAGE
$	gosub WRITE_LINE
$	return
$!
$ SHOW_BOUND_PARTS:
$	use_bound_name = 0
$	volnum = 1
$	savedisk = curdisk
$	curvolname = f$getdvi(curdisk, "ROOTDEVNAM")
$ VOL2LOOP:
$	gosub ZERO_OUT
$	namebuf = f$getdvi(curvolname, "FULLDEVNAM")
$	namelen = 20 - f$length(namebuf)
$	curdisk = namebuf
$	datasrc = namebuf
$	gosub OBTAIN_DATA
$	gosub CALC_PERCENTAGE
$	if .not. show_grand then gosub WRITE_LINE
$	if volnum .lt. vols
$	then
$		volnum = volnum + 1
$		curvolname = f$getdvi(curvolname, "NEXTDEVNAM")
$		goto VOL2LOOP
$	endif
$	curdisk = savedisk
$	use_bound_name = 1
$	return 1
$!
$ LEAVE:
$	exit 1 + 0 * f$verify(save_ver)

                          Megs      Megs      Megs  Percent
                Disk     Total      Used      Free     Free  Volume
      --------------   -------   -------   -------  -------  ------------
     _ENG108$DKC300:      1001       930        70    7.02%  ALPHANDSS
       _ENG108$DKD0:      2007       783      1223   60.97%  DATA
    (bound set of 3)      6021      2907      3114   51.71%  PROJDISK
     _ENG108$DKD200:      1001       324       676   67.60%  DISK
>    _ENG108$DKD500:      4091      2819      1272   31.08%  USERDISK
      --------------   -------   -------   -------  -------  ------------
              Totals     14122      7764      6358   45.02%


                         Total                       Percentage
                Disk    Blocks      Used      Free    Available  Errors  Remarks
      --------------   -------   -------   -------   ----------  ------  ----------------
     _CONNOR$DKA200:    410200    355489     54711       13.33%       2  readonly
     _CONNOR$DKA300:   2050860   1787967    262893       12.78%       1
     _CONNOR$DKA400:   2050860   1029856   1021004       49.80%       2
     _CONNOR$DKA600:   2050860   1732284    318576       15.51%       1  system
      --------------   -------   -------   -------   ----------  ------
              Totals   6562780   4905596   1657184       25.25%       6

$!
$ SCALE:
$	if show_kils .or. show_megs .or. show_gigs
$	then
$!		---- convert "blocks" (512 bytes) into "kils" (1024 bytes)
$		result = nBlocks / 2
$		if show_megs .or. show_gigs
$		then
$			result = result / 1024
$			if show_gigs
$			then
$				result = (result + 64) / 1024
$			endif
$		endif
$	else
$		result = nBlocks
$	endif
$	return 1
$!
$ DUINIT:
$	curdepth = 0
$	maxdepth = 0
$	if f$locate("/USED", quals) .lt. f$length(quals)
$	then
$		whichsize = "used"
$	else
$		whichsize = "allocation"
$	endif
$	if f$locate("/DEPTH", quals) .lt. f$length(quals)
$	then
$		where = f$locate("/DEPTH", quals)
$		foo1  = f$extract(where + 1, 99, quals)      ! now looks like GRAPH or GRAPH=FREE or GRAPH/MEMBERS
$		where = f$locate("/", foo1)
$		if where .lt. f$length(foo1)
$		then
$			foo1 = f$extract(0, where, foo1)
$		endif
$		where = f$locate("=", foo1)
$		if where .lt. f$length(foo1)
$		then
$			maxdepth = f$integer(f$extract(where + 1, 99, foo1))
$			! ws "looks like maxdepth will be ''maxdepth'!"
$		endif
$	endif
$	if param .eqs. ""
$	then
$		param = f$environment("DEFAULT")
$	endif
$	tmpfs = "SYS$LOGIN:__DU_" + f$getjpi("", "PID") + ".TMP"
$	units = "   Blocks"
$	if show_kils then units = "        K"
$	if show_megs then units = "     Megs"
$	if show_gigs then units = "     Gigs"
$	ws units + " Path"
$	ws "--------- -------------------------------"
$	call DUSUBDIRS 'param'
$	goto LEAVE
$!
$ DUSUBDIRS:
$	subroutine
$	curdepth = curdepth + 1
$	save_path = f$environment("DEFAULT")
$	set default 'p1'
$	! ws "curdepth=''curdepth' maxdepth=''maxdepth' looking at ''p1'"
$ DULOOP:
$	if maxdepth .eq. 0 .or. curdepth .lt. maxdepth
$	then
$		nextdir = f$search("*.DIR", curdepth)
$		if nextdir .nes. ""
$		then
$			newname = f$parse(nextdir,,,"NAME")
$			if newname .nes. "000000"
$			then
$				newpath = "[." + newname + "]"
$				call DUSUBDIRS 'newpath'
$			endif
$			goto DULOOP
$		endif
$	endif
$	call DUCURTREE
$	set default 'save_path'
$	exit 1
$	endsubroutine
$!
$ DUCURTREE:
$	subroutine
$!		---- i let the DIRECTORY command determine the actual numbers for us;
$!		---- while parsing the output of a program is never desirable,
$!		---- the alternative of calling f$search() directly a billion times
$!		---- not only consumes triple the CPU time (yes, i measured)
$!		---- but causes the inevitable
$!		----         %SYSTEM-W-ACCONFLICT, file access conflict
$!		---- signals.  admittedly i do need a single f$search() to avoid the
$!		----         %DIRECT-W-NOFILES, no files found
$!		---- signal.
$	if f$search("[...]*.*;*", 99) .eqs. ""
$	then
$		result = 0
$	else
$		directory__ /grand_total /size='whichsize' /output='tmpfs' [...]
$		durecord = ""
$		open /read /error=OUCH2 duchan 'tmpfs'
$		read /error=OUCH1 duchan durecord
$		read /error=OUCH1 duchan durecord
$ OUCH1:
$		close duchan
$ OUCH2:
$		delete /nolog 'tmpfs';*
$		nBlocks = f$integer(f$element(7, " ", durecord))       ! "Grand total of 1 directory, 20 files, 141 blocks."
$		gosub SCALE
$	endif
$	ws f$fao("!9SL !AS", result, f$parse(f$environment("DEFAULT"),,,"DIRECTORY"))
$	exit 1
$!
$ SCALE:
$	if show_kils .or. show_megs .or. show_gigs
$	then
$!		---- convert "blocks" (512 bytes) into "kils" (1024 bytes)
$		result = nBlocks / 2
$		if show_megs .or. show_gigs
$		then
$			result = result / 1024
$			if show_gigs
$			then
$				result = (result + 64) / 1024
$			endif
$		endif
$	else
$		result = nBlocks
$	endif
$	return 1
$!
$	endsubroutine