Trailing-Edge
-
PDP-10 Archives
-
BB-P363B-SM_1985
-
t20/nmlt20/filt20.b36
There is 1 other file named filt20.b36 in the archive. Click here to see a list.
! PH4:<BUILD>FILT20.B36.2 4-Mar-83 16:54:33, Edit by GUNN
! A14 - Declare DEALLOC_BUFFER routine 'novalue' to be compatible with
! NMUFIL.BLI and FILT10.B36 after DECnet-10 merge.
!
! A13 - Fix references to FD_CURRENT_BUFFER to refer to the field rather
! than its address, since in BLISS-36 it doesn't fill the whole
! value.
! A12 - Fix A11 to convert response buffer address into a pointer.
! A11 - Add response pointer and length as parameters to NETWORK_OPEN.
! A10 - Add REQUIRE of FALACC.BLI module.
! A09 - Add code which was done in FAL_ACCESS for DAP_PUT, allowing for a
! common FALACC module.
! D08 - Move setting of BUFFER [BD_BIAS] from ALLOC_BUFFER to
! FAL_ACCESS routine.
! A07 - Remove FAL_ACCESS routine and move it to module FALACC.
! A06 - Fix FILE_OPEN to retry connection to remote FAL if first attempt fails.
! A05 - Fix READ%FILE and WRITE%FILE conversion for 18_FOR_16, writes one word
! to far (beyond end of buffer page).
! A04 - Update FD_LENGTH, FD_FILE_POSITION and BD_VALID in FAL%ACCESS on PUTs.
! A03 - Set bias in ALLOC buffer for remote buffer (needed for writes).
! A02 - Update DB_POINTER after any PMAP in READ_FILE.
! A01 - Update BD_REMAINING_COUNT in SEEK_FILE.
!
!
! This is the TOPS-20 System Specific portion of the NMUFIL utility module.
!
%routine ('ALLOC_BUFFER', FILE : ref FILE_DATA_BLOCK) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
bind
FIRST_BUFFER = .FILE [FD_CURRENT_BUFFER] : BUFFER_DATA_BLOCK;
local
BUFFER : ref BUFFER_DATA_BLOCK;
external routine
NMU$PAGE_GET;
BUFFER = NMU$MEMORY_GET (BUFFER_DATA_BLOCK_ALLOCATION);
BUFFER [BD_VALID] = $FALSE;
selectone .FILE [FD_LOCAL] of
set
[$TRUE] : ! Local file access
begin
!
! Get the number of a page to use as a buffer.
!
if (BUFFER [BD_ADDRESS] = NMU$PAGE_GET ()) eql 0
then
begin
return $FALSE
end;
%debug (FILE_TRACE,
(TRACE_INFO ('Page %O allocated as file buffer',
.BUFFER [BD_ADDRESS])));
!
! Convert the page number to an address and save it.
! Set up allocation and length of buffer.
! Build pointer to current position within buffer.
!
BUFFER [BD_ADDRESS] = .BUFFER [BD_ADDRESS] * PAGE_SIZE;
BUFFER [BD_ALLOCATION] = PAGE_SIZE;
BUFFER [BD_LENGTH] = PAGE_SIZE * (%bpval / .FILE [FD_BYTE_SIZE]);
end;
[$FALSE] : ! Remote file access
begin
if (BUFFER [BD_ADDRESS] = NMU$MEMORY_GET (REMOTE_BUFFER_ALLOCATION)) eql 0
then
begin
return $FALSE
end;
%debug (FILE_TRACE,
(TRACE_INFO ('Memory at address %O allocated as file buffer',
.BUFFER [BD_ADDRESS])));
BUFFER [BD_ALLOCATION] = REMOTE_BUFFER_ALLOCATION;
BUFFER [BD_LENGTH] = REMOTE_BUFFER_LENGTH;
end;
tes;
!
! Link buffer into buffer ring
!
if FIRST_BUFFER eql 0
then
begin
FILE [FD_CURRENT_BUFFER] = .BUFFER;
BUFFER [BD_NEXT] = .BUFFER;
end
else
begin
BUFFER [BD_NEXT] = .FIRST_BUFFER [BD_NEXT];
FIRST_BUFFER [BD_NEXT] = .BUFFER;
end;
return $TRUE
end; !End of ALLOC_BUFFER
%routine ('DEALLOC_BUFFER', FILE : ref FILE_DATA_BLOCK) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
bind
BUFFER_RING = .FILE [FD_CURRENT_BUFFER] : BUFFER_DATA_BLOCK ;
local
BUFFER : ref BUFFER_DATA_BLOCK ;
external routine
NMU$PAGE_RELEASE;
BUFFER = BUFFER_RING;
selectone .FILE [FD_LOCAL] of
set
[$TRUE] : ! Local file access
begin
NMU$PAGE_RELEASE ((.BUFFER [BD_ADDRESS] / PAGE_SIZE));
%debug (FILE_TRACE,
(TRACE_INFO ('File buffer page %O deallocated',
.BUFFER [BD_ADDRESS])));
end;
[$FALSE] : ! Remote file access
begin
NMU$MEMORY_RELEASE (.BUFFER [BD_ADDRESS], .BUFFER [BD_ALLOCATION]);
%debug (FILE_TRACE,
(TRACE_INFO ('File buffer at address %O deallocated',
.BUFFER [BD_ADDRESS])));
end;
tes;
BUFFER [BD_ADDRESS] = 0;
BUFFER [BD_LENGTH] = 0;
BUFFER [BD_ALLOCATION] = 0;
if .BUFFER [BD_NEXT] eql .BUFFER
then FILE [FD_CURRENT_BUFFER] = 0
else FILE [FD_CURRENT_BUFFER] = .BUFFER [BD_NEXT];
NMU$MEMORY_RELEASE (.BUFFER, BUFFER_DATA_BLOCK_ALLOCATION);
return $TRUE
end; !End of DEALLOC_BUFFER
%routine ('OPEN_FILE', FILE : ref FILE_DATA_BLOCK, FN : ref FILE_NAME_BLOCK) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Performs system specific functions to allow access to a
! file. Sets various fields within the FILE_BLOCK. A NICE
! response message is written if the open fails.
!
! FORMAL PARAMETERS
!
! FILE - Address of a file data block.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! $TRUE, if file is successfully opened;
! $FALSE, otherwise.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
GTJFN_FLAGS,
OPENF_FLAGS;
DECLARE_JSYS (GTJFN,OPENF,GTFDB,CHFDB);
selectone .FILE [FD_LOCAL] of
set
[1] : ! Local file access
begin
GTJFN_FLAGS = GJ_SHT ;
if .FILE[FD_ACCESS] eql FILE_ACCESS_READ_ONLY
then GTJFN_FLAGS = .GTJFN_FLAGS or GJ_OLD
else GTJFN_FLAGS = .GTJFN_FLAGS or GJ_FOU;
OPENF_FLAGS = (FLD ((if .FILE[FD_FORMAT] eql FILE_FORMAT_18_FOR_16
then 18
else if .FILE[FD_FORMAT] eql FILE_FORMAT_BYTE_STREAM
then 8
else 36), OF_BSZ)
or (if .FILE[FD_ACCESS] eql FILE_ACCESS_READ_ONLY
then OF_RD
else if .FILE[FD_ACCESS] eql FILE_ACCESS_WRITE_ONLY
then OF_WR
else (OF_RD or OF_WR)));
!
! Get a JFN to the file. Use file name string in FD_NAME
! because GTJFN needs ASCIZ string.
!
if not $$GTJFN (.GTJFN_FLAGS, ch$ptr(FILE [FD_NAME]); FILE [FD_JFN])
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE, .FILE [FD_TYPE],
'GTJFN failure: %J', -1);
return $FALSE;
end;
%debug (FILE_TRACE,
(TRACE_INFO ('Local file system assigned JFN %O',
.FILE [FD_JFN])));
!
! Open the file for required access and byte size.
!
if not $$OPENF (.FILE [FD_JFN], .OPENF_FLAGS)
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE, .FILE [FD_TYPE],
'OPENF failure: %J', -1);
return $FALSE;
end;
!
! If file is being opened for write access only then it will
! be treated as a new file. Set its byte size in the FDB.
!
! Otherwise it must be an existing file. Determine its length
! in bytes and save in file data block.
!
if .FILE [FD_ACCESS] neq FILE_ACCESS_WRITE_ONLY
then
begin
local
FDB : vector [2];
bind
FDB_FBBYV = FDB [0],
FDB_FBSIZ = FDB [1];
!
! Get words .FBBYV (11) and .FBSIZ (12) of the files FDB.
!
if not $$GTFDB (.FILE [FD_JFN], ((2 ^ 18) or $FBBYV), FDB)
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FIO, .FILE [FD_TYPE],
'GTFDB failed');
return $FALSE
end;
!
! Save the number of file pages.
! Calculate and save the length of the file in bytes of size
! defined by contents of FD_BYTE_SIZE field in file data block.
!
FILE [FD_PAGE_COUNT] = .FDB_FBBYV<$P$S(FB_PGC)>; ! Save page count
FILE [FD_LENGTH] = .FDB_FBSIZ / (%bpval / .FDB_FBBYV<$P$S(FB_BSZ)>); ! Words in file
FILE [FD_LENGTH] = .FILE [FD_LENGTH] * (%bpval / .FILE [FD_BYTE_SIZE]); ! Bytes in file
%debug (FILE_TRACE,
(TRACE_INFO ('File has %D pages, %D (%D) bytes',
.FILE [FD_PAGE_COUNT],
.FILE [FD_LENGTH],
.FILE [FD_BYTE_SIZE])));
end
else
begin
local
FDB_FBBYV;
!
! Set word .FBBYV (11) of the files FDB, to reflect the
! files byte size.
!
if .FILE [FD_FORMAT] eql FILE_FORMAT_18_FOR_16
then
FDB_FBBYV = FLD (18, FB_BSZ)
else
FDB_FBBYV = FLD (.FILE [FD_BYTE_SIZE], FB_BSZ);
if not $$CHFDB ((CF_NUD or FLD ($FBBYV, CF_DSP)
or FLD (.FILE [FD_JFN], CF_JFN)),
FB_BSZ,
.FDB_FBBYV)
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FIO, .FILE [FD_TYPE],
'CHFDB failed');
return $FALSE
end;
%debug (FILE_TRACE,
(TRACE_INFO ('File byte size %D set',
.FILE [FD_BYTE_SIZE])));
end;
end;
[0] : ! Remote file access
begin
local
CONN_BLK : CONNECT_BLOCK,
NODE_BFR : vector [NODE_ID_BUFFER_SIZE],
NODE_PTR,
LENGTH,
RETRY,
TEMP; ! A convenient temporary
RETRY = 5;
!
! Open a logical link to FAL at the remote node.
!
while $true
do
begin
CONN_BLK [CB_OBJECT] = FAL_OBJECT;
CONN_BLK [CB_DESCRIPTOR_LENGTH] = 0;
CONN_BLK [CB_TASK_LENGTH] = 0;
!
! Attempt to map node name to node address
!
NODE_PTR = ch$ptr (NODE_BFR,,8);
PUTB (0,NODE_PTR);
PUTB (0,NODE_PTR);
PUTB (.FN [FN_HOST_LENGTH],NODE_PTR);
ch$move (.FN [FN_HOST_LENGTH], .FN [FN_HOST_POINTER], .NODE_PTR);
LENGTH = NODE_ID_BUFFER_LENGTH ;
%( N.B. - This needs to have NMULIB include NMXINT.REQ
$NML$MAP_NODE_ID (LENGTH, ! Map node number to name
.NODE_PTR) ;)%
CONN_BLK [CB_HOST] = ch$ptr (NODE_BFR,,8);
CONN_BLK [CB_HOST_LENGTH] = .LENGTH;
CONN_BLK [CB_USERID_LENGTH] = .FN [FN_USER_LENGTH];
CONN_BLK [CB_USERID] = .FN [FN_USER_POINTER];
CONN_BLK [CB_ACCOUNT_LENGTH] = .FN [FN_ACCOUNT_LENGTH];
CONN_BLK [CB_ACCOUNT] = .FN [FN_ACCOUNT_POINTER];
CONN_BLK [CB_PASSWORD_LENGTH] = .FN [FN_PASSWORD_LENGTH];
CONN_BLK [CB_PASSWORD] = .FN [FN_PASSWORD_POINTER];
CONN_BLK [CB_DATA_LENGTH] = 0;
if (FILE [FD_JFN] = NMU$NETWORK_OPEN (SOURCE_LINK, CONN_BLK,
ch$ptr(.FILE[FD_RESPONSE],,8), %ref(120), NICE$_LCF)) lss 0
then
if (RETRY = .RETRY - 1) gtr 0
then
begin
external routine NMU$SCHED_SLEEP;
NMU$SCHED_SLEEP (5);
end
else
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE,
.FILE [FD_TYPE],
'Could not connect to remote FAL');
return $false;
end
else exitloop;
end;
%debug (FILE_TRACE,
(TRACE_INFO ('Connected to FAL at node (%#A)',
.FN [FN_HOST_LENGTH],
.FN [FN_HOST_POINTER],
.FILE [FD_JFN])));
!
! Open file on remote HOST.
!
if not FAL_ACCESS (.FILE, DAP_OPEN,
.FN [FN_NAME_POINTER],
.FN [FN_NAME_LENGTH])
then
begin
return $FALSE;
end;
end;
tes;
$TRUE
end; !End of OPEN_FILE
%routine ('READ_FILE', FILE : ref FILE_DATA_BLOCK) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS
!
! NONE.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
bind
BUFFER = .FILE [FD_CURRENT_BUFFER] : BUFFER_DATA_BLOCK,
BYTES_PER_PAGE = ((%bpval / .FILE [FD_BYTE_SIZE]) * PAGE_SIZE);
local
FILE_PAGE,
BUFFER_PAGE,
FLAG_COUNT;
DECLARE_JSYS (PMAP);
!
! Handle case of seek being done. If the data in the buffer is valid
! and the file current position falls within the range of this buffer
! then all that needs to be done is to update the remaining count,
! and buffer current position.
!
if .FILE [FD_SEEK_DONE]
then
begin
FILE [FD_SEEK_DONE] = $FALSE;
if (.FILE [FD_CURRENT_POSITION] geq .BUFFER [BD_FILE_POSITION])
and (.FILE [FD_CURRENT_POSITION] leq .BUFFER [BD_MAX_POSITION])
then
begin
BUFFER [BD_CURRENT_POSITION] = .FILE [FD_CURRENT_POSITION] -
.BUFFER [BD_FILE_POSITION];
BUFFER [BD_REMAINING_COUNT] = .BUFFER [BD_DATA_COUNT] -
.BUFFER [BD_CURRENT_POSITION];
BUFFER [BD_POINTER] = ch$ptr (.BUFFER [BD_ADDRESS],
(.BUFFER [BD_CURRENT_POSITION] +
.BUFFER [BD_BIAS]),
.FILE [FD_BYTE_SIZE]);
return $TRUE
end;
end;
selectone .FILE [FD_LOCAL] of
set
[$TRUE] : ! Local file access
begin
!
! This buffer is at next position to read from file.
!
BUFFER [BD_FILE_POSITION] = .FILE [FD_FILE_POSITION];
!
! Set up to do PMAP. Get the files JFN. Calculate a page number
! in the file to be mapped. Page will be mapped into our process
! at page number determined by address in BD_ADDRESS. Preload
! the page and allow copy-on-write access.
!
! Note that by using PMAP we can go directly to the page
! indicated by current position. Sequential access would
! require multiple file reads.
!
FILE_PAGE<18,18> = .FILE [FD_JFN];
FILE_PAGE<0,18> = .FILE [FD_CURRENT_POSITION] / BYTES_PER_PAGE;
BUFFER_PAGE<18,18> = $FHSLF;
BUFFER_PAGE<0,18> = .BUFFER [BD_ADDRESS] / PAGE_SIZE;
FLAG_COUNT = PM_PLD or PM_RD or PM_CPY;
!
! Assuming a sequential file the current page to be mapped
! should be less than the number of pages in the file.
!
if (.FILE_PAGE<0,18> + 1) gtr .FILE [FD_PAGE_COUNT]
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FIO, .FILE [FD_TYPE],
'Page to be mapped from file greater than page count');
return $FALSE
end;
if not $$PMAP (.FILE_PAGE,.BUFFER_PAGE,.FLAG_COUNT)
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FIO, .FILE [FD_TYPE],
'PMAP failed to read file');
return $FALSE
end;
%debug (FILE_TRACE,
(TRACE_INFO ('File page %O mapped to page %O, (%D. pages)',
.FILE_PAGE<0,18>,
.BUFFER_PAGE<0,18>,
.FILE_PAGE<0,18>)));
BUFFER [BD_CURRENT_POSITION] = .FILE [FD_CURRENT_POSITION] mod BYTES_PER_PAGE;
BUFFER [BD_MAX_POSITION] = min ((.BUFFER [BD_FILE_POSITION] + BYTES_PER_PAGE),
(.FILE [FD_LENGTH] - .BUFFER [BD_FILE_POSITION]));
BUFFER [BD_POINTER] = ch$ptr (.BUFFER [BD_ADDRESS],
.BUFFER [BD_CURRENT_POSITION],
.FILE [FD_BYTE_SIZE]);
if (.FILE [FD_CURRENT_POSITION] + BYTES_PER_PAGE) geq .FILE [FD_LENGTH]
then
begin
BUFFER [BD_END_OF_FILE] = $TRUE;
BUFFER [BD_DATA_COUNT] = .FILE [FD_LENGTH] -
((.FILE [FD_CURRENT_POSITION] / BYTES_PER_PAGE)
* BYTES_PER_PAGE);
BUFFER [BD_REMAINING_COUNT] = .FILE [FD_LENGTH] -
.FILE [FD_CURRENT_POSITION];
%debug (FILE_TRACE,
(TRACE_INFO ('Partial page EOF, %D data bytes, %D bytes remaining',
.BUFFER [BD_DATA_COUNT],
.BUFFER [BD_REMAINING_COUNT])));
end
else
begin
BUFFER [BD_REMAINING_COUNT] = BYTES_PER_PAGE -
.BUFFER [BD_CURRENT_POSITION];
BUFFER [BD_DATA_COUNT] = BYTES_PER_PAGE;
%debug (FILE_TRACE,
(TRACE_INFO ('Full page, %D bytes remaining',
.BUFFER [BD_REMAINING_COUNT])));
end;
!
! Update position in file.
!
FILE [FD_FILE_POSITION] = .BUFFER [BD_FILE_POSITION] +
.BUFFER [BD_DATA_COUNT];
!
! Convert buffer to contiguous 8 bit bytes.
!
if .FILE [FD_FORMAT] eql FILE_FORMAT_18_FOR_16
then
begin
local
WORD16_PTR,
WORD16,
BYTE8_PTR;
WORD16_PTR = ch$ptr (.BUFFER [BD_ADDRESS],,18);
BYTE8_PTR = ch$ptr (.BUFFER [BD_ADDRESS],,8);
decr N from (PAGE_SIZE * (%bpval / 18)) - 1 to 0
do
begin
WORD16 = ch$rchar_a (WORD16_PTR);
PUTW (WORD16,BYTE8_PTR);
end;
end;
end;
[$FALSE] : ! Remote file access
begin
%debug (FILE_TRACE,
(TRACE_INFO ('FD_CURRENT_POSITION = %D. %1-(%O)',
.FILE [FD_CURRENT_POSITION])));
do
begin
BUFFER [BD_FILE_POSITION] = .FILE [FD_FILE_POSITION];
if not FAL_ACCESS (.FILE, DAP_GET, .BUFFER [BD_LENGTH],
ch$ptr (.BUFFER [BD_ADDRESS],,8))
then
begin
return $FALSE;
end;
FILE [FD_FILE_POSITION] = .BUFFER [BD_FILE_POSITION] +
.BUFFER [BD_DATA_COUNT];
BUFFER [BD_MAX_POSITION] = .BUFFER [BD_FILE_POSITION] +
.BUFFER [BD_DATA_COUNT];
%debug (FILE_TRACE,
(TRACE_INFO ('BD_FILE_POSITION = %D. %1-(%O)',
.BUFFER [BD_FILE_POSITION])));
%debug (FILE_TRACE,
(TRACE_INFO ('BD_MAX_POSITION = %D. %1-(%O)',
.BUFFER [BD_MAX_POSITION])));
%debug (FILE_TRACE,
(TRACE_INFO ('FD_FILE_POSITION = %D. %1-(%O)',
.FILE [FD_FILE_POSITION])));
end
until (.FILE [FD_CURRENT_POSITION] geq .BUFFER [BD_FILE_POSITION]
and
.FILE [FD_CURRENT_POSITION] lss .BUFFER [BD_MAX_POSITION]);
BUFFER [BD_CURRENT_POSITION] = .FILE [FD_CURRENT_POSITION] -
.BUFFER [BD_FILE_POSITION];
BUFFER [BD_REMAINING_COUNT] = .BUFFER [BD_DATA_COUNT] -
.BUFFER [BD_CURRENT_POSITION];
BUFFER [BD_POINTER] = ch$ptr (.BUFFER [BD_ADDRESS],
(.BUFFER [BD_CURRENT_POSITION] +
.BUFFER [BD_BIAS]),
.FILE [FD_BYTE_SIZE]);
end;
tes;
!
! Buffer now has valid data.
! File is now positioned by amount of data read.
!
BUFFER [BD_VALID] = $TRUE;
return $TRUE
end; !End of READ_FILE
%routine ('WRITE_FILE', FILE : ref FILE_DATA_BLOCK) =
!++
! Functional description
!
! This routine writes a buffer (the current one) to the specified
! location in the file. The whole page is written to the file.
!
! Note: This routine does not handle multi-buffering!!
! This routine does not handle non-contiguous writes!!
!
! Formal parameters
!
! .FILE Address of file data block
!
! Implicit inputs:
!
! File level
!
! FD_LOCAL flag to indicate local or remote file system
! FD_FORMAT value indicating type of file being written
! FD_JFN TOPS20 JFN of output file
! FD_BYTE_SIZE number of bits per byte in buffer
! FD_RESPONSE pointer to response buffer (on errors only)
! FD_TYPE DECnet NM file type (on errors only)
!
! Buffer level
!
! BD_FILE_POSITION where to start writting data in file
! BD_ADDRESS address of buffer page containing data
! BD_DATA_COUNT number of bytes in buffer to be written
!
! Implicit outputs:
!
! File level
!
! FD_PAGE_COUNT number of pages that have been written to file
! FD_LENGTH number of bytes that have been written to file
! FD_FILE_POSITION byte position of page after written page
!
! Buffer level
!
! BD_VALID set to false to indicate buffer data block no
! longer describes a valid buffer
!
! Routine value
!
! $true if the write succeeds
! $false if the write fails, response pointer in the file data
! block is used to illuminate the error.
!
!--
begin
bind
BUFFER = .FILE [FD_CURRENT_BUFFER] : BUFFER_DATA_BLOCK,
BYTES_PER_PAGE = ((%bpval / .FILE [FD_BYTE_SIZE]) * PAGE_SIZE);
local
FILE_PAGE,
BUFFER_PAGE,
FLAG_COUNT;
DECLARE_JSYS (PMAP);
if .FILE [FD_LOCAL]
then
begin
!
! Convert buffer from contiguous 8 bit bytes to 2 bytes
! per 18 bit halfword.
!
if .FILE [FD_FORMAT] eql FILE_FORMAT_18_FOR_16
then
begin
local
WORD36_PTR,
WORD36,
WORD16_PTR,
WORD16,
BYTE8_PTR;
WORD16_PTR = ch$ptr (.BUFFER [BD_ADDRESS],,18);
WORD36_PTR = ch$ptr (.BUFFER [BD_ADDRESS],,36);
decr N from PAGE_SIZE - 1 to 0
do
begin
WORD36 = ch$rchar_a (WORD36_PTR); ! Fetch 4 bytes
BYTE8_PTR = ch$ptr (WORD36,,8); ! Point to these 4 bytes
WORD16 = GETW (BYTE8_PTR); ! Get a 16 bit word
ch$wchar_a (.WORD16,WORD16_PTR); ! Store as 18 bits
WORD16 = GETW (BYTE8_PTR); ! Get next 16 bit word
ch$wchar_a (.WORD16,WORD16_PTR); ! Store as 18 bits
end;
end;
!
! Set up to do PMAP. Get the files JFN. Calculate a page number
! in the file to be mapped. Page will be mapped from our process
! at page number determined by address in BD_ADDRESS.
!
FILE_PAGE<18,18> = .FILE [FD_JFN];
FILE_PAGE<0,18> = .BUFFER [BD_FILE_POSITION] / BYTES_PER_PAGE;
BUFFER_PAGE<18,18> = $FHSLF;
BUFFER_PAGE<0,18> = .BUFFER [BD_ADDRESS] / PAGE_SIZE;
FLAG_COUNT = PM_PLD or PM_RD or PM_WR or PM_CPY;
!
! Assuming a sequential file the current page to be mapped
! must be the same as the number of pages in the file.
!
if .FILE_PAGE<0,18> neq .FILE [FD_PAGE_COUNT]
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FIO, .FILE [FD_TYPE],
'Non-contiguous writes attempted');
return $FALSE
end;
if not $$PMAP (.BUFFER_PAGE,.FILE_PAGE,.FLAG_COUNT)
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FIO, .FILE [FD_TYPE],
'PMAP failed to write file: %J', -1);
return $FALSE
end;
%debug (FILE_TRACE,
(TRACE_INFO ('File page %O mapped from page %O',
.FILE_PAGE<0,18>,
.BUFFER_PAGE<0,18>)));
!
! Increment the number of file pages.
! Calculate and save the length of the file in bytes of size
! defined by contents of FD_BYTE_SIZE field in file data block.
!
FILE [FD_PAGE_COUNT] = .FILE [FD_PAGE_COUNT] + 1;
FILE [FD_LENGTH] = .FILE [FD_LENGTH] + .BUFFER [BD_DATA_COUNT];
FILE [FD_FILE_POSITION] = .BUFFER [BD_FILE_POSITION] + BYTES_PER_PAGE;
%debug (FILE_TRACE,
(TRACE_INFO ('File has %D pages, %D (%D) bytes',
.FILE [FD_PAGE_COUNT],
.FILE [FD_LENGTH],
.FILE [FD_BYTE_SIZE])));
!
! Invalidate buffer
!
BUFFER [BD_VALID] = $FALSE;
end
else
begin
local
RTN_COD;
RTN_COD = FAL_ACCESS (.FILE, DAP_PUT, .BUFFER [BD_LENGTH],
ch$ptr (.BUFFER [BD_ADDRESS],,8));
BUFFER [BD_VALID] = $FALSE;
FILE [FD_LENGTH] = .FILE [FD_LENGTH] +
.BUFFER [BD_DATA_COUNT];
FILE [FD_FILE_POSITION] = .BUFFER [BD_FILE_POSITION] +
.BUFFER [BD_DATA_COUNT];
return .RTN_COD;
end;
return $TRUE
end; !End of WRITE_FILE
%routine ('CLOSE_FILE', FILE : ref FILE_DATA_BLOCK) =
!++
! Functional description:
!
!
! Formal parameters:
!
! .FILE Address of file data block
!
! Implicit inputs:
!
!
! Routine value:
!
! $true close succeeded
! $false close failed
!
! Note: Even if this routine fails, the file is no longer open
! for access. Close failure means that any changes written
! to a file may not be saved.
!
!--
begin
DECLARE_JSYS (CLOSF,CHFDB);
if .FILE [FD_LOCAL]
then
begin
!
! If this is a new file then update file length
! in bytes and save in files FDB.
!
! NOTE: To handle the case of update mode access
! a flag must be maintained in the FD to indicate
! whether the file size has changed since it was
! opened and update the FDB only if it has changed
! to avoid updating when not necessary. This code
! will not do any updating now except for new files.
!
if .FILE [FD_ACCESS] eql FILE_ACCESS_WRITE_ONLY
then
begin
if .FILE [FD_FORMAT] eql FILE_FORMAT_18_FOR_16
then
begin
FILE [FD_LENGTH] = .FILE [FD_LENGTH] / (%bpval / .FILE [FD_BYTE_SIZE]);
FILE [FD_LENGTH] = .FILE [FD_LENGTH] * 2;
FILE [FD_BYTE_SIZE] = 18;
end;
if not $$CHFDB ((CF_NUD or FLD ($FBSIZ, CF_DSP)
or FLD (.FILE [FD_JFN], CF_JFN)),
-1,
.FILE [FD_LENGTH])
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_FIO, .FILE [FD_TYPE],
'CHFDB failed');
return $FALSE
end;
%debug (FILE_TRACE,
(TRACE_INFO ('File has %D pages, %D (%D) bytes',
.FILE [FD_PAGE_COUNT],
.FILE [FD_LENGTH],
.FILE [FD_BYTE_SIZE])));
end;
if not $$CLOSF (.FILE [FD_JFN])
then
begin
$RESPONSE (.FILE [FD_RESPONSE], NICE$_OPF, .FILE [FD_TYPE],
'Could not close file');
return $FALSE
end;
end
else
begin
!
! Close file with FAL. Don't care if it fails.
!
FAL_ACCESS (.FILE,DAP_CLOSE,0,0);
!
! Close the logical link to FAL.
!
NMU$NETWORK_CLOSE (.FILE [FD_JFN], 0, 0);
end;
return $TRUE
end; !End of CLOSE_FILE
require 'FALACC'; ! Include common FAL access routine
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:40
! Comment Rounding:+1
! End: