Google
 

Trailing-Edge - PDP-10 Archives - BB-X117B-SB_1986 - 10,7/nml/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: