Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

! FILT10 - Network Management File Utility, Tops-10 Specific Routines
!
!                          COPYRIGHT (C) 1981 BY
!     DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS  01754
!
! THIS SOFTWARE IS FURNISHED  UNDER A LICENSE FOR USE ONLY ON A SINGLE
! COMPUTER  SYSTEM AND  MAY BE  COPIED ONLY 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
! EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE
! TERMS.  TITLE TO AND  OWNERSHIP OF THE  SOFTWARE  SHALL AT ALL TIMES
! REMAIN IN DEC.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD  NOT BE CONSTRUED  AS A COMMITMENT  BY DIGITAL  EQUIPMENT
! CORPORATION.
!
! DEC ASSUMES  NO  RESPONSIBILITY  FOR  THE USE OR  RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
!

!++
! Facility: LSG DECnet Network Management
!
! Abstract: This file contains the Tops-10 specific routines for the
!	    Network Management file system.
!
! Environment: TOPS10 user mode, BLISS-36
!
! Author: Stuart S. Grossman, Creation Date: 9-Dec-81
!
!--

%routine ('ALLOC_BUFFER', FILE : ref FILE_DATA_BLOCK) =

!++
! Functional description:
!
!	This routine will allocate and build buffer rings for doing disk I/O.
!	This is necessary because just letting Tops-10 create it's own buffers
!	will mess up NML's memory management.
!
! Formal parameters:
!
!	FILE		Address of a FILE_DATA_BLOCK.
!
! Routine value:
!
!	$true		If all buffers could be allocated
!	$false		If not all buffers could be allocated
!
! Side effects:
!
!	A pointer to an input or output buffer control block will be put
!	into FD_BUFFER_HEADERS.
!--

begin
    external routine
	NMU$FILE_BUILD_BUFFERS;

    builtin
	uuo;

    register
	T1;

    local
	ARGLST : vector [2],
	BUFFER_HEADER;

    ARGLST [0] = $IOBIN;		! Probably this mode
    ARGLST [1] = %sixbit 'DSK';		! Figger out for DSK:

    T1 = ARGLST;
    uuo (1,DEVSIZ (T1));		! Get the number and size of buffers
!
! Now its time to set up the buffer ring.
!
    if not NMU$FILE_BUILD_BUFFERS (BUFFER_HEADER, .T1<18,18,0>, .T1<0,18,0>)
    then return $false;

    selectone .FILE [FD_ACCESS] of
    set
	[FILE_ACCESS_READ_ONLY,
	 FILE_ACCESS_RANDOM]	: FILE [FD_BUFFER_HEADERS] = .BUFFER_HEADER;
	[FILE_ACCESS_WRITE_ONLY] : FILE [FD_BUFFER_HEADERS] = .BUFFER_HEADER ^ 18
    tes;

    $true
end; ! End of ALLOC_BUFFER

%routine ('DEALLOC_BUFFER', FILE : ref FILE_DATA_BLOCK) : novalue =

!++
!
! Functional description:
!
!	This routine will deallocate the buffer ring for a file.
!
! Formal parameters:
!
!	.FILE		Address of a File Descriptor Block
!
! Routine value:
!
!	NONE
!
!--
begin
    external routine
	NMU$FILE_KILL_BUFFERS : novalue;

    local
	BUFFER_HEADER;

    BUFFER_HEADER =
    (selectone .FILE [FD_ACCESS] of
    set
	[FILE_ACCESS_READ_ONLY] : .FILE [FD_BUFFER_HEADERS] and %o'777777';
	[FILE_ACCESS_WRITE_ONLY]: .FILE [FD_BUFFER_HEADERS] ^ -18;
    tes);

    NMU$FILE_KILL_BUFFERS (.BUFFER_HEADER);
end; ! End of DEALLOC_BUFFER

%global_routine ('NMU$FILE_BUILD_BUFFERS', BUFFER_POINTER, NUMBER_BUFFERS, BUFFER_SIZE) =

!++
!
! Functional description:
!
!	Set up a buffer ring for doing Tops-10 style buffered I/O.
!
! Formal parameters:
!
!	.BUFFER_POINTER		Address of where to put pointer to I/O control
!				block
!	.NUMBER_BUFFERS		Number of buffers desired
!	.BUFFER_SIZE		Size of one buffer
!
! Routine value:
!
!	$true			Buffers have been allocated and set up
!	$false			Not enough memory for all the buffers
!
!--

begin
    external routine
	NMU$FILE_KILL_BUFFERS : novalue;

    local
	GOT_MEMORY_FLAG;

    bind
	BUFFER_HEADER = .BUFFER_POINTER : ref vector;

    BUFFER_HEADER = NMU$MEMORY_GET(3);	! Allocate an I/O buffer header

    if .BUFFER_HEADER eql 0 then return $false; ! Crash and burn

    GOT_MEMORY_FLAG = $true;		! Flag for allocation failure cleanup

    BUFFER_HEADER [$BFADR] = 0;		! Clear the buffer ring pointer
!
! Now its time to set up the buffer ring.
!

    while .NUMBER_BUFFERS gtr 0 do
    begin
	local
	    BUFFER : ref vector;

	BUFFER = NMU$MEMORY_GET(.BUFFER_SIZE);	! Get one buffer
	if .BUFFER eql 0 then
	begin
	    GOT_MEMORY_FLAG = $false;
	    exitloop;
	end;
!
! Now its time to set up the header for one buffer.
!
	BUFFER [$BFSTS] = 0;			! Reset the status word
	BUFFER [$BFCNT] = 0;			! And the count word

	if .BUFFER_HEADER [$BFADR] eql 0 then
	begin

! Special code for the first time through. It makes a ring of one item which
! points to itself.

	    BUFFER [$BFHDR] = (.BUFFER_SIZE - 2) ^ 18 + BUFFER [$BFHDR];
	    BUFFER_HEADER [$BFADR] = BUFFER [$BFHDR];
	end
	else
	begin
	    bind
		PREVIOUS_BUFFER = .BUFFER_HEADER [$BFADR] - 1 : vector;
	    local
		TEMP;
	    
	    TEMP = .PREVIOUS_BUFFER [$BFHDR];	! Get previous buffer's pointer

	    ! Make previous buffer point to us
	    PREVIOUS_BUFFER [$BFHDR] = (.BUFFER_SIZE - 2) ^ 18 + BUFFER [$BFHDR];
	    BUFFER [$BFHDR] = .TEMP;		! Point us to other buffer
	end;

	NUMBER_BUFFERS = .NUMBER_BUFFERS - 1;	! Decrement the buffer count
    end; ! Of while loop

    if not .GOT_MEMORY_FLAG then
    begin
	NMU$FILE_KILL_BUFFERS (.BUFFER_HEADER);	! Kill off the buffers
	return $false
    end;

    BUFFER_HEADER [$BFADR] = .BUFFER_HEADER [$BFADR] or BF$VBR;

    $true

end; ! End of NMU$FILE_BUILD_BUFFERS

%global_routine ('NMU$FILE_KILL_BUFFERS', BUFFER_HEADER : ref block) : novalue =

!++
!
! Functional description:
!
!	This routine will take apart and deallocate a Tops-10 I/O buffer ring.
!	It will also deallocate the header.
!
! Formal parameters:
!
!	.BUFFER_HEADER		Address of buffer ring control block
!
! Routine value:
!
!	NONE
!
!--

begin
    local
	CURRENT_BUFFER : ref block,
	TEMP,
	FIRST_BUFFER;

    CURRENT_BUFFER = FIRST_BUFFER = .BUFFER_HEADER [$BFADR, 0, 18, 0] - 1;

    NMU$MEMORY_RELEASE (.BUFFER_HEADER, 3);

    do
    begin

	TEMP = .CURRENT_BUFFER [$BFHDR, 0, 18, 0] - 1;

	NMU$MEMORY_RELEASE (.CURRENT_BUFFER, .CURRENT_BUFFER [$BFHDR, 18, 17,0] + 2);
	CURRENT_BUFFER = .TEMP;

    end
    until .CURRENT_BUFFER eql .FIRST_BUFFER;

end; ! End of NMU$FILE_KILL_BUFFERS

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

!++
! Functional description:
!
!	This routine will do LOOKUPs or ENTERs as appropriate, in order to
!	set up the file for I/O. It will also set up the byte counts, byte
!	sizes, and other stuff in the file and buffer data bases.
!
! Formal parameters:
!
!	FILE		ref pointer to a FILE_DATA_BLOCK
!	FN		ref pointer to a FILE_NAME_BLOCK
!
! Implicit inputs:
!
!	NONE.
!
! Routine value:
!
!	$TRUE		if file is successfully opened
!	$FALSE		otherwise
!
! Side effects:
!
!	A file is now opened, and an I/O channel is now allocated.
!
!--

begin

!
! This macro computes the width of a bit mask
!

    macro
	WID (MASK) = %nbitsu(MASK) - (%nbitsu((MASK) and - (MASK)) - 1) %,
	POS (MASK) = (%nbitsu((MASK) and - (MASK)) - 1) %,
	PW (MASK) = POS(MASK),WID(MASK),0 %,
	WRD = 0,36,0 %,
	LEFT_HALF = 18,18,0 %,
	RIGHT_HALF = 0,18,0 %;

    field
	FILOP_BLOCK_FIELDS =
	set
	FILOP_CHANNEL = [$FOFNC, PW(FO$CHN)],
	FILOP_FUNCTION = [$FOFNC, PW(FO$FNC)],
	FILOP_FLAGS = [$FOFNC, WRD],
	FILOP_OPEN_FLAGS = [$FOIOS, WRD],
	FILOP_DEVICE = [$FODEV, WRD],
	FILOP_OUTPUT_BUFFER_HEADER = [$FOBRH, LEFT_HALF],
	FILOP_INPUT_BUFFER_HEADER = [$FOBRH, RIGHT_HALF],
	FILOP_BUFFER_HEADERS = [$FOBRH, WRD],
	FILOP_OUTPUT_BUFFER_NUMBER = [$FONBF, LEFT_HALF],
	FILOP_INPUT_BUFFER_NUMBER = [$FONBF, RIGHT_HALF],
	FILOP_RENAME_POINTER = [$FOLEB, LEFT_HALF],
	FILOP_LOOKUP_POINTER = [$FOLEB, RIGHT_HALF],
	FILOP_ENTER_POINTER = [$FOLEB, RIGHT_HALF],
	FILOP_PATH_LENGTH = [$FOPAT, LEFT_HALF],
	FILOP_PATH_POINTER = [$FOPAT, RIGHT_HALF]
	tes;

    field
	LOOKUP_BLOCK_FIELDS =
	set
	LOOKUP_NAME = [0, WRD],
	LOOKUP_EXT = [1, LEFT_HALF],
	LOOKUP_PATH = [3, RIGHT_HALF]
	tes;

    field
	PATH_BLOCK_FIELDS =
	set
	PATH_PROJECT = [$PTPPN, LEFT_HALF],
	PATH_PROGRAMMER = [$PTPPN, RIGHT_HALF],
	PATH_SFD = [$PTSFD, 0, 0, 0]
	tes;

    local
	FILOP_BLOCK : block [$FOPAT+1] field (FILOP_BLOCK_FIELDS),
	LOOKUP_BLOCK : block [4] field (LOOKUP_BLOCK_FIELDS),
	PATH_BLOCK : block [$PTMAX] field (PATH_BLOCK_FIELDS),
	BUFFER_HEADER : ref vector,
	TEMP;

!
! First we set up the FILOP, LOOKUP, and PATH blocks with the constant data
!

    begin
	map
	    FILOP_BLOCK : vector [$FOPAT+1],
	    LOOKUP_BLOCK : vector [4],
	    PATH_BLOCK : vector [$PTMAX];

	incr INDEX from 0 to $FOPAT do FILOP_BLOCK [.INDEX] = 0;
	incr INDEX from 0 to 3 do LOOKUP_BLOCK [.INDEX] = 0;
	incr INDEX from 0 to $PTMAX-1 do PATH_BLOCK [.INDEX] = 0
    end;

	! Tell monitor to assign channels, and use privs
    FILOP_BLOCK [FILOP_FLAGS] = FO$PRV + FO$ASC;
    FILOP_BLOCK [FILOP_OPEN_FLAGS] = $IOBIN + UU$LBF;
    FILOP_BLOCK [FILOP_DEVICE] = %sixbit'DSK   ';
    FILOP_BLOCK [FILOP_OUTPUT_BUFFER_NUMBER] = 0;
    FILOP_BLOCK [FILOP_INPUT_BUFFER_NUMBER] = 0;
    FILOP_BLOCK [FILOP_LOOKUP_POINTER] = LOOKUP_BLOCK;
    LOOKUP_BLOCK [LOOKUP_PATH] = PATH_BLOCK;

    BUFFER_HEADER =
    (selectone .FILE [FD_ACCESS] of
    set
	[FILE_ACCESS_READ_ONLY] : .FILE [FD_BUFFER_HEADERS] and %o '777777';
	[FILE_ACCESS_WRITE_ONLY]: .FILE [FD_BUFFER_HEADERS] ^ -18
    tes);
!
! Now its time to parse the filespec...
!
!=========================================================================
    begin

%( The following is the file parser action table. The entries are action
routines to be called whenever going from one parser state to another. The
table is accessed using the old state and the new state. The table is
arranged such that the vertical numbers are the old state, and the horizontal
numbers are the new state.

\	1	2	3	4	5	6	7
 \----------------------------------------------------------
0!     dev     fil     fil                             fil
1!             fil     fil                             fil
2!                     ext                             ext
3!                             proj
4!                                     prog    prog
5!                                     sfd     sfd
6!                                                     end

)%

	switches list (noobject);

	structure 
	    PARSE_MATRIX [OLD, NEW ; ROW, COL] =
	    [ROW+1 * COL]
	    (PARSE_MATRIX + OLD*COL + NEW - 1)<0,36,0>;

	literal
	    DEV$P = 1,			! We just saw a device
	    FIL$P = 2,			! We just saw a file name
	    EXT$P = 3,			! We just saw an extension
	    PROJ$P = 4,			! We just saw a project number
	    PROG$P = 5,			! We just saw a programmer number
	    SFD$P = 6,			! We just saw a SFD
	    END$P = 7;			! We just saw end of file spec string

	bind
	    PTABLE = uplit(
		DEV$P,	FIL$P,	FIL$P,	0,	0,	0,	FIL$P,
		0,	FIL$P,	FIL$P,	0,	0,	0,	FIL$P,
		0,	0,	EXT$P,	0,	0,	0,	EXT$P,
		0,	0,	0,	PROJ$P,	0,	0,	0,
		0,	0,	0,	0,	PROG$P,	PROG$P,	0,
		0,	0,	0,	0,	SFD$P,	SFD$P,	0,
		0,	0,	0,	0,	0,	0,	END$P)
		     : PARSE_MATRIX [6,7];

	own
	    PTR,
	    LEN;

	local
	    STATE,
	    NEWSTATE,
	    TOKEN,
	    SFD_COUNT;

	bind
	    SFD = PATH_BLOCK [PATH_SFD] : vector [5];

	routine GETC =
	begin
	    LEN = .LEN - 1;
	    if .LEN lss 0 then return 0;
	    ch$rchar_a(PTR)
	end;

	routine GETOCT (TOKEN) =
	begin
	    local
		TEMP;

	    .TOKEN = 0;

	    incr INDEX from 1 to .LEN do
	    begin
		TEMP = GETC ();
		if .TEMP lss %c'0' or .TEMP gtr %c'7' then exitloop;
		if .INDEX leq 6 then .TOKEN = ..TOKEN * 8 + .TEMP - %c'0';
	    end;

	    .TEMP
	end; !End of routine GETOCT

	routine GETSIX (TOKEN) =
	begin
	    local
		TEMP,
		PTR;

	    .TOKEN = 0;
	    PTR = ch$ptr(.TOKEN,,6);

	    while $TRUE do
	    begin
		TEMP = GETC ();
		if .TEMP geq %c'a'
		   and .TEMP leq %c'z' then TEMP = .TEMP - %c'a'+%c'A';

		if not (.TEMP geq %c'A' and .TEMP leq %c'Z')
		   and not (.TEMP geq %c'0' and .TEMP leq %c'9') then exitloop;

		TEMP = .TEMP - %c' ';
		if (..TOKEN and %o'77') eql 0 then ch$wchar_a(.TEMP, PTR);
	    end;

	    .TEMP
	end; !End of routine GETSIX

	STATE = 0;
	SFD_COUNT = 0;
	PTR = .FN [FN_NAME_POINTER];
	LEN = .FN [FN_LENGTH];

	while .STATE neq 7 do
	begin

	    NEWSTATE = (if .STATE eql 3 or .STATE eql 4 then GETOCT (TOKEN)
							else GETSIX (TOKEN));

	    NEWSTATE =
		(selectone .NEWSTATE of
		set
		    [%c':']		:	1;
		    [%c'.']		:	2;
		    [%c'[']		:	3;
		    [%c',']		:	if .STATE leq 3 then 4 else 5;
		    [%c']']		:	6;
		    [0]			:	7;
		    [otherwise]		:	0;
		tes);

	    case .PTABLE [.STATE, .NEWSTATE] from 0 to END$P of
	    set

	    [0]		:	return 0;
	    [DEV$P]	:	FILOP_BLOCK [FILOP_DEVICE] = .TOKEN;
	    [FIL$P]	:	LOOKUP_BLOCK [LOOKUP_NAME] = .TOKEN;
	    [EXT$P]	:	LOOKUP_BLOCK [LOOKUP_EXT] = .TOKEN ^ -18;
	    [PROJ$P]	:	PATH_BLOCK [PATH_PROJECT] = .TOKEN;
	    [PROG$P]	:	PATH_BLOCK [PATH_PROGRAMMER] = .TOKEN;
	    [SFD$P]	:	(SFD[.SFD_COUNT] = .TOKEN;SFD_COUNT = .SFD_COUNT + 1);
	    [END$P]	:	;
	    tes;

	    STATE = .NEWSTATE;

	end; !End of while .STATE neq 7
	$true
    end; !End of routine PARSE
!======================================================================

    FILOP_BLOCK [FILOP_BUFFER_HEADERS] = .FILE [FD_BUFFER_HEADERS];

    FILOP_BLOCK [FILOP_FUNCTION] = (
     selectone .FILE [FD_ACCESS] of
     set
	[FILE_ACCESS_READ_ONLY] : $FORED;
	[FILE_ACCESS_WRITE_ONLY] : $FOWRT;
     tes);

    begin
	builtin
	    UUO;

	register
	    T1;

	T1 = ($FOPAT+1) ^ 18 + FILOP_BLOCK;
	if not UUO (1, FILOP$(T1)) then
	begin
	    selectone .FILE [FD_ACCESS] of
	    set
		[FILE_ACCESS_READ_ONLY] :
		    if .T1 eql ERFNF_ then
		    begin
			$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE, 0,
			'File %#A not found.', .FN [FN_LENGTH],
			.FN [FN_NAME_POINTER]);
			return $FALSE
		    end;
		[FILE_ACCESS_WRITE_ONLY] :
		    begin
			$RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE, 0,
			'Cannot create file %#A.  ENTER error = %O',
			.FN [FN_LENGTH], .FN [FN_NAME_POINTER], .T1);
			return $FALSE
		    end;
	    tes;

	    $RESPONSE (.FILE [FD_RESPONSE], NICE$_FOE, 0,
		       'Cannot lookup file %#A.  LOOKUP error = %O',
		       .FN [FN_LENGTH], .FN [FN_NAME_POINTER], .T1);
	    return $FALSE
	end;
    end;

    FILE [FD_CHANNEL] = .FILOP_BLOCK [FILOP_CHANNEL];

    BUFFER_HEADER [$BFPTR] = FLD(
	selectone .FILE [FD_FORMAT] of
	    set
	    [FILE_FORMAT_18_FOR_16] : 18;
	    [FILE_FORMAT_BYTE_STREAM] : 8;
	    [OTHERWISE] : 36;
	    tes,
	%o'007700000000');

    $true
end; ! End of OPEN_FILE

%routine ('CLOSE_FILE', FILE : ref FILE_DATA_BLOCK) =

!++
!
! Function description:
!
!	This routine will do a Tops-10 file close, and channel release.
!
! Formal parameters:
!
!	.FILE		Address of file descriptor block
!
! Routine value:
!
!	$true		File was closed successfully
!	$false		Couldn't close file
!
!--

begin
    builtin
	UUO;

    register
	T1;

    local
	ARGLST : vector [2];

    ARGLST [0] = .FILE [FD_CHANNEL] ^ 18 + $FOCLS;
    ARGLST [1] = 0;

    T1 = 2 ^ 18 + ARGLST;

    if not UUO (1, FILOP$(T1)) then return $false;

    ARGLST [0] = .FILE [FD_CHANNEL] ^ 18 + $FOREL;

    T1 = 1 ^ 18 + ARGLST;

    if not UUO (1, FILOP$(T1)) then return $false;

    $true
end; ! End of CLOSE_FILE

%routine ('READ_FILE', FILE : ref FILE_DATA_BLOCK, DATA) =

!++
!
! Functional description:
!
!	This routine will do a buffered mode read from a file.  Call it
!	once for each byte desired.
!
! Formal parameters:
!
!	.FILE			Address of file descriptor block
!	.DATA			Address of where to store data
!
! Routine value:
!
!	$true			Everythings fine, byte is in DATA.
!	$false			I/O error occurred while reading.  GETSTS
!				data is in DATA.
!	$eof			End of file was encountered.
!
!--

begin
    bind
	BUFFER_HEADER = .FILE [FD_BUFFER_HEADERS] and %o'777777' : vector;

    BUFFER_HEADER [$BFCTR] = .BUFFER_HEADER [$BFCTR] - 1;

    if .BUFFER_HEADER [$BFCTR] lss 0 then
    begin
	local
	    FILOP_ARGS;

	builtin
	    UUO;

	register
	    T1;

	FILOP_ARGS = .FILE [FD_CHANNEL] ^ 18 + $FOINP;

	T1 = 1 ^ 18;
	T1 = .T1 + FILOP_ARGS;
	if not UUO (1, FILOP$(T1)) then
	begin
!	    T1 = .T1 and IO$EOF;	\    Commented out
!	    if .T1 neq 0 then $eof;	 >   because of a
!	    return $false;		/    nasty BLISS problem
	    .DATA = .T1;
	    return $eof;
	end;

	BUFFER_HEADER [$BFCTR] = .BUFFER_HEADER [$BFCTR] - 1;
    end;

    .DATA = ch$rchar_a (BUFFER_HEADER [$BFPTR]);
    $true
end; ! End of READ_FILE

%routine ('WRITE_FILE', FILE : ref FILE_DATA_BLOCK, DATA) =

!++
!
! Functional description:
!
!	This routine will do a buffered mode write to a file.  Call it
!	once for each byte you wish to write.
!
! Formal parameters:
!
!	.FILE			Address of file descriptor block
!	.DATA			Data to be written to the file
!
! Routine value:
!
!	$true			Everythings fine, data has been put in buffer
!	Not $true		Value of routine is GETSTS for the channel
!
!--

begin
    bind
	BUFFER_HEADER = .FILE [FD_BUFFER_HEADERS] ^ -18 : vector;

    BUFFER_HEADER [$BFCTR] = .BUFFER_HEADER [$BFCTR] - 1;

    if .BUFFER_HEADER [$BFCTR] lss 0 then
    begin
	local
	    FILOP_ARGS;

	builtin
	    UUO;

	register
	    T1;

	FILOP_ARGS = .FILE [FD_CHANNEL] ^ 18 + $FOOUT;

	T1 = 1 ^ 18;
	T1 = .T1 + FILOP_ARGS;
	if not UUO (1, FILOP$(T1)) then return .T1;

	BUFFER_HEADER [$BFCTR] = .BUFFER_HEADER [$BFCTR] - 1;
    end;

    ch$wchar_a (.DATA, BUFFER_HEADER [$BFPTR]);
    $true
end; ! End of WRITE_FILE