Google
 

Trailing-Edge - PDP-10 Archives - BB-X117B-SB_1986 - 10,7/nml/nmufil.bli
There are 2 other files named nmufil.bli in the archive. Click here to see a list.
! UPD ID= 190, SNARK:<6.1.NML>NMUFIL.BLI.4,  10-Dec-84 14:45:16 by HALPIN
! Get MONSYM Library file out of default directory, not BLI:
!
! UPD ID= 96, SLICE:<6.1.NML>NMUFIL.BLI.3,  18-Sep-84 15:24:15 by GUNN
!WORK:<GUNN.NML>NMUFIL.BLI.2 21-Aug-84 10:01:16, Edit by GUNN
!
! Change to accomodate new LIBRARY conventions. MONSYM.L36 and JLNKG.L36
! are now explicity declared here rather than in NMULIB.
!
! UPD ID= 31, SNARK:<6.1.NML>NMUFIL.BLI.2,  24-May-84 16:15:45 by GLINDELL
! DSKT:NMUFIL.BLI[10,6026,NML702]  2-Feb-84 09:25:33, Edit by DAVENPORT
!
! Remove definition of FAL_ACCESS to remove compilation error.
!
! NET:<BRANDT.DEVELOPMENT>NMUFIL.BLI.1 8-Jun-82 11:59:30, Edit by BRANDT
!
! Ident 09.
!   Remove defn of literals for NODE_ID buffer.  They are never used
!   and are now defined in NMLCOM which causes duplicate defs in this
!   module.
!
! NET:<PECKHAM.DEVELOPMENT>NMUFIL.BLI.2  5-Jun-82 12:59:37, Edit by PECKHAM
!
! Ident 08.
! No code change - eliminate empty compound expression in NMU$FILE_WRITE
! to produce clean BLIS16 compilation.
!
! NET:<DECNET20-V3P0.XPT>NMUFIL-REAL.BLI.2 15-Jan-82 17:17:11, Edit by VOBA
!
! Ident 07.
! Change PARSE_ACCESS_CONTROL to use blanks as delimiters rather than
! semicolons.
!
! NET:<DECNET20-V3P0.XPT>NMUFIL.BLI.2  8-Jan-82 10:35:40, Edit by WEBBER
!
! Ident 06.
! Fix FILE_OPEN so that the data buffer is allocated before the file is
! opened.  This allows the lower-level open routine to set up the buffer
! descriptor.
!
! NET:<GROSSMAN>NMUFIL.BLI.2  9-Dec-81 01:11:50, Edit by GROSSMAN
!
! Put a conditional around the definition of FLD for Tops-10 only. FLD is
! defined in TENDEF on Tops-10 in exactly the same manner as it is here, so
! no conflict should occur between the various systems that this code runs on.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.MCB>NMUFIL.BLI.17  9-Oct-81 11:21:00, Edit by GUNN
!
! Ident 05.
! Change file position variables to accomodate more than 16 bits in MCB
! version and perform 32 bit arithmetic.
! Remove $RESPONSE_X macro, it is in NMULIB.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NMUFIL.BLI.9 12-Aug-81 09:57:56, Edit by JENNESS
!
! Ident 04.
! Fix CH$BYTE to generate the proper code in the MCB (-16 bit) version.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NMUFIL.BLI.5  8-Aug-81 14:02:05, Edit by GUNN
!
! Put $RESPONSE_X macro def in sources since it won't compile for NMLLIB.L16.
!
! NET:<DECNET20-V3P1.NML>NMUFIL.BLI.3  8-Aug-81 16:52:53, Edit by GUNN
!
! Ident 03.
! Change syntax of remote file spec as bypass caused by not being able to
! parse access control information with embedded spaces. Only works if
! last token on line.
!
! NET:<DECNET20-V3P1.BASELEVEL-2.SOURCES>NMUFIL.BLI.5  8-Aug-81 14:02:05, Edit by GUNN
!
! Put $RESPONSE_X macro def in sources since it won't compile for NMLLIB.L16.
!
! NET:<DECNET20-V3P1.NML>NMUFIL.BLI.2  8-Aug-81 13:07:31, Edit by GUNN
!
! Ident 02.
! Modify $RESPONSE macros to provide error number for MCB.
!
! NET:<DECNET20-V3P1.NMU>NMUFIL.BLI.2 31-Jul-81 10:08:02, Edit by JENNESS
!
! Ident 01
! Change REMOTE_BUFFER_LENGTH to 512 to match configuration message size.
!
! Ident 00
! Code copied from BL2SRC:NMUFIL.B36. This module represents significant
! changes to implement buffered I/O and remote file access.
!
module NMUFIL	(
		ident = 'X03.09'
		) =
begin

!
!			  COPYRIGHT (c) 1981 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! Facility: LSG DECnet Network Management
!
! Abstract:
!
!	This module provides a common interface for file system access.
!
! Environment:	User Mode on TOPS-20, TOPS-10, RSX-11/MCB
!
! Author: Steven M. Jenness & Dale C. Gunn, Creation date: 19-Jun-81
!
!--
!
! Include files:
!

library 'NMULIB';			! Get all required definitions

%if $TOPS20
    %then
	library 'MONSYM';			! Monitor symbols

	library 'JLNKG';			! JSYS linkage definitions
    %fi

!
! Table of contents
!

switches list (require);                ! Allow listing of specific code

forward routine
        NMU$FILE_INITIALIZE : novalue,  ! Initialize file interface
	NMU$FILE_OPEN,                  ! Open file for access
        PARSE_FILE_SPECIFICATION,       ! File syntax parser
        PARSE_ACCESS_CONTROL,           ! Access control parser
	NMU$FILE_READ,
	NMU$FILE_WRITE,
%if not $TOPS10 %then
        SETUP_WRITE_BUFFER : novalue,
%fi
	NMU$FILE_SEEK,
	NMU$FILE_SKIP,
	NMU$FILE_CLOSE,
%if $TOPS10 %then
	NMU$FILE_BUILD_BUFFERS,
	NMU$FILE_KILL_BUFFERS: novalue,
%fi
	FILE_ERROR,
	FIND_FILE_DATA_BLOCK,
        !
        ! System specific routines.
        !
        ALLOC_BUFFER,
        DEALLOC_BUFFER : novalue,
%if $TOPS20
%then
	FAL_ACCESS,
%fi
        OPEN_FILE,
	READ_FILE,
        WRITE_FILE,
        CLOSE_FILE;

!
! Macros:
!

!
! $32BIT_INTEGER - Build field for a 32 bit integer.
!

macro
     $32BIT_INTEGER =
         %if $MCB
         %then $sub_block (2)           ! Aligned 2 words for PDP-16
         %else $integer
         %fi %;

!	$P (mask) - Calculate bit position of a literal mask
!
!		where mask is a literal or symbol which defines a
!               field as a series of contiguous bits
!
!		returns pos, which may be used in a context such
!               as, ADDRESS<pos,siz>, or FIELD_NAME = [ADDR,pos,siz,sgn]
!

macro $P (MASK) =
      %nbitsu (MASK  and  - MASK) - 1 % ;


!	$S (mask) - Calculate size in bits of a literal mask
!
!		where mask is a literal or symbol which defines a
!               field as a series of contiguous bits
!
!		returns siz, which may be used in a context such
!               as, ADDRESS<pos,siz>, or FIELD_NAME = [ADDR,pos,siz,sgn]
!

macro $S (MASK) =
      %nbitsu (MASK) - %nbitsu (MASK  and  - MASK) + 1 % ;


!	$P$S (mask) - Calculate bit position and size of a literal mask
!
!		where mask is a literal or symbol which defines a
!               field as a series of contiguous bits
!
!		returns "pos , siz", which may be used in a context such
!               as, ADDRESS<pos,siz>, or FIELD_NAME = [ADDR,pos,siz,sgn]
!
!		E.g, XCB_1 = [2,$P$S(XCB_MASK),0]

macro $P$S (MASK) =
      $P (MASK) , $S (MASK) % ;

! The following macro is already defined on Tops-10 in TENDEF.
%if not $TOPS10 %then
macro
     FLD (VAL, MASK) =
         ((VAL) ^ (%nbitsu(MASK  and  - MASK) - 1)) %;
%fi

%if not $MCB
%then
macro
     CH$BYTE [B1,B2,B3,B4] =
         ((B1 ^ (%bpval-8))
          %if not %null(B2)
          %then
               or (B2 ^ (%bpval-16))
          %if not %null(B3)
          %then
               or (B3 ^ (%bpval-24))
          %if not %null(B4)
          %then
               or (B4 ^ (%bpval-32))
          %fi %fi %fi) %;
%else
macro
     CH$BYTE [B1, B2] =
         (B1
          %if not %null (B2)
          %then
               or (B2 ^ 8)
          %fi) %;
%fi

%if not $TOPS10 %then
macro
     FILE_SYS_SPEC_FIELDS =
         FD_JFN = [$integer],           ! JFN of file
         %if not $MCB
         %then
         FD_NAME = [$string (MAX_FILE_NAME_LENGTH + 1)], ! Buffer for file name
         %fi
         FD_PAGE_COUNT = [$integer]     ! Number of pages in file
         %;
%fi

%if $TOPS10 %then
macro
    FILE_SYS_SPEC_FIELDS =
	FD_CHANNEL = [$integer],	! I/O channel for this file
	FD_BUFFER_HEADERS = [$integer]	! I/O buffer headers
%;
%fi

macro
     FILE_DATA_BLOCK = block [FILE_DATA_BLOCK_SIZE]
                       field (FILE_DATA_FIELDS) %;

%if not $TOPS10 %then
macro
     BUFFER_DATA_BLOCK = block [BUFFER_DATA_BLOCK_SIZE]
                         field (BUFFER_DATA_FIELDS) %;
%fi

!macro
!     FILE_BUFFER_BLOCK = block [FILE_DATA_BLOCK_SIZE+BUFFER_DATA_BLOCK_SIZE]
!                         field (FILE_DATA_FIELDS,BUFFER_DATA_FIELDS) %;

macro
     FILE_NAME_BLOCK = block [FILE_NAME_FIELDS_SIZE]
                       field (FILE_NAME_FIELDS) %;

!
! Equated symbols:
!

%module_name ('NMUFIL');

literal
       REMOTE_BUFFER_LENGTH = 512,
       REMOTE_BUFFER_ALLOCATION = ch$allocation (REMOTE_BUFFER_LENGTH,8) * %upval;

!
! Operating System Interface Definitions 
!

%if $TOPS20 %then

DECLARE_JSYS (GTJFN, OPENF, BIN, BOUT, CLOSF, SFPTR, RFPTR)

literal
       PAGE_SIZE = 512;

%else 
%if $TOPS10 %then
%else
%if $MCB %then
%fi %fi %fi

literal
       DAP_OPEN = 1,
       DAP_PUT = 2,
       DAP_GET = 3,
       DAP_CLOSE = 4;

literal
       MAX_FILE_NAME_LENGTH = 255;

!
! FILE DATA BLOCK Structure Field Names
!

$field
      FILE_DATA_FIELDS =
          set
          FILE_SYS_SPEC_FIELDS,             ! System specific fields
          FD_TYPE = [$byte],                ! ** File type **
          FD_ACCESS = [$tiny_integer],      ! Accessing method
          FD_FORMAT = [$tiny_integer],      ! Format of data in file
          FD_BYTE_SIZE = [$tiny_integer],   ! Byte size as per format
          FD_RESPONSE = [$pointer],         ! Pointer to NICE response buffer
          FD_CURRENT_POSITION = [$32BIT_INTEGER], ! Current byte offset as set by
                                            ! READ, SEEK, SKIP, or WRITE
          FD_FILE_POSITION = [$32BIT_INTEGER], ! Position of next read from file
          FD_LENGTH = [$32BIT_INTEGER],     ! Size of file in bytes
          FD_CURRENT_BUFFER = [$address],   ! Address of current BD block
%( Not yet used.
          FD_CHKPT_THRESHOLD = [$32BIT_INTEGER], ! Max bytes written before chkpnt
)%
          FD_DAP_STATE = [$tiny_integer],   ! DAP access state
          FD_LOCAL = [$bit],                ! Local/remote file access
          FD_SEEK_DONE = [$bit]             ! Seek operation has been done
          tes;

literal
       FILE_DATA_BLOCK_SIZE = $field_set_size,
       FILE_DATA_BLOCK_ALLOCATION = $field_set_units;

literal
       FILE_ACCESS_READ_ONLY = 1,       ! File is read only
       FILE_ACCESS_WRITE_ONLY = 2,      ! File is write only
       FILE_ACCESS_RANDOM = 3;          ! Read/write and backwards seeks

literal
       FILE_FORMAT_BYTE_STREAM = 1,     ! 8 bit byte stream
       FILE_FORMAT_18_FOR_16 = 2,       ! 18 bits in file for 16 bit data
       FILE_FORMAT_SWAPPED_BYTES = 3,   ! 16 bit bytes swapped
       FILE_FORMAT_WORD = 4;            ! Word mode (%bpval)

!
! BUFFER DATA BLOCK Structure Field Names
!

%if not $TOPS10 %then
$field
      BUFFER_DATA_FIELDS =
          set
          BD_NEXT = [$address],             ! Address of next BD in ring
          BD_ADDRESS = [$address],          ! Buffer base address
          BD_LENGTH = [$integer],           ! Buffer length in bytes
          BD_ALLOCATION = [$integer],       ! Buffer size in allocation units
          BD_FILE_POSITION = [$32BIT_INTEGER],    ! Buffer position in file
          BD_MAX_POSITION = [$32BIT_INTEGER], ! End of buffer position in file 
          BD_BIAS = [$integer],             ! Buffer bias to start of data
          BD_CURRENT_POSITION = [$integer], ! Current position in buffer
          BD_POINTER = [$pointer],          ! Current pointer to buffer
          BD_DATA_COUNT = [$integer],       ! Bytes read/written in buffer
          BD_REMAINING_COUNT = [$integer],  ! Bytes yet to be read from
                                            ! or written to buffer
          BD_CHANGED_COUNT = [$integer],    ! Number of bytes written in buffer
          BD_CHANGED = [$bit],              ! Buffer has changes flag
          BD_VALID = [$bit],                ! Buffer has valid data
          BD_END_OF_FILE = [$bit]           ! End of file flag
          tes;


literal
       BUFFER_DATA_BLOCK_SIZE = $field_set_size,
       BUFFER_DATA_BLOCK_ALLOCATION = $field_set_units;
%fi

%if $TOPS10 %then
literal
    $eof = 12345;		! Must be distinct from $true and $false
%fi

!
! File name block fields
!

$field
      FILE_NAME_FIELDS =
      set
      FN_LENGTH = [$integer],           ! Length of file specification string
      FN_HOST_LENGTH = [$integer],
      FN_USER_LENGTH = [$integer],
      FN_ACCOUNT_LENGTH = [$integer],
      FN_PASSWORD_LENGTH = [$integer],
      FN_NAME_LENGTH = [$integer],
      FN_POINTER = [$pointer],          ! Pointer file spec string
      FN_HOST_POINTER = [$pointer],
      FN_USER_POINTER = [$pointer],
      FN_ACCOUNT_POINTER = [$pointer],
      FN_PASSWORD_POINTER = [$pointer],
      FN_NAME_POINTER = [$pointer]
      tes;

literal
       FILE_NAME_FIELDS_SIZE = $field_set_size,
       FILE_NAME_FIELDS_ALLOCATION = $field_set_units;

!
! Remote file access definitions
!

literal
       FAL_OBJECT = 17,
       DAP_BFR_LENGTH = 512,
       DAP_BFR_SIZE = ch$allocation (DAP_BFR_LENGTH,8),
       DAP_BFR_ALLOCATION = DAP_BFR_SIZE * %upval ;


!
! Own storage:
!

own
   FILE_TABLE: initial (0) ;            ! Base address of file table data base

!
! External references:
!

external
        %debug_data_base;

external routine
         %if not $MCB %then NMU$TEXT, %fi
         NMU$TABLE_ROUTINES,
         NMU$NETWORK_UTILITIES,         ! DECnet logical link interface
         NMU$MEMORY_MANAGER;

%global_routine ('NMU$FILE_INITIALIZE') : novalue =

!++
! Functional description:
!
!	Initializes the file system at start up or restart time.
!       The internal file table data base is cleared and reset to
!       an initial state.
!
! Formal parameters: none
! Implicit inputs: none
!
! Routine value: none
! Side effects: none
!
!--

    begin

    NMU$TABLE_CLEAR (FILE_TABLE) ;

    %debug (FILE_TRACE,
            (TRACE_INFO ('File system interface initialized')));

    end;				! End of NMU$FILE_INITIALIZE
%global_routine ('NMU$FILE_OPEN', FILE_TYPE, HOST, FILE_NAME, RSP_PTR) =

!++
! Functional description:
!
!	This routine opens a file to be read. The FILE_TYPE specifies
!	the accessing technique. If the file can not be opened a NICE
!       response message is built using RSP_PTR.
!
! Formal parameters:
!
!       .FILE_NAME    Pointer to file spec string (counted ASCII)
!       .FILE_TYPE    Type of file
!                         FILE_PERMANENT_DATA_BASE
!                         FILE_SYSTEM_IMAGE
!                         FILE_DUMP_IMAGE
!                         FILE_SECONDARY_LOADER
!                         FILE_TERTIARY_LOADER
!                         FILE_SECONDARY_DUMPER
!       .RSP_PTR      Pointer to NICE response buffer
!
! Implicit inputs: none
!
! Routine value:
!
!       gtr 0   File identifier to be used on any future reference
!       leq 0   Error occured while opening file
!
! Side effects: none
!
!--

    begin

    local
         FN: FILE_NAME_BLOCK,
         FILE : ref FILE_DATA_BLOCK,
         FILE_ID;

    %debug (FILE_TRACE,
            (TRACE_INFO ('Opening file %#A',
                         ch$rchar (.FILE_NAME),
                         ch$plus (.FILE_NAME,1))));

    !
    ! Check to see if the file name has been specified.
    !

    if .FILE_NAME eql 0 or ch$rchar (.FILE_NAME) eql 0
    then
        begin
        $RESPONSE_X (.RSP_PTR, NICE$_FOE, .FILE_TYPE,
                     'File specification missing', 201);
        FILE_ID = 0;
        return .FILE_ID;
        end;

    !
    ! Check if file name is not too long.
    !

    if ch$rchar (.FILE_NAME) gtr MAX_FILE_NAME_LENGTH
    then
        begin
        $RESPONSE_X (.RSP_PTR, NICE$_FOE, .FILE_TYPE,
                     'File specification too long', 202);
        FILE_ID = 0;
        return .FILE_ID;
        end;

    !
    ! Allocate a file block and fill it in with known information.
    !

    FILE = NMU$MEMORY_GET (FILE_DATA_BLOCK_ALLOCATION);
    FILE [FD_TYPE] = .FILE_TYPE;        ! Save file type
    FILE [FD_RESPONSE] = .RSP_PTR ;     ! Save NICE response pointer

    FN[FN_POINTER] =.FILE_NAME;
    FN[FN_LENGTH] = ch$rchar_a (FN[FN_POINTER]); ! Get length from I-field

    selectone .FILE_TYPE of
        set
        [FILE_SYSTEM_IMAGE,
         FILE_SECONDARY_LOADER,
         FILE_TERTIARY_LOADER,
         FILE_SECONDARY_DUMPER] :
             begin
             FILE [FD_ACCESS] = FILE_ACCESS_READ_ONLY ;
             FILE [FD_FORMAT] = FILE_FORMAT_18_FOR_16 ;
             FILE [FD_BYTE_SIZE] = 8;
             end;

        [FILE_PERMANENT_DATA_BASE] :
             begin
             FILE [FD_ACCESS] = FILE_ACCESS_RANDOM ;
             FILE [FD_FORMAT] = FILE_FORMAT_SWAPPED_BYTES ; ! ** ?Word Mode? **
             FILE [FD_BYTE_SIZE] = %bpval;
             end;
        [FILE_DUMP_IMAGE] :
             begin
             FILE [FD_ACCESS] = FILE_ACCESS_WRITE_ONLY ;
             FILE [FD_FORMAT] = FILE_FORMAT_18_FOR_16 ;
             FILE [FD_BYTE_SIZE] = 8;
             end;
    tes;

    %if $TOPS20
    %then
    ch$copy (.FN[FN_LENGTH], .FN[FN_POINTER], 0,
             min ((.FN[FN_LENGTH] + 1), (MAX_FILE_NAME_LENGTH + 1)),
             ch$ptr (FILE [FD_NAME]));
    %fi

    !
    ! Parse the file specification and extract the node id and
    ! access control information. If node name is present set
    ! remote access mode.
    !

    if not PARSE_FILE_SPECIFICATION (.FILE, FN)
    then
        begin
        NMU$MEMORY_RELEASE (.FILE, FILE_DATA_BLOCK_ALLOCATION);
        FILE_ID = 0;
        return .FILE_ID;
        end;

    if .FN [FN_HOST_LENGTH] eql 0
    then
        FILE [FD_LOCAL] = $true
    else
        begin
        FILE [FD_LOCAL] = $false;
        FILE [FD_DAP_STATE] = 0;
        end;

    !
    ! Initialize the buffer ring. It is now a ring of 1 item.
    !

    FILE [FD_CURRENT_BUFFER] = 0;
    ALLOC_BUFFER (.FILE);


    !
    ! Open the file
    !

    %MOVI32 (0 , FILE [FD_LENGTH]);     ! Initialize length of file to zero.

    if not OPEN_FILE (.FILE, FN)
    then
        begin
        DEALLOC_BUFFER (.FILE);
        NMU$MEMORY_RELEASE (.FILE, FILE_DATA_BLOCK_ALLOCATION);
        FILE_ID = 0;
        return .FILE_ID;
        end;

    !
    ! Initialize the user's position in the file.
    ! Initialize NMU$FILE's position in the file.
    ! Indicate that no seeks have been done yet.
    !

    %MOVI32 (0 , FILE [FD_CURRENT_POSITION]);
    %MOVI32 (0 , FILE [FD_FILE_POSITION]);
    FILE [FD_SEEK_DONE] = $false;

    !
    ! Insert file block into the file table data base and return the
    ! index into the data base
    !

    FILE_ID = NMU$TABLE_INSERT (FILE_TABLE, .FILE);

    %debug (FILE_TRACE,
            (TRACE_INFO ('File id %O assigned to FD block at %O',
                         .FILE_ID,
                         .FILE)));

    return .FILE_ID

    end;				! End of NMU$FILE_OPEN

%routine ('PARSE_FILE_SPECIFICATION', FILE : ref FILE_DATA_BLOCK,
                                      FN : ref FILE_NAME_BLOCK) =

!++
! Functional description:
!
!	Parses a network file specification of the form:
!
!		NODE"USER;PASSWORD;ACCOUNT"::DIR:FILNAM.TYP
!
!	File specification fields in the file name block are 
!       filled in.
!
! Formal parameters:
!
!	.FILE    Address of File Data Block
!       .FN      Address of File Name Block
!
! Implicit inputs: none
!
! Routine value:
!
!	$true     if file syntax is valid
!       $false    otherwise
!
! Side effects: none
!
!--

    begin

    local
         BEG_PTR,
         TMP_PTR,
         TMP_LTH ;

    !
    ! Save pointer to file specification string and it's total length.
    !

    TMP_PTR = BEG_PTR = .FN [FN_POINTER] ;
    TMP_LTH = .FN [FN_LENGTH] ;

    !
    ! Search for a double colon ('::') to determine if it's 
    ! a network file specification.
    !

    if not ch$fail (TMP_PTR = ch$find_sub (.TMP_LTH,.BEG_PTR,2,CH$ASCII('::')))
    then begin

         !
         ! Found a double colon, so this is a network file specification.
         ! Save pointer to host node name.
         ! TMP_LTH will be set to length of file spec string up to '::'.
         ! Calculate length of file name portion of string.
         !

         FN [FN_HOST_POINTER] = .BEG_PTR ;
         TMP_LTH = ch$diff (.TMP_PTR,.BEG_PTR);
         FN [FN_NAME_LENGTH] = .FN [FN_LENGTH] - (.TMP_LTH + 2);

         !
         ! Determine if the optional access control information is present.
         !

         if ch$fail (TMP_PTR = ch$find_sub (.TMP_LTH,.BEG_PTR,1,CH$ASCII('"')))
         then begin

              !
              ! If no access control info then set length of host node name
              ! and lengths of user, password, and account as zero.
              !

              FN [FN_HOST_LENGTH] = .TMP_LTH;
              FN [FN_USER_LENGTH] = 0;
              FN [FN_ACCOUNT_LENGTH] = 0;
              FN [FN_PASSWORD_LENGTH] = 0;
              end
         else begin

              !
              ! Access control is present. Save length of host node name.
              ! Bump pointer past '"', and adjust for remaining length of
              ! the access control string.
              !

              FN [FN_HOST_LENGTH] = ch$diff (.TMP_PTR,.BEG_PTR);
              TMP_PTR = ch$plus (.TMP_PTR,1) ;
              TMP_LTH = .TMP_LTH - (.FN [FN_HOST_LENGTH] + 1);

              !
              ! Ensure that the access control string is terminated by '"'.
              ! If not return with error, otherwise parse the three
              ! access control fields.
              !

              if ch$fail (ch$find_sub (.TMP_LTH,.TMP_PTR,1,CH$ASCII('"')))
              then begin
                   $RESPONSE_X (.FILE [FD_RESPONSE], NICE$_FOE, .FILE[FD_TYPE],
                                'Access control terminator missing', 203);
                   return $false
                   end;

              PARSE_ACCESS_CONTROL (TMP_PTR,TMP_LTH,
                                    FN [FN_USER_POINTER],
                                    FN [FN_USER_LENGTH]);
              PARSE_ACCESS_CONTROL (TMP_PTR,TMP_LTH,
                                    FN [FN_PASSWORD_POINTER],
                                    FN [FN_PASSWORD_LENGTH]);
              PARSE_ACCESS_CONTROL (TMP_PTR,TMP_LTH,
                                    FN [FN_ACCOUNT_POINTER],
                                    FN [FN_ACCOUNT_LENGTH]);
              end;

         if .FN [FN_HOST_LENGTH] gtr 6
         then begin
              $RESPONSE_X (.FILE [FD_RESPONSE], NICE$_FOE, .FILE[FD_TYPE],
                           'Node name greater than 6 characters', 204);
              return $false
              end;

         !
         ! Store pointer to remainder of file name string.
         !

         FN [FN_NAME_POINTER] = ch$plus (.TMP_PTR,2);

         end
    else begin

         !
         ! If no '::' found then this is just a plain old local file
         ! specification.
         !

         FN [FN_HOST_LENGTH] = 0;
         FN [FN_NAME_POINTER] = .BEG_PTR;
         FN [FN_NAME_LENGTH] = .TMP_LTH;
         end;

    if .FN [FN_NAME_LENGTH] leq 0
    then begin
         $RESPONSE_X (.FILE [FD_RESPONSE], NICE$_FOE, .FILE[FD_TYPE],
                      'File name missing', 205);
         return $false
         end
    else if .FN [FN_NAME_LENGTH] gtr 255
         then begin
              $RESPONSE_X (.FILE [FD_RESPONSE], NICE$_FOE, .FILE[FD_TYPE],
                           'File name greater than 255 characters', 206);
              return $false
              end;

    return $true

    end;				! End of PARSE_FILE_SPECIFICATION
%routine ('PARSE_ACCESS_CONTROL', IPTR, ILEN, OPTR, OLEN) =

!++
! Functional description:
!
! 	Parses individual portions of the access control field.
!       IPTR and ILEN are updated to point past the parsed field.
!

! Formal parameters:
!
!       .IPTR    Address of Pointer to beginning of remainder of access 
!                  control field
!       .ILEN    Address of Length of remainder of access control fields
!       .OPTR    Address of Pointer to access control field
!       .OLEN    Address of Length of access control field
!
! Implicit inputs: none
!
! Routine value: none
! Side effects: none
!
!--

    begin

    local
         PTR,
         CHR;

    CHR = ch$rchar (..IPTR);            ! Get leading character
    while ((.CHR eql %c' ') or (.CHR eql %O'11')) and (..ILEN gtr 0)
    do begin                            ! Skip leading blanks
       .IPTR = ch$plus (..IPTR,1);      ! Advance pointer
       .ILEN = ..ILEN - 1;              ! Update remaining length
       CHR = ch$rchar (..IPTR);         ! Get next character
       end;

    ! Check for delimeters, i.e. blank and tab characters, or terminating
    ! character, i.e. double quote character

    if (..ILEN leq 0)
    or (ch$fail (PTR = ch$find_sub (..ILEN,..IPTR,1,CH$ASCII(' ')))
    and ch$fail (PTR = ch$find_sub (..ILEN,..IPTR,1,CH$ASCII(%char(%O'11'))))
    and ch$fail (PTR = ch$find_sub (..ILEN,..IPTR,1,CH$ASCII('"'))))
    then begin                          ! If cannot find field delimeter,
         .OLEN = 0;                     !  then indicate zero length field
         return $false;
         end
    else begin                          ! Found either delimeter or terminator
         .OLEN = ch$diff (.PTR,..IPTR); ! Return length of field
         .OPTR = ..IPTR;                ! Return pointer of field
         .IPTR = ch$plus (.PTR,1) ;     ! Fix up pointer to remaining string
         .ILEN = ..ILEN - (..OLEN + 1); ! Fix up remaining length of string
         return $true;
         end;

    end;				! End of PARSE_ACCESS_CONTROL
%global_routine ('NMU$FILE_READ', FILE_ID, DEST_PTR, DEST_COUNT, RSP_PTR) =

!++
! Functional description:
!
!        This routine reads a byte stream, of maximum length specified
!        by caller, from a file into callers buffer. The actual number
!        of bytes read is returned to caller.
!
! Formal parameters:
!
!       .FILE_ID      File identifier
!       .DEST_PTR     Pointer to buffer to receive the file data
!       .DEST_COUNT   Number of bytes to read into buffer
!       .RSP_PTR      Pointer to NICE response buffer
!
! Implicit inputs: none
!
! Routine value:
!
!        gtr 0    Error occured while reading file
!        eql 0    End of file encountered
!        lss 0    Number of bytes actually read from file
!
! Side effects: none
!
!--

    begin

    local
         FILE : ref FILE_DATA_BLOCK,
         XFR_COUNT;

    %debug (FILE_TRACE,
            (TRACE_INFO ('File id %O read request for %D bytes',
                         .FILE_ID,
                         .DEST_COUNT)));

    !
    ! Initialize the count of bytes to be transferred on this read.
    !

    XFR_COUNT = .DEST_COUNT;

    !
    ! Setup pointer to file data base
    !

    if (FILE = FIND_FILE_DATA_BLOCK (.FILE_ID, .RSP_PTR)) eql 0
    then
        return -1 ;

    !
    ! Set pointer to response buffer in file data block.
    !

    FILE [FD_RESPONSE] = .RSP_PTR;

%if not $TOPS10 %then
    !
    ! Set up and maintain the address of the current BD block
    ! for the file.
    !

    begin                               ! bind BUFFER context
    bind
        BUFFER = (FILE [FD_CURRENT_BUFFER]) : ref BUFFER_DATA_BLOCK ;


    !
    ! Check if buffer needs to be filled with data before
    ! transfer can take place.
    !

    if .FILE [FD_SEEK_DONE] or not .BUFFER [BD_VALID] 
    then
        begin
        if not READ_FILE (.FILE)
        then
            return -1;
        end;

    !
    ! Transfer the specified number of bytes
    !

    while .XFR_COUNT gtr 0
    do
      begin

      !
      ! If no more bytes to be read from current buffer and the buffer
      ! has been written into then write the buffer out.
      ! If at EOF exit now, else read more data from file to
      ! fill buffer.
      !

      if .BUFFER [BD_REMAINING_COUNT] leq 0
      then
          begin
          if .BUFFER [BD_CHANGED]
          then
              begin
              if not WRITE_FILE (.FILE)
              then
                  return -1;
              end;

          if .BUFFER [BD_END_OF_FILE]
          then
              exitloop;

          if not READ_FILE (.FILE)
          then
              return -1;

          end;

      begin                             ! bind BUFFER context
      bind
          BUFFER = (FILE [FD_CURRENT_BUFFER]) : ref BUFFER_DATA_BLOCK ;

      local
           MOVE_COUNT;

      !
      ! BUFFER must be bound each time through the loop since the
      ! current buffer data block pointed to by the file data block
      ! may get changed.
      !

      MOVE_COUNT = min (.XFR_COUNT, .BUFFER [BD_REMAINING_COUNT]);

      %debug (FILE_TRACE,
              (TRACE_INFO ('Moving %D bytes to user buffer from buffer position %D',
                           .MOVE_COUNT, .BUFFER [BD_CURRENT_POSITION])));

      %debug ((FILE_TRACE and FILE_DATA_TRACE),
              (FORMAT_BUFFER ('User buffer data',,
                              0, .BUFFER [BD_POINTER], .MOVE_COUNT)));

      DEST_PTR = ch$move (.MOVE_COUNT,
                          .BUFFER [BD_POINTER],
                          .DEST_PTR);

      BUFFER [BD_REMAINING_COUNT] = .BUFFER [BD_REMAINING_COUNT] - .MOVE_COUNT;
      BUFFER [BD_POINTER] = ch$plus (.BUFFER [BD_POINTER], .MOVE_COUNT);
      BUFFER [BD_CURRENT_POSITION] = .MOVE_COUNT;
      %ADDI32 (.MOVE_COUNT , FILE [FD_CURRENT_POSITION]);
      XFR_COUNT = .XFR_COUNT - .MOVE_COUNT;

      %debug (FILE_TRACE,
              (TRACE_INFO ('%D bytes remaining in buffer',
                           .BUFFER [BD_REMAINING_COUNT])));

      end;                              ! bind BUFFER context

      end;

    end;                                ! bind BUFFER context

%fi
%if $TOPS10 %then
    begin

	if .FILE [FD_SEEK_DONE] then
	begin
	    FILE [FD_SEEK_DONE] = $false;

	    while .FILE [FD_FILE_POSITION] lss .FILE [FD_CURRENT_POSITION] do
	    begin
		local
		    TEMP;

		selectone READ_FILE (.FILE, TEMP) of
		set
		    [$eof]: return 0;
		    [$true]: ;
		    [$false]: return -1;
		tes;

		FILE [FD_FILE_POSITION] = .FILE [FD_FILE_POSITION] + 1;

		if .FILE [FD_FORMAT] eql FILE_FORMAT_18_FOR_16 then
		FILE [FD_FILE_POSITION] = .FILE [FD_FILE_POSITION] + 1;
	    end;
	end;

	while .XFR_COUNT gtr 0 do
	begin
	    local
		DATA;

	    selectone READ_FILE (.FILE, DATA) of
	    set
		[$false]:	return -1;
		[$true]: ;
		[$eof]: exitloop;
	    tes;

	    ch$wchar_a (.DATA, DEST_PTR);
	    XFR_COUNT = .XFR_COUNT - 1;
	    FILE [FD_FILE_POSITION] = .FILE [FD_FILE_POSITION] + 1;

	    if .FILE [FD_FORMAT] eql FILE_FORMAT_18_FOR_16 then
	    begin
		ch$wchar_a (.DATA <8,8,0>, DEST_PTR);
		FILE [FD_FILE_POSITION] = .FILE [FD_FILE_POSITION] + 1;
		XFR_COUNT = .XFR_COUNT - 1;
	    end;
	end;

    end; ! Of Tops-10 specific stuff
%fi
    !
    ! Return the count of bytes read.
    !

    return .DEST_COUNT - .XFR_COUNT;

    end;				! End of NMU$FILE_READ

%global_routine ('NMU$FILE_WRITE', FILE_ID, SOURCE_PTR, WRITE_COUNT, RSP_PTR) =

!++
! Functional description:
!
!	Writes a byte stream, of length specified by caller, into a file.
!
! Formal parameters:
!
!	.FILE_ID       File identifier
!       .WRITE_COUNT   Number of bytes to write to the file
!       .SOURCE_PTR    Pointer to byte string to be written to file
!       .RSP_PTR       Pointer to NICE response buffer
!
! Implicit inputs: none
!
! Routine value:
!
!	$true    if data was written successfully to file
!       $false   otherwise
!
! Side effects: none
!
!--

    begin

    local
         FILE : ref FILE_DATA_BLOCK,
         XFR_COUNT,
         SETUP_NEEDED;

    %debug (FILE_TRACE,
            (TRACE_INFO ('Write request on file id %O, %D bytes',
                         .FILE_ID,
                         .WRITE_COUNT)));

    !
    ! Setup pointer to file data base
    !

    if (FILE = FIND_FILE_DATA_BLOCK (.FILE_ID, .RSP_PTR)) eql 0
    then return $false;

    !
    ! Set pointer to response buffer in file data block.
    ! Initialize the count of bytes to be transferred on this write.
    !

    XFR_COUNT = .WRITE_COUNT;
    FILE [FD_RESPONSE] = .RSP_PTR;
%if not $TOPS10 %then
    begin                               ! bind BUFFER context
    bind
        BUFFER = (FILE [FD_CURRENT_BUFFER]) : ref BUFFER_DATA_BLOCK ;

    if .BUFFER [BD_VALID]
    then
        begin
        %debug (FILE_TRACE,
                (TRACE_INFO ('Buffer valid')));

        if .FILE [FD_SEEK_DONE]
        then
            begin
            FILE [FD_SEEK_DONE] = $false;
            SETUP_NEEDED = $true;

            if (%CMP32 (FILE [FD_CURRENT_POSITION] , lss , BUFFER [BD_FILE_POSITION]))
               or
               (%CMP32 (FILE [FD_CURRENT_POSITION] , gtr , BUFFER [BD_MAX_POSITION]))
            then
                begin
                %debug (FILE_TRACE,
                        (TRACE_INFO ('File seek moved pointer out of current buffer')));
                if not WRITE_FILE (.FILE)
                then return $false;
                end
            else
                begin
                %debug (FILE_TRACE,
                        (TRACE_INFO ('File seek done within current buffer bounds')));
                0
                end
            end
        else
            SETUP_NEEDED = $false;
        end
    else
        begin
        %debug (FILE_TRACE,
                (TRACE_INFO ('Buffer invalid')));
        SETUP_NEEDED = $true;
        end;

    if .SETUP_NEEDED
    then SETUP_WRITE_BUFFER (.FILE);

    end;                                ! End of bind BUFFER context
    !
    ! Transfer the specified number of bytes into the buffer.
    !

    while .XFR_COUNT gtr 0
    do
      begin
      bind
          BUFFER = (FILE [FD_CURRENT_BUFFER]) : ref BUFFER_DATA_BLOCK ;

      local
           MOVE_COUNT;

      !
      ! BUFFER must be bound each time through the loop since the
      ! current buffer data block pointed to by the file data block
      ! may get changed.
      !

      MOVE_COUNT = min (.XFR_COUNT, .BUFFER [BD_REMAINING_COUNT]);

      %debug (FILE_TRACE,
              (TRACE_INFO ('Moving %D bytes from user buffer to buffer position %D',
                           .MOVE_COUNT, .BUFFER [BD_CURRENT_POSITION])));

      %debug ((FILE_TRACE and FILE_DATA_TRACE),
              (FORMAT_BUFFER ('User buffer data',,
                              0, .SOURCE_PTR, .MOVE_COUNT)));

      BUFFER [BD_POINTER] = ch$move (.MOVE_COUNT,
                                     .SOURCE_PTR,
                                     .BUFFER [BD_POINTER]);
      SOURCE_PTR = ch$plus (.SOURCE_PTR, .MOVE_COUNT);
      XFR_COUNT = .XFR_COUNT - .MOVE_COUNT ;

      BUFFER [BD_CURRENT_POSITION] = .MOVE_COUNT;

      BUFFER [BD_DATA_COUNT] = .BUFFER [BD_DATA_COUNT] + .MOVE_COUNT;
      BUFFER [BD_REMAINING_COUNT] = .BUFFER [BD_REMAINING_COUNT] - .MOVE_COUNT;
      BUFFER [BD_CHANGED_COUNT] = .BUFFER [BD_CHANGED_COUNT] + .MOVE_COUNT;
      BUFFER [BD_CHANGED] = $true;

      %debug (FILE_TRACE,
              (TRACE_INFO ('%D bytes remaining in buffer',
                           .BUFFER [BD_REMAINING_COUNT])));

      %ADDI32 (.MOVE_COUNT , FILE [FD_CURRENT_POSITION]);

      !
      ! If no more bytes can be written into this buffer
      ! write this buffer out.
      !

      if .BUFFER [BD_REMAINING_COUNT] leq 0
      then
          begin
          if not WRITE_FILE (.FILE)
          then return $false;

          SETUP_WRITE_BUFFER (.FILE);
          end;

      end;
%fi
%if $TOPS10 %then
    while .WRITE_COUNT gtr 0 do
    begin
	local DATA;

	if .FILE [FD_FORMAT] eql FILE_FORMAT_18_FOR_16 then
	begin
    	    DATA = GETW (SOURCE_PTR);
	    WRITE_COUNT = .WRITE_COUNT - 1;
	end
	else DATA = ch$rchar_a(SOURCE_PTR);

	WRITE_FILE (.FILE, .DATA);
	WRITE_COUNT = .WRITE_COUNT - 1;
    end;
%fi
	
    return $true

    end;				! End of NMU$FILE_WRITE

%if not $TOPS10 %then
%routine ('SETUP_WRITE_BUFFER', FILE : ref FILE_DATA_BLOCK) : novalue =

!++
! Functional description:
!
! Formal parameters:
!
!       .FILE    Address of file data block
!
! Implicit inputs: none
!
! Routine value: none
!
! Side effects: none
!
!--
    begin

    local
         TEMP32 : THIRTY_TWO_BIT;

    bind
        BUFFER = (FILE [FD_CURRENT_BUFFER]) : ref BUFFER_DATA_BLOCK,
        BYTE_SIZE = %if $MCB %then 8 %else .FILE [FD_BYTE_SIZE] %fi ;

    !
    ! Define limits of buffer with respect to location in the file.
    !

    %MOV32 (FILE [FD_FILE_POSITION] , BUFFER [BD_FILE_POSITION]);
    %MOV32 (BUFFER [BD_FILE_POSITION] , BUFFER [BD_MAX_POSITION]);
    %ADDI32 ((.BUFFER [BD_LENGTH] - .BUFFER [BD_BIAS] - 1) , BUFFER [BD_MAX_POSITION]);

%(
    BUFFER [BD_MAX_POSITION] = .BUFFER [BD_FILE_POSITION] +
                               .BUFFER [BD_LENGTH] -
                               .BUFFER [BD_BIAS] - 1;
)%

    !
    ! Define pointers into buffer, taking into account the fact
    ! that a seek may have been done (data transfer does not start
    ! at the beginning of the buffer).
    !

    %MOV32 (BUFFER [BD_FILE_POSITION] , TEMP32);
    %SUB32 (FILE [FD_CURRENT_POSITION] , TEMP32);
    %MOVF32 (TEMP32 , BUFFER [BD_DATA_COUNT]);
%( N.B. - Old code
    BUFFER [BD_DATA_COUNT] = .FILE [FD_CURRENT_POSITION] -
                             .BUFFER [BD_FILE_POSITION];
)%
    BUFFER [BD_CURRENT_POSITION] = .BUFFER [BD_DATA_COUNT];
    BUFFER [BD_REMAINING_COUNT] = .BUFFER [BD_LENGTH] -
                                  .BUFFER [BD_DATA_COUNT] -
                                  .BUFFER [BD_BIAS];
    BUFFER [BD_POINTER] = ch$ptr (.BUFFER [BD_ADDRESS],
                                  .BUFFER [BD_CURRENT_POSITION] + .BUFFER [BD_BIAS],
                                  BYTE_SIZE);

    !
    ! Indicate no changes have been made, the pointers into the
    ! buffer are now valid and point to the end of the file.
    !

    BUFFER [BD_CHANGED_COUNT] = 0;
    BUFFER [BD_VALID] = $true;
    BUFFER [BD_CHANGED] = $false;
    BUFFER [BD_END_OF_FILE] = $true;

    %debug (FILE_TRACE,
            (TRACE_INFO ('Buffer validated')));

    end;                                ! End of SETUP_WRITE_BUFFER
%fi
%global_routine ('NMU$FILE_SEEK', FILE_ID, BYTE_POSITION, RSP_PTR) =

!++
! Functional description:
!
!	Sets the current position within a file to an arbitrary
!       byte position. Subsequent reads or writes will begin at
!       the new byte position within the file.
!
! Formal parameters:
!
!	.FILE_ID         File identifier
!	.BYTE_POSITION   The byte offset at which the file is to positioned
!
! Implicit inputs: none
!
! Routine value:
!
!	$true     File positioned successfully
!       $false    Invalid ID or failure during seek
!
! Side effects: none
!
!--

    begin
    local
         FILE : ref FILE_DATA_BLOCK;

    %debug (FILE_TRACE,
            (TRACE_INFO ('File id %O seek request to byte position %D',
                         .FILE_ID,
                         .BYTE_POSITION)));

    !
    ! Setup pointer to file data base
    !

    if (FILE = FIND_FILE_DATA_BLOCK (.FILE_ID, .RSP_PTR)) eql 0
    then
        return $false;

    !
    ! Set pointer to response buffer in file data block.
    !

    FILE [FD_RESPONSE] = .RSP_PTR;

    !
    ! Ensure that the file is not positioned backwards if it
    ! is a remote file. DAP does not support it.
    !

    if (not .FILE [FD_LOCAL])
       and
       (%CMPI32 (FILE [FD_CURRENT_POSITION] , gtr , .BYTE_POSITION))
    then
        begin
        $RESPONSE_X (.FILE [FD_RESPONSE], NICE$_FIO, .FILE [FD_TYPE],
                     'Illegal operation on remote file', 207);
        return $false
        end;

    !
    ! Set current byte position within file.
    !

    %MOVI32 (.BYTE_POSITION , FILE [FD_CURRENT_POSITION]);
    FILE [FD_SEEK_DONE] = $true;

    %debug (FILE_TRACE,
            (local
                  CP;
             %MOVF32 (FILE [FD_CURRENT_POSITION] , CP);
             TRACE_INFO ('File at byte position %D',
                         .CP)));

    return $true

    end;				! End of NMU$FILE_SEEK

%global_routine ('NMU$FILE_SKIP', FILE_ID, BYTE_COUNT, RSP_PTR) =

!++
! Functional description:
!
!	This routine skips forward the specified number of bytes
!       in the file associated with the FILE_ID.
!
! Formal parameters:
!
!	.FILE_ID         File identifier
!       .BYTE_COUNT      Number of bytes to skip
!
! Implicit inputs: none
!
! Routine value:
!
!	$true     Bytes skipped successfully
!       $false    Invalid ID or failure during skip
!
! Side effects: none
!
!--

    begin
    local
         FILE : ref FILE_DATA_BLOCK;

    %debug (FILE_TRACE,
            (TRACE_INFO ('File id %O skip request %D bytes',
                         .FILE_ID,
                         .BYTE_COUNT)));

    !
    ! Setup pointer to file data base
    !

    if (FILE = FIND_FILE_DATA_BLOCK (.FILE_ID, .RSP_PTR)) eql 0
    then
        return $false;

    !
    ! Set pointer to response buffer in file data block.
    !

    FILE [FD_RESPONSE] = .RSP_PTR;

    !
    ! Increment current position in file by count of bytes specified.
    !

    %ADDI32 (.BYTE_COUNT , FILE [FD_CURRENT_POSITION]);
    FILE [FD_SEEK_DONE] = $true;

    %debug (FILE_TRACE,
            (local
                  CP;
             %MOVF32 (FILE [FD_CURRENT_POSITION] , CP);
             TRACE_INFO ('File at byte position %D',
                         .CP)));

    return $true

    end;				! End of NMU$FILE_SKIP

%global_routine ('NMU$FILE_CLOSE', FILE_ID, RSP_PTR) =

!++
! Functional description:
!
!	Closes a file and invalidates further access. Resources are
!       released and any buffered data is written to file.
!
! Formal parameters:
!
!	.FILE_ID    File identifier
!       .RSP_PTR    Pointer to NICE response buffer
!
! Implicit inputs: none
!
! Routine value:
!
!       $true     File closed successfully
!       $false    Invalid file id or unable to close file
!
! Side effects: none
!
!--

    begin
    local
         FILE : ref FILE_DATA_BLOCK;

    %debug (FILE_TRACE,
            (TRACE_INFO ('File id %O close requested',
                         .FILE_ID,)));

    !
    ! Setup pointer to file data base
    !

    if (FILE = FIND_FILE_DATA_BLOCK (.FILE_ID, .RSP_PTR)) eql 0
    then
        return $false;

    !
    ! Set pointer to response buffer in file data block.
    !

    FILE [FD_RESPONSE] = .RSP_PTR;

    !
    ! Set up and maintain the address of the current BD block
    ! for the file.
    !

    begin
    %if not $TOPS10 %then
    bind
        BUFFER = (FILE [FD_CURRENT_BUFFER]) : ref BUFFER_DATA_BLOCK ;

    !
    ! If buffer has been modified by write then flush it out to file.
    !

    if .BUFFER [BD_VALID] and .BUFFER [BD_CHANGED]
    then
        begin
        if not WRITE_FILE (.FILE)
        then
            return $false;
        end;
    %fi

    !
    ! Perform actions necessary to close the file.
    !

    if not CLOSE_FILE (.FILE)
    then
        return $false;

    !
    ! Deallocate all storage associated with the file.
    ! Delete FD from table. Release storage for FD.
    !

    DEALLOC_BUFFER (.FILE);

    NMU$TABLE_DELETE (FILE_TABLE, .FILE_ID);

    NMU$MEMORY_RELEASE (.FILE, FILE_DATA_BLOCK_ALLOCATION);

    %if not $TOPS10 %then
    %debug (FILE_TRACE,
            (TRACE_INFO ('File on JFN %O closed',
                         .FILE [FD_JFN])));

    %fi

    %if $TOPS10 %then
    %debug (FILE_TRACE,
	    (TRACE_INFO ('File on channel %O closed',
			 .FILE [FD_CHANNEL])));
    %fi
    end;                                ! End buffer context

    return $true

    end;				! End of NMU$FILE_CLOSE
%routine ('FILE_ERROR', FILE_ID, RSP_PTR) =

!++
! Functional description:
!
!	Builds a NICE response message which describes a file
!       error condition as set in the file data block.
!
! Formal parameters:
!
!	.FILE_ID     File identifier
!       .RSP_PTR     Pointer to NICE response buffer
!	.RTN_COD     NICE error response code
!
! Implicit inputs: none
!
! Routine value:
!
!	$true always
!
! Side effects: none
!
!--

    begin

    return $TRUE

    end;				! End of FILE_ERROR
%routine ('FIND_FILE_DATA_BLOCK', FILE_ID, RSP_PTR) =

!++
! Functional description:
!
!	Sets up the address of the FILE DATA BLOCK based on the
!       file identifier.
!
! Formal parameters:
!
!	.FILE_ID    File identifier
!       .RSP_PTR    Pointer to NICE response buffer
!
! Implicit inputs: none
!
! Routine value:
!
!       gtr 0	Address of FILE DATA BLOCK
!       eql 0   if not found
!
! Side effects: none
!
!--

    begin

    local
         FILE ;

    !
    ! Setup the file data base pointer
    !

    if not NMU$TABLE_FETCH (FILE_TABLE, .FILE_ID, FILE)
    then
        begin
        %( N.B. - Is this error a user caused error or does it indicate
           some internal error. If it is internally caused this should
           probably cause either a TASK_ERROR or a TASK_INFO followed
           by command abort. )%

        %debug (FILE_TRACE,
                (TRACE_INFO ('Table lookup of FD for FILE_ID %O failed',
                             .FILE_ID)));

        $RESPONSE_X (.RSP_PTR, NICE$_FIO, 0,
                     'Invalid file ID', 208);
        return 0
        end;

    return .FILE

    end;				! End of FIND_FILE_DATA_BLOCK
%if $TOPS20 %then
require 'FILT20' 
        %else %if $MCB %then
              require 'FILMCB' 
              %else %if $TOPS10 %then
                    require 'FILT10' 
                    %fi %fi %fi ;

end				! End of Module NMUFIL
eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:40
! Comment Rounding:+1
! End: