| You need to get down to the ACP level. These two routines
should get you going.
ROUTINE ACP_EXTEND_FILE
(channel, ! INTEGER, READ ONLY, BY VALUE
! channel # of file to be extended
num_blks_to_extend ! INTEGER, READ ONLY, BY VALUE
! # of blocks to extend by
) = ! INTEGER
! last block allocated
!++
! FUNCTIONAL DESCRIPTION:
!
! The specified file (channel) is extended by num_blks_to_extend.
!
!
! IMPLICIT INPUTS:
! none
!
! IMPLICIT OUTPUTS:
! none
!
! ROUTINE VALUE:
! The new HIBLK# (current # blks allocated)
!
! SIDE EFFECTS:
! none
!--
BEGIN
LOCAL
hiblk,
status,
iosb: VECTOR [4, WORD],
fat: BLOCK [ATR$S_RECATTR, BYTE] ! File Attr Blk
INITIAL (REP ATR$S_RECATTR OF BYTE (0)),
fat_dsc: VECTOR [3, LONG] INITIAL (ATR$C_RECATTR ^ 16 OR ATR$S_RECATTR, fat, 0),
fib: BLOCK [FIB$K_EXTDATA, BYTE] ! File Info Blk
INITIAL (REP FIB$K_EXTDATA OF BYTE (0)),
fib_dsc: VECTOR [2, LONG] INITIAL (FIB$K_EXTDATA, fib);
!++
! First, read in the current attribute settings.
!--
status = $QIOW (CHAN = .channel,
FUNC = IO$_ACCESS, ! access function
IOSB = iosb, ! I/O status block
P1 = fib_dsc, ! FIB descriptor
P5 = fat_dsc); ! FAT descriptor
IF NOT .status THEN SIGNAL (.status);
IF NOT .iosb [0] THEN SIGNAL (.iosb [0]);
hiblk = .fat [FAT$W_HIBLKH] ^ 16 OR .fat [FAT$W_HIBLKL];
!++
! Extend the file by the number of blocks specified.
!--
fib [FIB$L_ACCTL] = FIB$M_WRITETHRU;
fib [FIB$W_EXCTL] = FIB$M_EXTEND; ! extend operation
fib [FIB$L_EXSZ] = .num_blks_to_extend; ! # blocks to extend
%IF %IO_TRACE %THEN
print (O$TEXT ('extending by '), $DECV (.fib [FIB$L_EXSZ]));
%FI
fib [FIB$L_EXVBN] = 0; ! where allocated (EOF)
hiblk = .hiblk + .num_blks_to_extend;
fat [FAT$W_EFBLKH] = .hiblk ^ -16;
fat [FAT$W_EFBLKL] = .hiblk AND %X'FFFF';
status = $QIOW (CHAN = .channel, ! file to modify
FUNC = IO$_MODIFY, ! modify function
IOSB = iosb, ! I/O status block
P1 = fib_dsc, ! FIB descriptor
P5 = fat_dsc);
IF NOT .status THEN SIGNAL (.status);
IF NOT .iosb [0] THEN SIGNAL (.iosb [0]);
%IF %IO_TRACE %THEN
print (O$TEXT ('new size: '), $DECV (.fib [FIB$L_EXVBN] + .fib [FIB$L_EXSZ] - 1), $CRLF);
%FI
RETURN .fib [FIB$L_EXVBN] + .fib [FIB$L_EXSZ] - 1 ! HIBLK#
END; !( ROUTINE ACP_EXTEND_FILE )
ROUTINE ACP_TRUNCATE_FILE
(channel, ! INTEGER, READ ONLY, BY VALUE
! channel # of file to be truncateed
where_to_truncate ! INTEGER, READ ONLY, BY VALUE
! # of blocks to truncate by
) = ! INTEGER
! last block in the file
!++
! FUNCTIONAL DESCRIPTION:
!
! The specified file (channel) is truncated at blk# where_to_truncate.
!
! NOTE: by convention, EFBLK (End of File Blk #) is always the VBN of the last
! used block, plus 1.
!
! IMPLICIT INPUTS:
! none
!
! IMPLICIT OUTPUTS:
! none
!
! ROUTINE VALUE:
! The new EFBLK# (End of File Blk #)
!
! SIDE EFFECTS:
! none
!--
BEGIN
LOCAL
efblk, ! End of File Blk # + 1
status,
iosb: VECTOR [4, WORD],
fat: BLOCK [ATR$S_RECATTR, BYTE] ! File Attr Blk
INITIAL (REP ATR$S_RECATTR OF BYTE (0)),
fat_dsc: VECTOR [3, LONG] INITIAL (ATR$C_RECATTR ^ 16 OR ATR$S_RECATTR, fat, 0),
fib: BLOCK [FIB$K_EXTDATA, BYTE] ! File Info Blk
INITIAL (REP FIB$K_EXTDATA OF BYTE (0)),
fib_dsc: VECTOR [2, LONG] INITIAL (FIB$K_EXTDATA, fib);
!++
! First, read in the current attribute settings.
!--
status = $QIOW (CHAN = .channel,
FUNC = IO$_ACCESS, ! access function
IOSB = iosb, ! I/O status block
P1 = fib_dsc, ! FIB descriptor
P5 = fat_dsc); ! FAT descriptor
IF NOT .status THEN SIGNAL (.status);
IF NOT .iosb [0] THEN SIGNAL (.iosb [0]);
!++
! Truncate the file at the specified blk#, and set the
! EFBLK# accordingly.
!--
fib [FIB$L_ACCTL] = FIB$M_WRITETHRU;
fib [FIB$W_EXCTL] = FIB$M_TRUNC; ! truncate operation
fib [FIB$L_EXSZ] = 0; ! # blocks deallocated
fib [FIB$L_EXVBN] = .where_to_truncate + 1; ! where truncated
%IF %IO_TRACE %THEN
print (O$TEXT ('truncating at '), $DECV (.fib [FIB$L_EXVBN]));
%FI
efblk = .where_to_truncate + 1;
fat [FAT$W_EFBLKL] = .efblk AND %X'FFFF'; ! EBK + 1
fat [FAT$W_EFBLKH] = .efblk ^ -16;
fat [FAT$W_FFBYTE] = 0; ! 1st free byte
status = $QIOW (CHAN = .channel, ! file to truncate
FUNC = IO$_DEACCESS, ! deaccess function
IOSB = iosb, ! I/O status block
P1 = fib_dsc, ! FIB descriptor
P5 = fat_dsc); ! FAT descriptor
IF NOT .status THEN SIGNAL (.status);
IF NOT .iosb [0] THEN SIGNAL (.iosb [0]);
%IF %IO_TRACE %THEN
print (O$TEXT ('new size: '), $DECV (.fib [FIB$L_EXVBN] - 1), $CRLF);
%FI
RETURN .efblk - 1 ! EOFBLK#
END; !( ROUTINE ACP_TRUNCATE_FILE )
|