From: GWDVMS::MOELLER [moeller@gwdvms.dnet.gwdg.de]
Sent: Wednesday, July 28, 1999 6:45 PM
To: Info-VAX@Mvb.Saic.Com
Subject: FRAGC.C (was re: Unsupported VMS "commands")

Due to popular demand ... here's my re-write of M. Levine's FRAG.MAR .

Wolfgang J. Moeller, Tel. +49 551 2011516 or -510, moeller@gwdvms.dnet.gwdg.de
GWDG, D-37077 Goettingen, F.R.Germany   |       Disclaimer: No claim intended!
<moeller@decus.decus.de>  ----- <moeller@gwdg.de>  -----  <w.moeller@ieee.org>

$! ................... Cut between dotted lines and save. ...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user MOELLER
$! on 29-JUL-1999 00:27:56.63.
$!
$! It contains the following 7 files:
$!        FEHLER.MAR
$!        FIBDEF.H
$!        FIDDEF.H
$!        FRAGC-MAKE.COM
$!        FRAGC.C
$!        REDIRECT.C
$!        VAXC.OPT
$!
$!============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ if f$getsyi("cpu").gt.127 then goto version_ok
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$VERSION_OK:
$ GOTO START
$!
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors 
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN 
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail 
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK
( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip 
<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF
; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip 
:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip 
<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET )
; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) 
); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line 
<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors 
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL
( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH
( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 
); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP
; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
( "The following !UL errors were detected while unpacking !AS", i_errors
, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" )
; ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed." )
$ RETURN
$!
$START: 
$ FILE_IS = "FEHLER.MAR"
$ CHECKSUM_IS = 87885753
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`009.title`009FEHLER`009abort a program with message & status
X;
X;`009w.j.m. ??? (FORTRAN version)
X;`009change apr 85: do not rely on own msg definition,
X;`009`009`009use "shared" msg instead.
X;`009`009`009disadvantage: unwinding become unwieldy,
X;`009`009`009`009message is output in any case
X;
X;`009entry:`009FEHLER(string)
X;
X;
X;`009note: this program had to written in MACRO to allow
X;`009`009access to the address of the stringdescriptor
X;`009`009passed by the calling routine!
X;`009      the FORTRAN program included does not work since
X;`009      literal strings are passed to it without descriptor!!
X;
X;
X;*****
X;
X`009.psect`009$LOCAL,pic,usr,con,rel,lcl,noshr,noexe,rd,wrt,novec
X;
Xfehler_name:`009.ascid`009"FEHLER"`009;.ADDRESS is not (PIC,SHR) !!
X;
X;
X`009.psect`009$CODE,pic,usr,con,rel,lcl,shr,exe,rd,nowrt,novec
X;
X`009.entry`009fehler,`094m<>
X;
X;=`009`009subroutine fehler(strdsc)
X;=`009`009implicit none
X;=`009`009integer*4 strdsc(2)`009! actual argument is character*(*) !
X;=`009c
X;=`009`009integer*4 msgvec(4)
X;=`009`009external shr$_text
X;=`009c
X;
Xmsgvec=-<4*4>`009;(fp)
X;
X`009moval`009msgvec(fp),sp
X;
X;=`009c
X;=`009`009msgvec(1)=3
X;=`009`009msgvec(2)=(%loc(shr$_text).and.'0000fff8'x) + 4 + '08000000'x
X;=`009c`009`009! # force fatal status
X;=`009c`009`009! # fake (user) facility other than "ss$_"
X;=`009c`009`009!   to allow for $fao argument
X;=`009`009msgvec(3)=1`009`009`009! # fao
X;=`009`009msgvec(4)=%loc(strdsc)`009`009! need %loc of descriptor here
X;
X`009movl`009#3,msgvec(fp)
X`009movl`009#<<shr$_text&`094x0000fff8>!`094x08000004>,msgvec+<1*4>(fp)
X`009movl`009#1,msgvec+<2*4>(fp)
X`009moval`009@1*4(ap),msgvec+<3*4>(fp)
X;
X;=`009`009call sys$putmsg(msgvec,,'FEHLER',)
X;
X`009$putmsg_s`009msgvec=msgvec(fp),-
X`009`009`009facnam=fehler_name
X;
X;=`009`009call lib$stop(%val(msgvec(2).or.'10000000'x))`009! no more output,
X;=`009c`009`009`009`009`009`009`009! but ggf. trace
X;
X`009bisl3`009msgvec+<1*4>(fp),#`094x10000000,-(sp)
X`009calls`009#1,g`094lib$stop
X;
X;=`009`009end
X;
X`009ret
X;
X`009.end
$ GOSUB UNPACK_FILE

$ FILE_IS = "FIBDEF.H"
$ CHECKSUM_IS = 812749928
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X * definitions created by GENDEF at 27-AUG-1992 12:32:04.22 (VMS V5.5-1)
X */
X#define`009FIB$M_NOWRITE`0091
X#define`009FIB$M_DLOCK`0092
X#define`009FIB$M_BLK_LOCK`0094
X#define`009FIB$M_SPOOL`00916
X#define`009FIB$M_WRITECK`00932
X#define`009FIB$M_SEQONLY`00964
X#define`009FIB$M_WRITE`009256
X#define`009FIB$M_READCK`009512
X#define`009FIB$M_NOREAD`0091024
X#define`009FIB$M_NOTRUNC`0092048
X#define`009FIB$M_CONTROL`0094096
X#define`009FIB$M_NO_READ_DATA`0098192
X#define`009FIB$M_EXECUTE`00965536
X#define`009FIB$M_PRSRV_ATR`009131072
X#define`009FIB$M_RMSLOCK`009262144
X#define`009FIB$M_WRITETHRU`009524288
X#define`009FIB$M_NOLOCK`0091048576
X#define`009FIB$M_NORECORD`0092097152
X#define`009FIB$M_NOVERIFY`0094194304
X#define`009FIB$M_REWIND`0098
X#define`009FIB$M_CURPOS`00916
X#define`009FIB$M_UPDATE`00964
X#define`009FIB$K_ACCDATA`00910
X#define`009FIB$C_ACCDATA`00910
X#define`009FIB$K_DIRDATA`00922
X#define`009FIB$C_DIRDATA`00922
X#define`009FIB$M_ALLVER`0098
X#define`009FIB$M_ALLTYP`00916
X#define`009FIB$M_ALLNAM`00932
X#define`009FIB$M_WILD`009256
X#define`009FIB$M_NEWVER`009512
X#define`009FIB$M_SUPERSEDE`0091024
X#define`009FIB$M_FINDFID`0092048
X#define`009FIB$M_LOWVER`00916384
X#define`009FIB$M_HIGHVER`00932768
X#define`009FIB$M_ALCON`0091
X#define`009FIB$M_ALCONB`0092
X#define`009FIB$M_FILCON`0094
X#define`009FIB$M_ALDEF`0098
X#define`009FIB$M_ALLOCATR`00916
X#define`009FIB$M_EXTEND`009128
X#define`009FIB$M_TRUNC`009256
X#define`009FIB$M_NOHDREXT`009512
X#define`009FIB$M_MARKBAD`0091024
X#define`009FIB$M_NOPLACE`00916384
X#define`009FIB$M_NOCHARGE`00932768
X#define`009FIB$K_EXTDATA`00932
X#define`009FIB$C_EXTDATA`00932
X#define`009FIB$M_EXACT`0091
X#define`009FIB$M_ONCYL`0092
X#define`009FIB$C_CYL`0091
X#define`009FIB$C_LBN`0092
X#define`009FIB$C_VBN`0093
X#define`009FIB$C_RFI`0094
X#define`009FIB$K_ALCDATA`00944
X#define`009FIB$C_ALCDATA`00944
X#define`009FIB$M_ALT_REQ`0091
X#define`009FIB$M_ALT_GRANTED`0092
X#define`009FIB$M_DIRACL`0094
X#define`009FIB$M_PROPAGATE`0098
X#define`009FIB$K_MOVEFILE`00972
X#define`009FIB$C_MOVEFILE`00972
X#define`009FIB$K_LENGTH`00972
X#define`009FIB$C_LENGTH`00972
X#define`009FIB$S_FIBDEF`00972
X#define`009FIB$L_ACCTL`0090
X#define`009FIB$V_NOWRITE`0090
X#define`009FIB$V_DLOCK`0091
X#define`009FIB$V_BLK_LOCK`0092
X#define`009FIB$V_SPOOL`0094
X#define`009FIB$V_WRITECK`0095
X#define`009FIB$V_SEQONLY`0096
X#define`009FIB$V_WRITE`0098
X#define`009FIB$V_READCK`0099
X#define`009FIB$V_NOREAD`00910
X#define`009FIB$V_NOTRUNC`00911
X#define`009FIB$V_CONTROL`00912
X#define`009FIB$V_NO_READ_DATA`00913
X#define`009FIB$V_EXECUTE`00916
X#define`009FIB$V_PRSRV_ATR`00917
X#define`009FIB$V_RMSLOCK`00918
X#define`009FIB$V_WRITETHRU`00919
X#define`009FIB$V_NOLOCK`00920
X#define`009FIB$V_NORECORD`00921
X#define`009FIB$V_NOVERIFY`00922
X#define`009FIB$V_REWIND`0093
X#define`009FIB$V_CURPOS`0094
X#define`009FIB$V_UPDATE`0096
X#define`009FIB$B_WSIZE`0093
X#define`009FIB$S_FID`0096
X#define`009FIB$W_FID`0094
X#define`009FIB$W_FID_NUM`0094
X#define`009FIB$W_FID_SEQ`0096
X#define`009FIB$W_FID_RVN`0098
X#define`009FIB$B_FID_RVN`0098
X#define`009FIB$B_FID_NMX`0099
X#define`009FIB$S_DID`0096
X#define`009FIB$W_DID`00910
X#define`009FIB$W_DID_NUM`00910
X#define`009FIB$W_DID_SEQ`00912
X#define`009FIB$W_DID_RVN`00914
X#define`009FIB$B_DID_RVN`00914
X#define`009FIB$B_DID_NMX`00915
X#define`009FIB$L_WCC`00916
X#define`009FIB$W_NMCTL`00920
X#define`009FIB$V_ALLVER`0093
X#define`009FIB$V_ALLTYP`0094
X#define`009FIB$V_ALLNAM`0095
X#define`009FIB$V_WILD`0098
X#define`009FIB$V_NEWVER`0099
X#define`009FIB$V_SUPERSEDE`00910
X#define`009FIB$V_FINDFID`00911
X#define`009FIB$V_LOWVER`00914
X#define`009FIB$V_HIGHVER`00915
X#define`009FIB$W_EXCTL`00922
X#define`009FIB$V_ALCON`0090
X#define`009FIB$V_ALCONB`0091
X#define`009FIB$V_FILCON`0092
X#define`009FIB$V_ALDEF`0093
X#define`009FIB$V_ALLOCATR`0094
X#define`009FIB$V_EXTEND`0097
X#define`009FIB$V_TRUNC`0098
X#define`009FIB$V_NOHDREXT`0099
X#define`009FIB$V_MARKBAD`00910
X#define`009FIB$V_NOPLACE`00914
X#define`009FIB$V_NOCHARGE`00915
X#define`009FIB$L_EXSZ`00924
X#define`009FIB$L_EXVBN`00928
X#define`009FIB$B_ALOPTS`00932
X#define`009FIB$V_EXACT`0090
X#define`009FIB$V_ONCYL`0091
X#define`009FIB$B_ALALIGN`00933
X#define`009FIB$S_ALLOC`00910
X#define`009FIB$W_ALLOC`00934
X#define`009FIB$S_LOC_FID`0096
X#define`009FIB$W_LOC_FID`00934
X#define`009FIB$W_LOC_NUM`00934
X#define`009FIB$W_LOC_SEQ`00936
X#define`009FIB$W_LOC_RVN`00938
X#define`009FIB$B_LOC_RVN`00938
X#define`009FIB$B_LOC_NMX`00939
X#define`009FIB$L_LOC_ADDR`00940
X#define`009FIB$W_VERLIMIT`00944
X#define`009FIB$B_AGENT_MODE`00946
X#define`009FIB$B_RU_FACILITY`00947
X#define`009FIB$L_ACLCTX`00948
X#define`009FIB$L_ACL_STATUS`00952
X#define`009FIB$L_STATUS`00956
X#define`009FIB$V_ALT_REQ`0090
X#define`009FIB$V_ALT_GRANTED`0091
X#define`009FIB$V_DIRACL`0092
X#define`009FIB$V_PROPAGATE`0093
X#define`009FIB$L_ALT_ACCESS`00960
X#define`009FIB$L_MOV_SVBN`00964
X#define`009FIB$L_MOV_VBNCNT`00968
X#define`009FIB$C_REWINDVOL`0091
X#define`009FIB$C_POSEND`0092
X#define`009FIB$C_NEXTVOL`0093
X#define`009FIB$C_SPACE`0094
X#define`009FIB$C_ILLEGAL`0095
X#define`009FIB$C_REWINDFIL`0096
X#define`009FIB$C_LOCK_VOL`0097
X#define`009FIB$C_UNLK_VOL`0098
X#define`009FIB$C_ENA_QUOTA`0099
X#define`009FIB$C_DSA_QUOTA`00910
X#define`009FIB$C_ADD_QUOTA`00911
X#define`009FIB$C_EXA_QUOTA`00912
X#define`009FIB$C_MOD_QUOTA`00913
X#define`009FIB$C_REM_QUOTA`00914
X#define`009FIB$C_USEREOT`00915
X#define`009FIB$C_REMAP`00916
X#define`009FIB$C_CLSEREXCP`00917
X#define`009FIB$C_FLUSH_CACHE`00918
X#define`009FIB$C_FORCE_MV`00919
X#define`009FIB$K_MTALEN`00928
X#define`009FIB$C_MTALEN`00928
X#define`009FIB$C_FID_CACHE`0091
X#define`009FIB$C_EXTENT_CACHE`0092
X#define`009FIB$C_QUOTA_CACHE`0093
X#define`009FIB$C_BFRD_CACHE`0094
X#define`009FIB$M_ALL_MEM`0091
X#define`009FIB$M_ALL_GRP`0092
X#define`009FIB$M_MOD_USE`0094
X#define`009FIB$M_MOD_PERM`0098
X#define`009FIB$M_MOD_OVER`00916
X#define`009FIB$S_FIBDEF1`00928
X#define`009FIB$W_CNTRLFUNC`00922
X#define`009FIB$L_CNTRLVAL`00924
X#define`009FIB$V_ALL_MEM`0090
X#define`009FIB$V_ALL_GRP`0091
X#define`009FIB$V_MOD_USE`0092
X#define`009FIB$V_MOD_PERM`0093
X#define`009FIB$V_MOD_OVER`0094
X/*
X * end of definitions created by GENDEF
X */
$ GOSUB UNPACK_FILE

$ FILE_IS = "FIDDEF.H"
$ CHECKSUM_IS = 1999005123
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X * definitions created by C_GBLINI at  7-JUN-1989 14:27:54.21
X */
X#define`009FID$K_LENGTH`0096
X#define`009FID$C_LENGTH`0096
X#define`009FID$C_INDEXF`0091
X#define`009FID$C_BITMAP`0092
X#define`009FID$C_BADBLK`0093
X#define`009FID$C_MFD`0094
X#define`009FID$C_CORIMG`0095
X#define`009FID$C_VOLSET`0096
X#define`009FID$C_CONTIN`0097
X#define`009FID$C_BACKUP`0098
X#define`009FID$C_BADLOG`0099
X#define`009FID$C_FREFIL`00910
X#define`009FID$S_FIDDEF`0096
X#define`009FID$W_NUM`0090
X#define`009FID$W_SEQ`0092
X#define`009FID$W_RVN`0094
X#define`009FID$B_RVN`0094
X#define`009FID$B_NMX`0095
X/*
X * end of C_GBLINI definitions
X */
$ GOSUB UNPACK_FILE

$ FILE_IS = "FRAGC-MAKE.COM"
$ CHECKSUM_IS = 1984389037
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$! make FRAGC.EXE - with DECC (VAX or Alpha),
X$!`009`009`009after fixes also with VAXC or GCC (VAX)
X$!
X$ ccopt   := /standard=VAXC`009`009! make this void for VAXC and GCC
X$ linkopt := ! ,VAXC.OPT/option`009`009! uncomment for VAXC (and GCC)
X$!
X$ cc 'ccopt' FRAGC.C
X$ macro      FEHLER.MAR
X$ cc 'ccopt' REDIRECT.C
X$!
X$ link       FRAGC.OBJ,FEHLER.OBJ,REDIRECT.OBJ 'linkopt'
X$!
X$ exit
$ GOSUB UNPACK_FILE

$ FILE_IS = "FRAGC.C"
$ CHECKSUM_IS = 1778942719
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/* imitate "FRAG.MAR", originally by MICHAEL N. LEVINE
X *`009`009`009(DECUS tapes [LEVINE.JUICER...])
X *`009`009`009and modified by w.j.m (last mod: mar 1987)
X * w.j.m. jun 1989
X * mod 17-feb-1992 wjm: allow for read-only disk
X * mod 23-mar-1994 wjm: fixes for DECC, plus a bug fix
X * mod 07-mar-1999 wjm: adapt to VAX GNUC
X */
X
X#include <stdio.h>
X#include <stdlib.h>
X#include <string.h>
X
X#include <dvidef.h>
X#include <iodef.h>
X
X#include <descrip.h>
Xtypedef struct dsc$descriptor_s DESCR;
X
X#include "fiddef.h"
Xstruct Fid `123
X`009unsigned short num;
X`009unsigned short seq;
X`009unsigned char rvn;
X`009unsigned char nmx;
X`125;
X
X#include "fibdef.h"
Xtypedef struct Fib `123`009/* stub, only what's needed */
X`009unsigned int acctl;
X`009struct Fid fid;
X`009unsigned char fill2[FIB$C_LENGTH - FIB$W_FID - sizeof(struct Fid)];
X`125 FIB;
X
Xtypedef struct Itmlst `123
X`009unsigned short size,code;
X`009void *retadr,*retlenp;
X`125 ITMLST;
X
X#ifdef __GNUC__
Xextern void ss$_writlck;
X#define SS$_WRITLCK ((int) &ss$_writlck)
X#else
Xglobalvalue SS$_WRITLCK;
X#endif
Xextern void lib$stop(), lib$signal(), fehler(DESCR *);
Xextern unsigned sys$assign(DESCR *,unsigned short *,unsigned,DESCR *);
Xextern unsigned sys$dassgn(short);
Xextern unsigned lib$get_vm(int *,void *,...);
Xextern unsigned sys$getdviw(), sys$qiow();
X
X#ifndef NULL
X#define NULL ((void *) 0)
X#endif
X
X#define CHECKV(k) if((k&1) == 0) lib$stop(k)
X#define CHECK(k) `123unsigned status = k; CHECKV(status);`125
X#define ZERO1(arr,len) memset(arr,0,len)
X#define ZERO4(arr,len) memset(arr,0,4*(len))
X#define FEHLER(s) `123$DESCRIPTOR(fd,s); fehler(&fd);`125
X#define MAX(a,b) (((a)>(b))?(a):(b))
X#define MIN(a,b) (((a)<(b))?(a):(b))
X
Xstatic int dvi_maxblock,dvi_freeblocks,dvi_cluster,dvi_volnumber;
Xstatic DESCR devdsc = `1230-0,0,0,NULL`125;
Xstatic char devnambuf[32];
X
X
X/*****/
X
Xmain(argc,argv)
Xint argc; char **argv;
X`123
X`009int i,ibit,ib,jcl;
X`009int n_clus,bitmap_blocks;
X`009int nfree,nfrag,maxfree,nfree_b,maxfree_b,avfs,eufs;
X`009unsigned int ml, *map, *mp;
X`009int /*logical*/ arg_ok;
X`009unsigned liosb[2];
X`009unsigned short chan, iosb[4];
X`009ITMLST dvi_items[] = `123
X`009`009`1234,DVI$_VOLNUMBER,&dvi_volnumber,NULL`125,
X`009`009`1234,DVI$_MAXBLOCK,&dvi_maxblock,NULL`125,
X`009`009`1234,DVI$_FREEBLOCKS,&dvi_freeblocks,NULL`125,
X`009`009`1234,DVI$_CLUSTER,&dvi_cluster,NULL`125,
X`009`009`12332,DVI$_FULLDEVNAM,&devnambuf,&devdsc.dsc$w_length`125,
X`009`009`1230,0,NULL,NULL`125`125;
X`009static FIB fib_blk;
X`009DESCR fib_descr = `123FIB$C_LENGTH,0,0,(void*)&fib_blk`125;
X#define`009NBUCK 23
X`009static const int bsize[NBUCK] = `123
X`009`0091,2,3,5,9,17,33,65,129,257,513,1025,2049,4097,8193,
X`009`00916385,32769,65537,131073,262145,524289,1048577,
X`009`0090x7fffffff`125;`009/* last value: MAX_INT */
X`009int bfree[NBUCK],bfrag[NBUCK];
X
X
X#ifdef VMS
X`009redirect(&argc,&argv);
X#endif
X
X`009devdsc.dsc$w_length = 0;
X`009for(arg_ok = 1, i = 1; arg_ok && i < argc; i++) `123
X`009`009`123
X`009`009`009if(devdsc.dsc$w_length > 0) `123
X`009`009`009`009arg_ok = 0;
X`009`009`009`125 else `123
X`009`009`009`009devdsc.dsc$w_length = strlen(argv[i]);
X`009`009`009`009devdsc.dsc$a_pointer = argv[i];
X`009`009`009`125
X`009`009`125
X`009`125
X`009if(devdsc.dsc$w_length <= 0) arg_ok = 0;
X`009if(!arg_ok) `123
X`009`009FEHLER("parameters: device");
X`009`125
X
X`009CHECK(sys$assign(&devdsc,&chan,0,0));
X
X`009devdsc.dsc$a_pointer = devnambuf;
X`009CHECK(sys$getdviw(0,chan,0,&dvi_items,&liosb,0,0,0));
X`009CHECKV(liosb[0]);
X
X`009/* get storage for bitmap */
X`009n_clus = dvi_maxblock/dvi_cluster;
X`009bitmap_blocks = (n_clus + (512*8) - 1)/(512*8);
X`009`123
X`009`009int bytes = 512 * bitmap_blocks + 4;
X
X`009`009CHECK(lib$get_vm(&bytes,&map));
X`009`125
X
X`009/* init FIB */
X`009ZERO1(&fib_blk,FIB$C_LENGTH);
X`009fib_blk.fid.rvn = dvi_volnumber;
X`009fib_blk.fid.num = FID$C_BITMAP;
X`009fib_blk.fid.seq = FID$C_BITMAP;
X`009fib_blk.acctl = FIB$M_WRITE `124 FIB$M_NOTRUNC `124 FIB$M_NORECORD;
X
X`009/* Try to access the bitmap file for *WRITE* to trigger cache flush */
X`009CHECK(sys$qiow(0,chan,IO$_ACCESS`124IO$M_ACCESS,
X`009`009&iosb,0,0,&fib_descr,0,0,0,0,0));
X`009if(iosb[0] == SS$_WRITLCK) `123`009`009/* try read-only access */
X`009`009fib_blk.acctl &= `126FIB$M_WRITE;
X`009`009CHECK(sys$qiow(0,chan,IO$_ACCESS`124IO$M_ACCESS,
X`009`009`009&iosb,0,0,&fib_descr,0,0,0,0,0));
X`009`125
X`009CHECK(iosb[0]);
X
X`009/* Read all of the bitmap (start at VBN 2) at once */
X`009CHECK(sys$qiow(0,chan,IO$_READVBLK,
X`009`009&iosb,0,0,map,512*bitmap_blocks,2,0,0,0));
X`009CHECK(iosb[0]);
X
X`009/* Done with I/O */
X`009CHECK(sys$dassgn(chan));
X
X`009/* zero counts ... (all counts are in CLUSTERS!) */
X`009maxfree = 0;
X`009nfree = nfrag = 0;
X`009for(i = 0; i < NBUCK; i++) `123
X`009`009bfree[i] = 0;
X`009`009bfrag[i] = 0;
X`009`125
X
X`009/* create sentinel at end of bitmap */
X`009*(map + (n_clus/32)) &= `126(1 << (n_clus % 32));`009/* zero next bit */
X
X`009/* main loop */
X`009jcl = 0;
X`009ibit = 0;
X`009mp = map;
X`009for(i = n_clus; i >= 0; i--) `123`009/* >= so we get to the sentinel */
X`009`009if(--ibit <= 0) `123
X`009`009`009ml = *mp++;
X`009`009`009ibit = 32;
X`009`009`125
X`009`009if(ml&1) `123`009`009/* free */
X`009`009`009jcl++;
X`009`009`125 else `123`009`009/* in use */
X`009`009`009if(jcl>0) `123
X`009`009`009`009for(ib = 0; jcl >= bsize[ib+1]; ib++);
X`009`009`009`009bfrag[ib]++;
X`009`009`009`009bfree[ib] += jcl;
X`009`009`009`009nfrag++;
X`009`009`009`009nfree += jcl;
X`009`009`009`009maxfree = MAX(jcl,maxfree);
X
X`009`009`009`009jcl = 0;
X`009`009`009`125
X`009`009`125
X`009`009ml >>= 1;
X`009`125
X
X`009nfree_b = nfree * dvi_cluster;
X`009if(nfrag > 0) `123
X`009`009avfs = (nfree_b + nfrag/2)/nfrag;`009/* rounded */
X`009`009/* wjm statistic after KNUTH Vol.1:
X`009`009`009"expected size of USED blocks" */
X`009`009eufs = (dvi_maxblock - nfree_b + nfrag)/(2*nfrag);
X`009`009`009`009`009`009`009/* rounded */
X`009`125 else `123
X`009`009avfs = eufs = 0;
X`009`125
X`009maxfree_b = maxfree * dvi_cluster;
X
X
X/* heading */
X`009printf("Disk %.*s\n",
X`009`009devdsc.dsc$w_length,devdsc.dsc$a_pointer);
X`009printf("Disk size in blocks             %10d\n",
X`009`009dvi_maxblock);
X`009printf("Cluster size in blocks          %10d\n",
X`009`009dvi_cluster);
X`009printf("Number of free blocks           %10d\n",
X`009`009dvi_freeblocks);
X`009printf("Average fragment size in blocks %10d    [%d]\n",
X`009`009avfs,eufs);
X`009printf("Largest free space in blocks    %10d\n",
X`009`009maxfree_b);
X`009printf("\n");
X`009printf("Free area size in clusters      Count of       Total   \
X        %% Disk  %% Free\n");
X`009printf("                                Fragments      Clusters\
X        Space   Space \n");
X
X
X`009for(ib = 0; ib < NBUCK; ib++) `123
X`009`009if(bfrag[ib] > 0) `123
X`009`009`009printf(
X`009`009"%10d    -%10d       %10d    (%10d    /%6.1f %%/%6.1f %%)\n",
X`009`009`009`009bsize[ib],bsize[ib+1]-1,
X`009`009`009`009bfrag[ib],bfree[ib],
X`009`009`009`009(100.0 * bfree[ib] * dvi_cluster) /
X`009`009`009`009`009(double) dvi_maxblock,
X`009`009`009`009(100.0 * bfree[ib]) / (double) nfree);
X`009`009`125
X`009`125
X`009printf("                        Total   %10d    (%10d    /\
X%6.1f %%/%6.1f %%)\n",
X`009`009nfrag,nfree,
X`009`009(100.0 * nfree_b) / (double) dvi_maxblock,
X`009`009100.0);
X`125
$ GOSUB UNPACK_FILE

$ FILE_IS = "REDIRECT.C"
$ CHECKSUM_IS = 1478173188
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*`009simulate SHELL redirection on VMS
X *`009w.j.m. feb 86
X *`009...
X *`009fix 10-nov-1996: for GCC, use standard #include <>
X *`009
X * usage:
X *
X *`009main(argc,argv)
X *`009int argc; char **argv;
X *`009`123
X *`009#ifdef VMS
X *`009`009redirect(&argc,&argv);
X *`009#endif
X *`009`009...
X * bugs:
X *`009does not handle redirection of stderr.
X *`009overwrites argument vector (*argv).
X */
X
X#include <stdio.h>
X#include <stdlib.h>
X
X#include <perror.h>
X#include <errno.h>
X
Xstatic myerr(str,flag)
Xchar *str; int flag;
X`123
X`009fprintf(stderr,"%%-F-REDIRECT, %s\n",str);
X`009if(flag) `123
X`009`009exit(vaxc$errno);
X`009`125 else`009exit(0x10000004);
X`125
X
Xredirect(argcp,argvp)
Xint *argcp; char ***argvp;
X`123
X`009char **av,**nav;
X`009int ac,nac;
X`009int inx = 0, outx = 0;
X
X`009av = nav = *argvp;
X`009ac = *argcp;
X
X`009if(ac <= 0) return;`009`009/* no arg, no action */
X
X`009av++; nav++; ac--; nac = 1;`009/* 1st arg untouched */
X
X`009for( ; ac > 0; av++, ac--) `123
X`009`009switch(**av) `123
X`009`009  case '<':
X`009`009`009if(inx++) myerr("double input redirection",0);
X`009`009`009if((stdin=freopen(*av+1,"r",stdin,"mbc=16"))==NULL)
X`009`009`009`009myerr("cannot redirect stdin",1);
X`009`009`009break;
X`009`009  case '>':
X`009`009`009if(outx++) myerr("double output redirection",0);
X`009`009`009if(*(*av+1) == '>') `123
X`009`009`009`009if((stdout=freopen(*av+2,"a",stdout,"mbc=16"))==NULL)
X`009`009`009`009`009myerr("cannot redirect stdout",1);
X`009`009`009`125 else `123
X`009`009`009`009if((stdout=freopen(*av+1,"w",stdout,"mbc=16"))==NULL)
X`009`009`009`009`009myerr("cannot redirect stdout",1);
X`009`009`009`125
X`009`009`009break;
X`009`009  default:
X`009`009`009*nav++ = *av; nac++;
X`009`009`125
X`009`125
X
X`009/* note: K&R does not say that argv[argc] == NULL */
X
X`009*argcp = nac;
X`125
$ GOSUB UNPACK_FILE

$ FILE_IS = "VAXC.OPT"
$ CHECKSUM_IS = 1394633292
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XSYS$SHARE:VAXCRTL.EXE/share
$ GOSUB UNPACK_FILE
$ EXIT

Wolfgang J. Moeller, Tel. +49 551 2011516 or -510, moeller@gwdvms.dnet.gwdg.de
GWDG, D-37077 Goettingen, F.R.Germany   |       Disclaimer: No claim intended!
<moeller@decus.decus.de>  ----- <moeller@gwdg.de>  -----  <w.moeller@ieee.org>