| > Any way to trouble shoot this? He believes he has a defragmented disk
> and still gets small chunks instead of contiguous space.
You could try it yourself. He can also verify the largest chunk
of available space by setting the FIB$V_ALCON bit with the
FIB$V_ALCONB bit and the returned value (FIB$L_EXSZ) will be the
largest contiguous area on the disk.
The CBT mechanism means that it will attempt to find the 3 largest
available blocks of contiguous space. After that, it is picked up
in whatever extent order that happens to exist.
So if you try to allocate 5000 blocks and the extents available
are 10, 20, 1000, 2000, 500, 100, 70, 500, 900 your extent map
from dump/header would look like
2000
1000
900
10
20
500
100
70
The example of code that I used to test this out:
/*
Program to test the CBT (FIB$M_ALCONB) extention of a file.
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <descrip.h>
#include <starlet.h>
#include <lib$routines.h>
#include <fab.h>
#include <stsdef.h>
#include <fibdef.h>
#include <iodef.h>
void Usage() ;
short open_file( char *file_name ) ;
void extend_file( int size, short channel ) ;
main(int argc, char *argv[])
{
short channel ;
char *file_name ;
int extend_size ;
if (argc < 3)
Usage() ;
if (!(extend_size = atoi(argv[2])))
Usage() ;
file_name = argv[1] ;
channel = open_file(file_name) ;
extend_file( extend_size, channel ) ;
}
void Usage()
{
printf("excbt file size\n") ;
exit(1) ;
}
short open_file( char *file_name )
{
struct FAB fab ;
int status ;
fab = cc$rms_fab ;
fab.fab$l_fop = FAB$M_UFO ;
fab.fab$b_fac = FAB$M_PUT | FAB$M_GET ; /* read and write */
fab.fab$l_fna = file_name ;
fab.fab$b_fns = strlen(file_name) ;
status = sys$open( & fab ) ;
if (!$VMS_STATUS_SUCCESS(status))
{
lib$signal(status, fab.fab$l_stv) ;
exit(status|STS$M_INHIB_MSG) ;
}
return (short)(fab.fab$l_stv&0xffff) ;
}
void extend_file( int size, short channel )
{
struct {
short status ;
short unused ;
int size_returned ;
} iosb ;
struct fibdef fib ;
struct dsc$descriptor fib_d = { 0, 0, 0, 0 } ;
int status ;
memset(&fib, 0, sizeof(fib) );
/*
If you also set the FIB$M_ALCON flag,
you will get back (only) the largest
contigous space available.
*/
fib.fib$w_exctl = FIB$M_ALCONB | FIB$M_EXTEND ;
fib.fib$l_exsz = size ;
fib_d.dsc$w_length = sizeof(fib) ;
fib_d.dsc$a_pointer = (void*)&fib ;
status = sys$qiow( 0, channel, IO$_MODIFY, &iosb, 0, 0,
&fib_d, 0, 0, 0, 0, 0) ;
if ($VMS_STATUS_SUCCESS(status)) status = iosb.status ;
if (!$VMS_STATUS_SUCCESS(status)) lib$signal(status);
printf("The file was extended by %d blocks\n", fib.fib$l_exsz) ;
printf("The largest contiguous area is %d blocks\n",
iosb.size_returned) ;
}
|
| I asked the customer to play with FIB$V_ALCON/FIB$V_ALCONB, not sure how
this will help knowing the largest chunk. From his notes below if he has
a delay the file is fragmented; otherwise it works.
This is really difficult for the customer support center to determine
expected behavior and to work with customers who believe something is not
working as they expect, these types of calls are the exception and
requires a great deal of time. Boy do I wish I had a good defense
attorney!
Notes from the customer and a example (large) below, not the affect of the
delay, that is what bothers me!
-drew
The attached Fortran program (ascii text file) duplicates the problem of
auto-fragmentation of the disk.
Please note the delay (LIB$WAIT) in the code. If no delay is placed in
the code, the file is created contiguous. With a delay of 1 minute or
more between the file extensions, the file is fragmented.
Is this some caching or time-out problem/feature?
Please let me know what you find and what I can adjust to prevent this
fragmentation.
Program DATA_STORAGE
Implicit NONE
Logical*4 VERFLAG /.TRUE./
Character*14 VERSION
Parameter (VERSION='DATA_STORAGE 1.0')
C
Character*92 MSG ! Event logging message string
C
Character*12 ME /'DATA_STORAGE'/
*
Include '($SYSSRVNAM)' !SYSTEM SERVICES
Include '($IODEF)' !IO SERVICES
Include '($SSDEF)' !SYSTEM SERVICE COMPLETION CODES
*
CDBP Include '$MOSAIC:[INC.DAQ]DAQ_OUT_BUF.INC'
CDBP Include '$MOSAIC:[INC.DAQ]SCAN_LISTS.INC'
CDBP Include '$MOSAIC:[INC.DAQ]AFLGREQ.INC'
*
*Set the no swap parameter
Integer*4 NO_SWAP
Parameter (NO_SWAP = 1)
*
*Disk Block Size
Integer*4 BLOCK_SIZE
Parameter (BLOCK_SIZE = 512)
*
INTEGER*4 ISTAT, ILEN
INTEGER*4 I, N, I4DUMMY
*Last block that can be used for storage with this scan list.
Integer*4 LAST_BLOCK
*
Integer*4 NBYTES
*
CRJE Integer*8 RECORD_NUMBER
INTEGER*4 RECORD_NUMBER !USE I*4 RJE. 10/30/96...
INTEGER*4 IREC !RECORD NUMBER FOR SESSION FILE.
*
*
*Character buffer for error messages
*
Character*256 ERR_MES
*
*Character buffer for file name
*
Character*255 FILE
Character*9 DEVICE
Data DEVICE /'DISK$TEST'/! RAID DEVICE
CHARACTER*6 DEV_HDR /'$DISK1'/
CHARACTER*64 DIR_PATH !LOCAL FOR "TEST_DATA_DIR"
CHARACTER*9 ASCII_STAMP
CHARACTER*8 ASESS
*
*QIO I/O Channel variables
*
Integer*4 IO_CHANNEL !QIO CHANNEL
Integer*4 EF !CHAN
*
Structure / QIO_IOSB /
Integer*2 STATUS
Integer*2 COUNT_LOW
Integer*2 COUNT_HIGH
Integer*2 ZIP_NOTHING
End structure
*
Record / QIO_IOSB / IOSB
*
Integer*4 FSL !LOCAL STORAGE FOR FSL
*Array for IO_BUFFER begin and end address for lock service
*
Integer*4 BUF_PAGES(2) ! Array for I/O buffer addresses
Integer*4 FREE_BLOCKS !MAX BLOCKS AVAILABLE ON DISC
INTEGER*4 INITIAL_SIZE !FILE ALLOCATION BLOCKS
INTEGER*4 EXTEND_SIZE !FILE EXTENSION BLOCKS
INTEGER*4 EXTEND_WATCH !WHEN TO EXTEND.
INTEGER*4 ALLOCATED
INTEGER*4 EXTEND_LOOK !LOOK AHEAD FOR ALLOCATION ALG.
INTEGER*4 ONE_MINUTE_OF_RECORDING !#BLOCKS EQUAL TO 1 MINUTE OF DATA
INTEGER*4 MAX_BUF_BLOCKS !WORST-CASE ALLOCATION.
Integer*4 MAX_BLOCKS !MAX BLOCK SIZE FOR DISC
INTEGER*4 EXTEND /1/
INTEGER*4 TRUNCATE/2/
Integer*4 WRITE_BLOCK !INITIAL WRITE BLOCK
Integer*4 BYTE_SIZE !RECORD BYTE SIZE
Integer*4 NUMBLKS_N_REC !NUMBER OF BLOCKS PER RECORD
Integer*4 BUFFER_FULL(2) /90 ! TUSTIN 1 -- 1M s/s
1, 91 / ! TUSTIN 2 -- 200K s/s
INTEGER*4 DATA_STORE /92/ ! DATA_STORAGE WAKEUP CALL.
INTEGER*4 FILE_RDY /95/ ! STORAGE FILE OPENED.
Integer*4 BOTH_TUSTINS !BUFFER FULL EVENT FLAGS
Parameter (BOTH_TUSTINS = '0C000000'z ) ! bits 90 and 91
Integer*4 EITHER_TUSTIN !ACQ ENABLES
Parameter (EITHER_TUSTIN = '60000000'z ) ! bits 93 OR 94
*
*Storage Buffer pointer and event flag
Integer*4 STORE_ODD_EVEN
*
*Integer Functions
*
Integer*4 LEN_TRIM ! Used with character strings to point to last character
INTEGER*4 LIB$CREATE_DIR
INTEGER*4 FILEMAINT !FILE EXTEND/TRUNCATE ROUTINE
*
*Define all local variables to make implicit none happy
*
Integer*4 LUN / 12 /
Integer*4 SLUN / 13 /
Integer*4 HLUN / 14 /
Integer*4 STATUS
Integer*4 NTEMP
Integer*4 SIZER
Integer*4 FAB_ADR
Integer*4 RAB_ADR
Integer*4 DAQ_OPEN
*External and AST sub programs
*
CCC LOG FILE OPEN INFO
C
INTEGER*4 USER_OPEN
EXTERNAL USER_OPEN
External DAQ_OPEN
Logical FILEOPEN / .false. / !FILE OPEN FLAG
LOGICAL EXTEND_OK
CDEBUG STUFF
INTEGER*4 DLUN /8/
integer*4 ILUN /1/
INTEGER*4 I4INC
CCCCCCCCCCCCCCCCC Begin executable code CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
CCC Open the DATA file
C
Open( Unit=LUN,
1 Name='DISK$TEST:[000000]ACPQIO.DAT',
2 Status='NEW',
3 Initialsize=21730,
3 Buffercount=4,
4 Recordtype='FIXED',
1 Recl=128, !LONGWORD DEFINITION
5 Access='DIRECT',
6 Blocksize=BLOCK_SIZE,
1 Useropen=DAQ_OPEN,
7 Iostat=STATUS)
If ( STATUS .ne. 0 ) Then
write (*,*) 'error opening file, status=',status
Go to 9000
End if
Call GET_QIO_CHANNEL ( LUN, IO_CHANNEL, FAB_ADR, RAB_ADR )
EXTEND_SIZE = 21730
C
I4INC = 1
DO WHILE (I4INC .LE. 100)
call lib$wait (70.0)
ISTAT = FILEMAINT(IO_CHANNEL,EXTEND,EXTEND_SIZE)
IF (.NOT. ISTAT) THEN
write (*,*) 'error EXTENDING file, status=',ISTAT
Go to 9000
ENDIF
I4INC = I4INC + 1
ENDDO
C
*Fatal error processing
C
9000 Close ( LUN,IOSTAT=ISTAT )
STOP
End !DATA_STORAGE
*****************************************************************
FUNCTION FILEMAINT(IO_CHANNEL,ACTION,NUM_BLOCKS)
Implicit NONE
Logical*4 VERFLAG /.TRUE./
Character*14 VERSION
Parameter (VERSION='FILEMAINT0.0')
C
Character*256 MSG ! Event logging message string
C
Character*10 ME
*
*
****************************************************************************
*
Include '($SYSSRVNAM)' !SYSTEM SERVICES
Include '($IODEF)' !IO SERVICES
Include '($SSDEF)' !SYSTEM SERVICE COMPLETION CODES
INCLUDE '($ATRDEF)'
INCLUDE '($FIBDEF)'
INTEGER*4 FILEMAINT
INTEGER*4 LEN_TRIM
*
*Disk Block Size
Integer*4 BLOCK_SIZE
Parameter (BLOCK_SIZE = 512)
*
INTEGER*4 ISTAT, ILEN
INTEGER*4 ACTION,
1 EXTEND,
2 TRUNCATE
PARAMETER (EXTEND=1, TRUNCATE=2)
INTEGER*4 NUM_BLOCKS
INTEGER*4 TEMP_BLOCKS
INTEGER*4 STATE
*
*QIO I/O Channel variables
*
Integer*4 IO_CHANNEL !QIO CHANNEL
Integer*4 EF /41/ !CHAN
*
Structure / QIO_IOSB /
Integer*2 STATUS
Integer*2 COUNT_LOW
Integer*2 COUNT_HIGH
Integer*2 ZIP_NOTHING
End structure
*
Record / QIO_IOSB / IOSB
INTEGER*4 BITS4
INTEGER*2 BITS2
record /fIbdef/ FIB
INTEGER*4 FIB_DESCR(2) / FIB$K_LENGTH , 0 /
LOGICAL IN_WORK/.FALSE./
C
CCC DEFINE RECORD ATTRIBUTE CONTROL BLOCK.
C
STRUCTURE /ATR_BLOCK/
UNION
MAP
INTEGER*2 ATR_SIZE
INTEGER*2 ATR_TYPE
INTEGER*4 ATR_ADDRESS
END MAP
MAP
INTEGER*4 END_OF_LIST
END MAP
END UNION
END STRUCTURE
RECORD /ATR_BLOCK/ ACB(2)
VOLATILE ACB
C
CCC DEFINE RECORD ATTRIBUTES BLOCK
C
STRUCTURE /REC_ATR_LAYOUT/
UNION
MAP
BYTE FAT$B_RTYPE
BYTE FAT$B_RATTRIB
INTEGER*2 FAT$W_RSIZE
UNION
MAP
INTEGER*4 FAT$L_HIBLK
END MAP
MAP
INTEGER*2 FAT$W_HIBLKH
INTEGER*2 FAT$W_HIBLKL
END MAP
END UNION
UNION
MAP
INTEGER*4 FAT$L_EFBLK
END MAP
MAP
INTEGER*2 FAT$W_EFBLKH
INTEGER*2 FAT$W_EFBLKL
END MAP
END UNION
INTEGER*2 FAT$W_FFBYTE
BYTE FAT$B_BKTSIZE
BYTE FAT$B_VFCSIZE
INTEGER*2 FAT$W_MAXREC
INTEGER*2 FAT$W_DEFEXT
INTEGER*2 FAT$W_GBC
BYTE FAT$_RESERVED(6)
INTEGER*2 FAT$W_UNUSED
INTEGER*2 FAT$W_VERSIONS
END MAP
END UNION
END STRUCTURE
RECORD /REC_ATR_LAYOUT/ REC_ATR
VOLATILE REC_ATR
INTEGER*4 NUM_BLK_HILO
INTEGER*2 NUM_BLK_I2(2)
INTEGER*2 NUM_BLK_HI
INTEGER*2 NUM_BLK_LO
EQUIVALENCE (NUM_BLK_HILO,NUM_BLK_I2)
EQUIVALENCE (NUM_BLK_I2(1),NUM_BLK_HI)
EQUIVALENCE (NUM_BLK_I2(2),NUM_BLK_LO)
LOGICAL FIRST/.TRUE./
CDEBUG STUFF
INTEGER*4 DLUN /8/
CCCCCCCCCCCCCCCCC Begin executable code CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
FILEMAINT = 1 !INITIALIZE NORMAL RETURN
C================= BEGIN RE-ENTRANT LOGIC ===============================
C IF THE SYS$MODIFY QIO IS WAIT MODE THEN RE-ENTRANT LOGIC IS NOT USED.
C
CCC TEST IF FUNCTION IS ALREADY ACTIVE.
CCC THIS IS RE-ENTRANT LOGIC IF NOWAIT QIO IS USED...
C
IF (IN_WORK) THEN
D WRITE(DLUN,*)'IN_WORK SET'
ISTAT = SYS$READEF(%VAL(EF),STATE)
IF (ISTAT .EQ. SS$_WASSET) THEN
IF ( .NOT. IOSB.STATUS) THEN
FILEMAINT = IOSB.STATUS
D WRITE(DLUN,*)'IOSBRETURN'
RETURN
ENDIF
FILEMAINT = 1
IN_WORK = .FALSE.
RETURN
ELSE
FILEMAINT = 2
RETURN
ENDIF
ENDIF
C====================== END OF RE-ENTRANT LOGIC =========================
C
CCC GET THE FILE INFORMATION BLOCK (FIB) ADDRESS
C
FIB_DESCR(2) = %LOC(FIB)
C
CCC SET ACCESS CONTROL BIT TO OVERRIDE EXCLUSIVE USE.
C
BITS4 = FIB.FIB$L_ACCTL
BITS4 = JIBSET(BITS4,FIB$V_NOLOCK)
FIB.FIB$L_ACCTL = BITS4
C
CCC IF THIS IS THE FIRST TIME ENTERED INTO THIS ROUTINE THEN
CCC GET THE RECORD ATTRIBUTES FOR LATER USE.
C
IF (FIRST) THEN
FIRST = .FALSE.
C
CCC SET UP ATTRIBUTE CONTROL BLOCK
C
ACB(1).ATR_SIZE = ATR$S_RECATTR
ACB(1).ATR_TYPE = ATR$C_RECATTR
ACB(1).ATR_ADDRESS = %LOC(REC_ATR)
ACB(2).END_OF_LIST = 0
ISTAT = SYS$QIOW ( %VAL(EF),
1 %VAL(IO_CHANNEL),
1 %VAL(IO$_ACCESS),
2 %REF(IOSB),
3,
4,
5 %REF(FIB_DESCR) !P1
6, !P2
7, !P3
8, !P4
9, !P5
9 %REF(ACB), ) !P6
IF (.NOT. ISTAT) THEN
FILEMAINT = ISTAT
RETURN
ENDIF
D WRITE(DLUN,*)'REC_ATR/RSIZE/MAXREC/RTYPE:',
D 1 REC_ATR.FAT$W_RSIZE,REC_ATR.FAT$W_MAXREC,
D 2 REC_ATR.FAT$B_RTYPE
ENDIF
IF (ACTION .EQ. EXTEND) THEN
TEMP_BLOCKS = NUM_BLOCKS
C
CCC SET UP EXTEND FLAGS AND SIZE.
C
BITS2 = FIB.FIB$W_EXCTL
BITS2 = IBCLR(BITS2,FIB$V_TRUNC) !NO TRUNC
BITS2 = IBSET(BITS2,FIB$V_EXTEND) !EXTEND
BITS2 = IBSET(BITS2,FIB$V_ALCONB) !CTB??
FIB.FIB$W_EXCTL = BITS2
FIB.FIB$L_EXSZ = TEMP_BLOCKS
FIB.FIB$L_EXVBN = 0
ISTAT = SYS$QIOW ( %VAL(EF),
1 %VAL(IO_CHANNEL),
1 %VAL(IO$_MODIFY),
2 %REF(IOSB),
3,
4,
5 %REF(FIB_DESCR) !P1
6, !P2
7, !P3
8, !P4
9, !P5
9, ) !P6
IF (.NOT. ISTAT) THEN
FILEMAINT = ISTAT
RETURN
ENDIF
ENDIF
FILEMAINT = IOSB.STATUS !THIS ASSUMES WAIT-MODE
RETURN
End
*****************************************************************
subroutine get_qio_channel( lun,
1 chan,
1 fab_adr,
1 rab_adr)
integer*4 for$rab,
1 rab_adr,
1 fab_adr,
1 lun,
1 chan
c ________________________________________________________________________
rab_adr = for$rab(lun)
call get_fab_adr(%val(rab_adr),fab_adr)
call get_fab_chan(%val(fab_adr),chan)
return
end
*****************************************************************
Function DAQ_OPEN (FAB, RAB)
Implicit NONE
Logical*4 VERFLAG /.TRUE./
Character*12 VERSION
Parameter (VERSION='DAQ_OPEN 1.0')
Character*92 MSG ! Event logging message string
CC
Character*8 ME /'DAQ_OPEN'/
CHARACTER*128 DEV
CHARACTER*128 DIR
CHARACTER*128 NAME
CHARACTER*128 FNAME
BYTE DEVLEN
BYTE DIRLEN
BYTE NAMLEN
BYTE FNAMLEN
Integer*4 DAQ_OPEN
Integer*4 SYS$CREATE
Include '($FABDEF)'
Include '($RABDEF)'
Include '($NAMDEF)'
Record /FABDEF/ FAB
Record /RABDEF/ RAB
Record /NAMDEF/ NAM
c __________________________________________________________________
FAB.FAB$L_FOP = FAB.FAB$L_FOP .OR. FAB$M_CBT
FAB.FAB$L_FOP = FAB.FAB$L_FOP .OR. FAB$M_UFO
FAB.FAB$B_RAT = 0
DAQ_OPEN = SYS$CREATE(FAB)
Return
End
*****************************************************************
subroutine get_fab_adr(rab,fab_adr)
C implicit none
include '($rabdef)'
record /rabdef/ rab
integer*4 fab_adr
c ________________________________________________________________________
fab_adr = rab.rab$l_fab
return
end
*****************************************************************
subroutine get_fab_chan(fab,chan)
include '($fabdef)'
record /fabdef/ fab
integer*4 chan
c ________________________________________________________________________
chan = fab.fab$l_stv
return
end
|