Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/mxufil.bli
There are 7 other files named mxufil.bli in the archive. Click here to see a list.
! Edit= 314 to MXUFIL.BLI on 17-May-88 by WADDINGTON, for SPR #21402
!Make MX work without DECnet for both TOPS-10 and TOPS-20.
MODULE mxfil    (
		IDENT = 'X03.09'
		) =
BEGIN

!
!			  COPYRIGHT (c) 1984 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: MX file system interface.
!
! Abstract:
!
!	This module provides a common interface for file system access.
!
! Environment:	User Mode on TOPS-20, TOPS-10
!
! Author: Richard B. Waddington   October 3, 1984
!
!--
!
! Include files:
!
%IF %SWITCHES(TOPS20) %THEN
    LIBRARY 'monsym';
    LIBRARY 'mxjlnk';
%FI
LIBRARY 'mxnlib';                       ! Get all required definitions
LIBRARY 'mxlib';
!
! Table of contents
!

SWITCHES LIST (REQUIRE);                ! Allow listing of specific code

FORWARD ROUTINE
        mx$file_initialize : NOVALUE,  ! Initialize file interface
	mx$file_open,                  ! open file for access
        mx$file_read,
	mx$file_write,
	mx$file_seek,
        mx$file_size,
	seek_file,
	mx$file_close,
%IF $tops10 %THEN
	mx$file_build_buffers,
	mx$file_kill_buffers: NOVALUE,
        filpar,
%FI
        !
        ! System specific routines.
        !
        alloc_buffer,
        dealloc_buffer : NOVALUE,
        open_file,
        map_page,
%IF $tops20 %THEN
        unmap_page,
%FI
        close_file;

%module_name ('MXFIL');

!
! Own storage:
!

OWN
   file_table: INITIAL (0) ;            ! Base address of file table data base

!
! External references:
!

EXTERNAL
        %debug_data_base;

EXTERNAL ROUTINE
         mx$error_processor,
         nmu$text,
         nmu$table_routines,
         nmu$memory_manager;
%global_routine ('MX$FILE_DELETE', spec) =
    BEGIN
%IF %SWITCHES(TOPS20) %THEN
    declare_jsys(gtjfn,delf);
    REGISTER
        t = 1;

    IF .spec EQL 0
    THEN
        RETURN 0;

    IF .spec<18,18,0> EQL 0
    THEN
        spec = CH$PTR(.spec);

    IF $$gtjfn(gj_sht OR gj_old, .spec;t)
    THEN
        $$delf(df_exp OR .t<0,18,0>);

    RETURN 0;
%ELSE

    STACKLOCAL
        flpblk: BLOCK[$fofsp+1] FIELD (filop_block_fields)
                                INITIAL(REP $fofsp+1 OF (0)),
        lkpblk: BLOCK[$rbtim+1] FIELD (lookup_block_fields)
                                INITIAL (REP $rbtim+1 OF (0)),
        pthblk: BLOCK[$ptmax]   FIELD (path_block_fields)
                                INITIAL (REP $ptmax OF (0));
    IF .spec EQL 0
    THEN
        RETURN 0;

    IF .spec<18,18,0> EQL 0
    THEN
        spec = CH$PTR(.spec);

    flpblk [filop_flags] = fo$prv OR fo$asc OR $fodlt;
    flpblk [filop_open_flags] = $ioasc;
    flpblk [filop_device] = %SIXBIT'DSK   ';
    flpblk [filop_lookup_pointer] = lkpblk;
    lkpblk [lookup_path] = pthblk;

    IF NOT filpar(.spec,flpblk,lkpblk,pthblk)
    THEN
	RETURN $false;

    BEGIN
    BUILTIN UUO;
    REGISTER t;
    LOCAL
        scratch,
        value;

    set_in_your_behalf(flpblk,lkpblk);
    t = ($fofsp+1)^18 + flpblk;                     !Do the delete...
    value = UUO(1,filop$(t));

    scratch = .flpblk[filop_channel]^18 + $forel;   !Release the channel
    t = 1^18 + scratch;
    UUO(1,filop$(t));

    RETURN .value
    END

    %FI
    END;
%global_routine('MX$FILE_SET_WRITER', spcptr, namptr): NOVALUE =
    BEGIN
    %IF %SWITCHES(TOPS20) %THEN

    LOCAL
        jfn;

    declare_jsys(gtjfn,sfust,rljfn);

    IF $$gtjfn(gj_old OR gj_sht, .spcptr; jfn)
    THEN
        BEGIN
        $$sfust($sflwr^18 OR .jfn, .namptr);
        $$rljfn(.jfn);
        RETURN 0
        END;
    RETURN -2;
    %ELSE
!	Not needed on TOPS-10 (?)

    RETURN -2 %FI
    END;


%global_routine('MX$FILE_SIZE', spec_, pages_, bytes_) =
    BEGIN
    BIND
        pages = .pages_,
        bytes = .bytes_;

    %IF %SWITCHES(TOPS20) %THEN
    LOCAL
        jfn;

    declare_jsys(gtjfn,sizef,rljfn);

    IF $$gtjfn(gj_old OR gj_sht, CH$PTR(.spec_);jfn)
    THEN
        BEGIN
        $$sizef(;,bytes);
        $$rljfn(.jfn);
	pages = .bytes/(512*5) + 1;
	RETURN 0
        END;
    RETURN -2;
    %ELSE
    LOCAL
	error,
	eop,
	buffer: REF VECTOR;
    STACKLOCAL
        flpblk: BLOCK[$fofsp+1] FIELD (filop_block_fields)
                                INITIAL(REP $fofsp+1 OF (0)),
        tmpblk: BLOCK[4]        FIELD (lookup_block_fields)
                                INITIAL (REP 4 OF (0)),
        lkpblk: BLOCK[$rbtim+1] FIELD (extended_lookup_block_fields)
                                INITIAL (REP $rbtim+1 OF (0)),
        pthblk: BLOCK[$ptmax]   FIELD (path_block_fields)
                                INITIAL (REP $ptmax OF (0));

    flpblk [filop_flags] = fo$prv OR fo$asc OR $fored;
    flpblk [filop_open_flags] = $iodmp;
    flpblk [filop_device] = %SIXBIT'DSK   ';
    flpblk [filop_lookup_pointer] = lkpblk;
    lkpblk [exlookup_count] = $rbtim+1;
    tmpblk [lookup_path] = pthblk;
    IF .spec_ EQL 0
    THEN
        RETURN 0;

    IF .spec_<18,18,0> EQL 0
    THEN
        spec_ = CH$PTR(.spec_);

    IF NOT filpar(.spec_,flpblk,tmpblk,pthblk)
    THEN
	RETURN $false;

    lkpblk[exlookup_name] = .tmpblk[lookup_name];
    lkpblk[exlookup_ext] = .tmpblk[lookup_ext];
    lkpblk[exlookup_ppn] = .tmpblk[lookup_ppn];

    BEGIN
    BUILTIN UUO;
    REGISTER t;
    LOCAL
        scratch,
        value,
	last_word,
	iolist: vector[2];

    set_in_your_behalf(flpblk,lkpblk);
    t = ($fofsp+1)^18 + flpblk;                     !Do the lookup
    IF UUO(1,filop$(t))
    THEN
	BEGIN
	scratch = .lkpblk[$rbsiz,wrd] - 1;	!zero based address of last word in file
	flpblk[filop_function] = $fousi;	!set file to
	flpblk[1,wrd] = .scratch<7,28,0> + 1;		!last block number
	t = 2^18 + flpblk;
	value = .value OR UUO(1,filop$(t));				!do the USETI
	buffer = nmu$memory_get(128);		!allocate a buffer
	iolist[0] = (-128)^18 OR (.buffer-1);
	iolist[1] = 0;
	flpblk[filop_function] = $foinp;
	flpblk[1,wrd] = iolist;
	t = 2^18 OR flpblk;
	UUO(1,filop$(t));
	last_word = .buffer[.scratch<0,7,0>] AND (NOT 1);
	nmu$memory_release(.buffer,128);
	eop = 0;
	WHILE (.last_word NEQ 0) DO
	BEGIN
	  last_word = .last_word ^ 7;
	  eop = .eop + 1;
	END;
	bytes = .eop + (5*.scratch);
	pages = (.bytes+(128*5)-1)/(128*5);
	scratch = .flpblk[filop_channel]^18 + $forel;   !Release the channel
	t = 1^18 + scratch;
	UUO(1,filop$(t));
	RETURN $true
    END
    ELSE
	BEGIN
        $error(FACILITY=$internal,           !Oh well, try again later
               SEVERITY=$warning,
               CODE=uf$len,
               MESSAGE_DATA=CH$PTR(.spec_),
               OPTIONAL_MESSAGE=$error_code,
               OPTIONAL_DATA=.error);
	RETURN $false
	END;
    END %FI
    END;

%global_routine('MX$FILE_EXISTS', ptr) =
    BEGIN
    %IF %SWITCHES(TOPS20) %THEN
    LOCAL
        jfn;

    declare_jsys(gtjfn,rljfn);

    $TRACE('MX$FILE_EXISTS called');
    IF $$gtjfn(gj_old OR gj_sht, .ptr)
    THEN
        BEGIN
        $$rljfn();
        RETURN 1
        END;
    RETURN 0;
    %ELSE
    STACKLOCAL
        flpblk: BLOCK[$fofsp+1] FIELD (filop_block_fields)
                                INITIAL(REP $fofsp+1 OF (0)),
        lkpblk: BLOCK[$rbtim+1] FIELD (lookup_block_fields)
                                INITIAL (REP $rbtim+1 OF (0)),
        pthblk: BLOCK[$ptmax]   FIELD (path_block_fields)
                                INITIAL (REP $ptmax OF (0));
    IF .ptr EQL 0
    THEN
        RETURN 0;

    IF .ptr<18,18,0> EQL 0
    THEN
        ptr = CH$PTR(.ptr);

    flpblk [filop_flags] = fo$prv OR fo$asc OR $fored;
    flpblk [filop_open_flags] = $ioasc;
    flpblk [filop_device] = %SIXBIT'DSK   ';
    flpblk [filop_lookup_pointer] = lkpblk;
    lkpblk [lookup_path] = pthblk;

    IF NOT filpar(.ptr,flpblk,lkpblk,pthblk)
    THEN
	RETURN $false;

    BEGIN
    BUILTIN UUO;
    REGISTER t;
    LOCAL
        scratch,
        value;

    set_in_your_behalf(flpblk,lkpblk);
    t = ($fofsp+1)^18 + flpblk;                     !Do the delete...
    value = UUO(1,filop$(t));

    scratch = .flpblk[filop_channel]^18 + $forel;   !Release the channel
    t = 1^18 + scratch;
    UUO(1,filop$(t));

    RETURN .value
    END


    %FI
    END;

%global_routine('MX$FILE_COPY',src,dst)=
    BEGIN
    STACKLOCAL
        buffer: VECTOR[CH$ALLOCATION(132)];

    LOCAL
        ifil,
        ofil,
        len,
        error;

    ifil = mx$file_open(.src, FILE_ACCESS_READ_ONLY, error);
    IF .ifil LEQ 0
    THEN
        BEGIN
        $error(FACILITY=$internal,
               SEVERITY=$warning,
               CODE=uf$fof,
               MESSAGE_DATA=.src,
               OPTIONAL_MESSAGE=$error_code,
               OPTIONAL_DATA=.error);
        RETURN $false;
        END;

    ofil = mx$file_open(.dst, FILE_ACCESS_WRITE_ONLY, error);
    IF .ofil LEQ 0
    THEN
        BEGIN
        $error(FACILITY=$internal,
               SEVERITY=$warning,
               CODE=uf$fof,
               MESSAGE_DATA=.dst,
               OPTIONAL_MESSAGE=$error_code,
               OPTIONAL_DATA=.error);

        mx$file_close(.ifil, file_abort, error);
        RETURN $false;
        END;

    WHILE (len = mx$file_read(.ifil, CH$PTR(buffer), 132, error)) GTR 0 DO
        BEGIN
        IF NOT mx$file_write(.ofil, CH$PTR(buffer), .len, error)
        THEN
            BEGIN
            $error(FACILITY=$internal,
                   SEVERITY=$warning,
                   CODE=uf$fwf,
                   MESSAGE_DATA=.dst,
                   OPTIONAL_MESSAGE=$error_code,
                   OPTIONAL_DATA=.error);

            mx$file_close(.ifil, file_abort, error);
            RETURN $false;
            END;
        END;

    IF .len NEQ 0
    THEN
        BEGIN
        $error(FACILITY=$internal,
               SEVERITY=$warning,
               CODE=uf$frf,
               MESSAGE_DATA=.dst,
               OPTIONAL_MESSAGE=$error_code,
               OPTIONAL_DATA=.error);

        mx$file_close(.ofil, file_abort, error);
        RETURN $false;
        END;

    IF NOT mx$file_close(.ofil, file_keep, error)
    THEN
        BEGIN
        $error(FACILITY=$internal,
               SEVERITY=$warning,
               CODE=uf$fcf,
               MESSAGE_DATA=.dst,
               OPTIONAL_MESSAGE=$error_code,
               OPTIONAL_DATA=.error);

        mx$file_close(.ifil, file_abort, error);
        RETURN $false;
        END;

    mx$file_close(.ifil, file_abort, error);
    RETURN $true
    END;

%global_routine('MX$FILE_WRITTEN_DATE', ptr) =
    BEGIN
    %IF %SWITCHES(TOPS20) %THEN
    DECLARE_JSYS(gtjfn,gtfdb,rljfn);

    LOCAL
        date;

    date = 0;
    IF mx$file_exists(.ptr)
    THEN
        BEGIN
        REGISTER
            jfn;

        $$gtjfn(gj_old OR gj_sht, .ptr; jfn);
        $$gtfdb(.jfn, 1^18 + $fbcre, date);
        $$rljfn(.jfn);
        END;

    RETURN .date;
    %ELSE
    STACKLOCAL
        flpblk: BLOCK[$fofsp+1] FIELD (filop_block_fields)
                                INITIAL(REP $fofsp+1 OF (0)),
        tmpblk: BLOCK[4]        FIELD (lookup_block_fields)
                                INITIAL (REP 4 OF (0)),
        lkpblk: BLOCK[$rbtim+1] FIELD (extended_lookup_block_fields)
                                INITIAL (REP $rbtim+1 OF (0)),
        pthblk: BLOCK[$ptmax]   FIELD (path_block_fields)
                                INITIAL (REP $ptmax OF (0));

    flpblk [filop_flags] = fo$prv OR fo$asc OR $fored;
    flpblk [filop_open_flags] = $ioasc;
    flpblk [filop_device] = %SIXBIT'DSK   ';
    flpblk [filop_lookup_pointer] = lkpblk;
    lkpblk [exlookup_count] = $rbtim+1;
    tmpblk [lookup_path] = pthblk;

    IF NOT filpar(.ptr,flpblk,tmpblk,pthblk)
    THEN
	RETURN $false;

    lkpblk[exlookup_name] = .tmpblk[lookup_name];
    lkpblk[exlookup_ext] = .tmpblk[lookup_ext];
    lkpblk[exlookup_ppn] = .tmpblk[lookup_ppn];

    BEGIN
    BUILTIN UUO;
    REGISTER t;
    LOCAL
        scratch,
        value;

    set_in_your_behalf(flpblk,lkpblk);
    t = ($fofsp+1)^18 + flpblk;                     !Do the lookup
    value = UUO(1,filop$(t));

    scratch = .flpblk[filop_channel]^18 + $forel;   !Release the channel
    t = 1^18 + scratch;
    UUO(1,filop$(t));

    RETURN (IF .value THEN .lkpblk[exlookup_create_udt]
                      ELSE $false)

    END
    %FI
    END;
%global_routine('MX$FILE_RENAME', ptr1, ptr2) =
    BEGIN
    %IF %SWITCHES(TOPS20) %THEN
    declare_jsys(gtjfn,rnamf,rljfn);
    REGISTER
        jfn1,
        jfn2;

    $$gtjfn(gj_old OR gj_sht, .ptr1; jfn1);
    $$gtjfn(gj_fou OR gj_sht, .ptr2; jfn2);
    IF $$rnamf(.jfn1,.jfn2)
    THEN
        BEGIN
        $$rljfn(.jfn2);
        RETURN 1
        END
    ELSE
        BEGIN
        $$rljfn(.jfn1);
        $$rljfn(.jfn2);
        RETURN 0
        END
    %ELSE
    BUILTIN UUO;

    STACKLOCAL
        flpblk: BLOCK[$fofsp+1] FIELD (filop_block_fields)
                                INITIAL(REP $fofsp+1 OF (0)),
        lkpblk: BLOCK[4]        FIELD (lookup_block_fields)
                                INITIAL (REP 4 OF (0)),
        renblk: BLOCK[4]        FIELD (lookup_block_fields)
                                INITIAL (REP 4 OF (0)),
        ptlblk: BLOCK[$ptmax]   FIELD (path_block_fields)
                                INITIAL (REP $ptmax OF (0)),
        ptrblk: BLOCK[$ptmax]   FIELD (path_block_fields)
                                INITIAL (REP $ptmax OF (0));

    flpblk [filop_flags] = fo$prv OR fo$asc OR $fornm;
    flpblk [filop_open_flags] = $ioasc;
    flpblk [filop_device] = %SIXBIT'DSK   ';
    flpblk [filop_lookup_pointer] = lkpblk;
    flpblk [filop_rename_pointer] = renblk;
    lkpblk [lookup_path] = ptlblk;
    renblk [lookup_path] = ptrblk;

    IF NOT filpar(.ptr1,flpblk,lkpblk,ptlblk)
    THEN
	RETURN $false;

    IF NOT filpar(.ptr2,flpblk,renblk,ptrblk)
    THEN
	RETURN $false;

    BEGIN
    REGISTER t;
    LOCAL 
        scratch,
        value;

    WHILE $true DO
        BEGIN
	set_in_your_behalf(flpblk,lkpblk);
	t = ($fofsp+1)^18 + flpblk;
        IF (value = UUO(1,filop$(t)))
        THEN
            EXITLOOP
        ELSE
            IF .t EQL eraef_
            THEN
                (IF NOT mx$file_delete(.ptr2)
                THEN
                    EXITLOOP)
            ELSE
                RETURN $false;
        END;

    scratch = .flpblk[filop_channel]^18 + $forel;
    t = 1^18 + scratch;
    UUO(1,filop$(t));
    RETURN .value

    END
!    mx$file_copy(.ptr1,.ptr2);
!    mx$file_delete(.ptr1)
    %FI
    END;
%global_routine ('MX$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 MX$FILE_INITIALIZE
%global_routine ('MX$FILE_OPEN', FILE_NAME, ACCESS, ERROR) =

!++
! Functional description:
!
!	This routine opens a local file.  The ACCESS specifies
!	the accessing technique.  The file is assumed to be a 7-bit
!	ASCII stream file.  If the file can not be opened, an error
!	code is returned in ERROR.
!
! Formal parameters:
!
!       .FILE_NAME    Pointer to file spec string (ASCIZ)
!	.ACCESS	      READ_ACCESS
!		      WRITE_ACCESS
!		      APPEND_ACCESS
!       .ERROR	      Address to return error code in
!
! 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;

    $TRACE('Opening %A',.file_name);
    !
    ! Allocate a file block and fill it in with known information.
    !

    file = nmu$memory_get (file_data_block_allocation);
    file [fd_access] = .access ;
    file [fd_byte_size] = 7;
    file [fd_error] = 0;

    fn[fn_pointer] =.file_name;
    fn[fn_length] = CH$LENGTH(.file_name);

    %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

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

    file [fd_current_buffer] = 0;
    alloc_buffer (.file);

    !
    ! Open the file
    !

    file [fd_length] = 0;

    IF NOT open_file (.file, fn)
    THEN
        BEGIN
        dealloc_buffer (.file);
        nmu$memory_release (.file, file_data_block_allocation);
        .error = .file [fd_error];
        file_id = 0;
        RETURN .file_id;
        END;

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

    file [fd_current_position] = 0;
    file [fd_file_position] = 0;

    %IF $tops20 %THEN		! I have to roll my own APPEND on TOPS-20...

    IF .access EQL file_access_append_only
    THEN
        IF NOT seek_file( .file, .file [fd_length], .error)
        THEN
            RETURN 0;

    %FI
    !
    ! 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 MX$FILE_OPEN
%global_routine ('MX$FILE_READ', FILE_ID, DEST_PTR, MAX_BYTES, ERROR) =

!++
! Functional description:
!
!        This routine reads a line of text, 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
!       .MAX_BYTES    The maximum number of bytes to transfer
!       .ERROR	      Pointer to error message buffer
!
! Implicit inputs: none
!
! Routine value:
!
!        gtr 0    Number of bytes actually read from file
!        eql 0    End of file encountered
!        lss 0    Error occured while reading file:
!                 -1    Fatal I/O error of some sort
!
! Side effects: none
!
!--

    BEGIN
    OWN
       file : REF file_data_block,
       xfr_count,
       eol_pointer,
       done,
       move_count;


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

    !
    ! Setup the file data base pointer
    !

    IF NOT nmu$table_fetch (file_table, .file_id, file)
    THEN
        BEGIN
        %debug (FILE_TRACE,
                (TRACE_INFO ('Table lookup of FD for FILE_ID %O failed',
                             .FILE_ID)));
        .error = uf$tlf;
        RETURN -1
        END;

    done = $false;
    xfr_count = 0;
    DO
      BEGIN
      BIND
          buffer = (file [fd_current_buffer]): REF buffer_data_block;

      IF NOT .buffer [bd_valid]
      THEN
          IF NOT map_page (.file)
          THEN
              BEGIN
              .error = .file [fd_error];
              RETURN -1;
              END;

      move_count = MIN( .buffer [bd_remaining_count], .max_bytes );

      eol_pointer = CH$FIND_SUB( .move_count, .buffer [bd_pointer],
                                 2, crlf_pointer);

      IF CH$FAIL (.eol_pointer)
      THEN
          BEGIN
          IF .file [fd_length] EQL 0
          THEN
              move_count = 0
          ELSE
              IF CH$RCHAR(.buffer [bd_pointer]) EQL 0
	      THEN
	          move_count = 0;

          IF (.buffer [bd_end_of_file] OR
              (.buffer [bd_remaining_count] GEQ .max_bytes))
          THEN
              done = $true
          ELSE
              buffer [bd_valid] = $false;
          END
      ELSE
          BEGIN
          move_count = CH$DIFF(.eol_pointer, .buffer [bd_pointer]) + 2 ;
          done = $true;
          END;

      transfer_bytes(.move_count, buffer [bd_pointer], dest_ptr);

      xfr_count = .xfr_count + .move_count;
      max_bytes = .max_bytes - .move_count;

      END
    UNTIL .done;

    RETURN .xfr_count
    END;				! End of MX$FILE_READ
%global_routine ('MX$FILE_WRITE', FILE_ID, SOURCE_PTR, WRITE_COUNT, ERROR) =

!++
! 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
!       .ERROR         The address to return the error code in.
!
! 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,
         move_count,
         space_in_buffer;

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

    !
    ! Setup pointer to file data base
    !

    IF NOT nmu$table_fetch (file_table, .file_id, file)
    THEN
        BEGIN
        %debug (FILE_TRACE,
                (TRACE_INFO ('Table lookup of FD for FILE_ID %O failed',
                             .FILE_ID)));
        .error = uf$tlf;
        RETURN $false
        END;

    DO
      BEGIN
      BIND
          buffer = (file [fd_current_buffer]): REF buffer_data_block;

      IF NOT .buffer [bd_valid]
      THEN
          IF NOT map_page (.file)
          THEN
              BEGIN
              .error = .file [fd_error];
              RETURN $false;
              END;

      space_in_buffer =
      %IF $tops20 %THEN
          bytes_per_page - .buffer [bd_current_position];
      %ELSE
          .buffer [bd_remaining_count];
      %FI

      IF .space_in_buffer LSS .write_count
      THEN
          buffer [bd_valid] = $false;

      move_count = MIN(.space_in_buffer, .write_count);
      write_count = .write_count - .move_count;

      transfer_bytes(.move_count, source_ptr, buffer [bd_pointer]);
      END
    UNTIL .write_count LEQ 0;

    file [fd_length] = MAX( .file [fd_length], .file [fd_current_position]);

    RETURN $true

    END;				! End of MX$FILE_WRITE
%global_routine ('MX$FILE_SEEK', FILE_ID, BYTE_POSITION, ERROR) =

!++
! 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 NOT nmu$table_fetch (file_table, .file_id, file)
    THEN
        BEGIN
        %debug (FILE_TRACE,
                (TRACE_INFO ('Table lookup of FD for FILE_ID %O failed',
                             .FILE_ID)));
        .error = uf$tlf;
        RETURN -1
        END;

    IF NOT seek_file (.file, .byte_position, .error)
    THEN
        RETURN $false;

    RETURN $true

    END;				! End of MX$FILE_SEEK
%routine ('SEEK_FILE', FILE: ref FILE_DATA_BLOCK, BYTE_POSITION, ERROR) =

!++
! 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            File Data Block
!     .BYTE_POSITION   The byte offset at which the file is to be positioned.
!     .ERROR           The address to return the error code in.
!
! Implicit Imputs: none
!
! Routine Value:
!
!     $TRUE     File positioned successfully.
!     $FALSE    Invalid ID or failure during seek.
!
! Side effects: none
!
!--

    BEGIN
    !
    ! Set current byte position within file.
    !

    file [fd_current_position] = .byte_position;

%IF $tops20 %THEN

    BEGIN
    BIND
        buffer = (.file [fd_current_buffer]): REF buffer_data_block;

    IF .file [fd_access] EQL file_access_append_only
    THEN
        IF .file [fd_append_in_progress]
        THEN
            BEGIN
            .error = uf$ifa;
            RETURN $false;
            END
        ELSE
            file [fd_append_in_progress] = $true;

    IF .buffer [bd_valid]
    THEN
        IF NOT ((.byte_position GEQ .buffer [bd_file_position]) AND
               (.byte_position LSS
                 (.buffer [bd_file_position] + .buffer [bd_length])))
        THEN
            buffer [bd_valid] = $false;
    END;

%FI

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

   RETURN $true;
   END;                               ! End of SEEK_FILE
%global_routine ('MX$FILE_CLOSE', FILE_ID, ABORT, ERROR) =

!++
! Functional description:
!
!	Closes a file and invalidates further access. Resources are
!       released and any buffered data is written to file.  If ABORT
!	is set to 1, then the file is not updated.  *** WARNING ***
!	ABORT = 1 does not work on TOPS-10 for APPEND mode access!
!	If ABORT is set to 2, then the file is deleted...
!
! Formal parameters:
!
!	.FILE_ID    File identifier
!       .ABORT      0 to keep, 1 to abort any changes
!       .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 NOT nmu$table_fetch (file_table, .file_id, file)
    THEN
        BEGIN
        %debug (FILE_TRACE,
                (TRACE_INFO ('Table lookup of FD for FILE_ID %O failed',
                             .FILE_ID)));
        .error = uf$tlf;
        RETURN $false
        END;

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

    BEGIN
    !
    ! Perform actions necessary to close the file.
    !
    $TRACE('Closing %A',CH$PTR(file[fd_name]));
%IF $tops20 %THEN

    unmap_page (.file);

%FI

    IF .abort EQL file_abort
    THEN
        file [fd_abort] = 1;

    IF .abort EQL file_delete
    THEN
	file [fd_delete] = 1;

    IF NOT close_file (.file)
    THEN
        BEGIN
        .error = .file [fd_error];
        RETURN $false;
        END;

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

    nmu$table_delete (file_table, .file_id);

    dealloc_buffer (.file);

    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 MX$FILE_CLOSE
%IF $tops20 %THEN
REQUIRE 'newt20'
%ELSE
REQUIRE 'newt10'
        %FI ;

END
ELUDOM