english
version "1.0"
identify "xyz"

#: Copyright (c) 1998-2005 by Wayne C. Gramlich.
#, All rights reserved.

module output_stream

define output_stream			#: Input stream of bytes/characters
    variant kind output_stream_kind
	closed null			#: This output_stream is closed
	file_output_stream file_output_stream #: A standard file output stream
    generate address_get, allocate, erase, identical, print

define output_stream_kind		#: The {output_stream} types.
    enumeration
	closed				#: A closed input stream
	file_output_stream		#: A file input stream
    generate equal, print, unsigned_convert

define file_output_stream		#: Input stream from a file
    record
	memory memory			#: Memory buffer (used as a ring buf.)
	file_descriptor_number unsigned	#: File descriptor number
	file_name file_name		#: File name
	file_name_string string		#: Associated file name as a {string}
	offset unsigned			#: Offset to first unwritten byte
	size unsigned			#: Bytes of data in buffer (can wrap)
    generate allocate, erase, print


#: {output_stream} routines:

procedure character_write@output_stream
    takes
	output_stream output_stream
	character character
    returns_nothing

    #: This procedure will output {character} to {output_stream}.


procedure close@output_stream
    takes
	output_stream output_stream
    returns_nothing

    #: This procedure will close {output_stream}.


procedure create@output_stream
    takes_nothing
    returns output_stream

    #: This procedure will return a new closed {output_stream} object.
    #, It is primarily intended for use by other types, like
    #, {file_output_stream}, that have open procedures that will
    #, return an open {output_stream} object.


procedure decimal_write@output_stream
    takes
	output_stream output_stream
	number unsigned
    returns_nothing

    #: This procedure will output {number} to {out_stream} as a decimal
    #, number.


procedure flush@output_stream
    takes
	output_stream output_stream
    returns_nothing

    #: This procedure will cause all internal buffers in {output_stream}
    #, to be flushed out.


procedure hexadecimal_write@output_stream
    takes
	output_stream output_stream
	number unsigned
    returns_nothing

    #: This procedure will write out {number} as a hexadicimal to {out_stream}.


procedure is_open@output_stream
    takes
	output_stream output_stream
    returns logical

    #: This procedure will return {true}@{logical} if {output_stream} is
    #, still open and {false} otherwise.


procedure memory_write@output_stream
    takes
	output_stream output_stream
	memory memory
	offset unsigned
	amount_requested unsigned
    returns unsigned

    #: This procedure will write up to {amount_requested} bytes from
    #, {memory} starting at {offset} to {output_stream}.  The actual
    #, number of bytes written out is returned.
    #,
    #, Please note that this procedure will 


procedure memory_write_exact@output_stream
    takes
	output_stream output_stream
	memory memory
	offset unsigned
	amount_requested unsigned
    returns_nothing

    #: This procedure will attempt to write exactly {amount_requested}
    #, bytes/characters from {memory} starting at {offset} to {output_stream}.


procedure string_write@output_stream
    takes
	output_stream output_stream
	buffer string
	offset unsigned
	amount_requested unsigned
    returns unsigned

    #: This procedure will write up to {amount_requested} characters
    #, from {buffer} to {output_stream}.  The actual number of characters
    #, written is returned.


procedure string_write_exact@output_stream
    takes
	output_stream output_stream
	buffer string
	offset unsigned
	amount_requested unsigned
    returns_nothing

    #: This procedure will write exactly {amount_requested} bytes/characters
    #, from {buffer} starting at {offset} to {output_stream}.


#: {file_output_stream} routines:

procedure character_write@file_output_stream
    takes
	file_output_stream file_output_stream
	character character
    returns_nothing

    #: This procedure will write {character} to {file_output_stream}.

procedure close@file_output_stream
    takes
	file_output_stream file_output_stream
    returns_nothing

    #: This procedure will close {file_output_stream}.


procedure file_descriptor_bind@file_output_stream
    takes
	file_descriptor_number unsigned
	buffer_size unsigned
	file_name file_name
	file_name_string string
    returns output_stream

    #: This procedure will create and return a {file_output_stream} object
    #, that has been bound to {file_descriptor_number} with a buffer of
    #, {buffer_size}.  {file_name} and {file_name_string} are associated
    #, with the returned {file_output_stream} object.


#FIXME:  There needs to be a flush_once@file_output_stream routine!!!

procedure flush@file_output_stream
    takes
	file_output_stream file_output_stream
    returns unsigned

    #: This procedure will flush out all internal buffers associated with
    #, {file_output_stream}.

    #put@("<=flush@file_output_stream()\n\", debug_stream)



procedure open@file_output_stream
    takes
	file_name file_name
    returns output_stream

    #: This procedure will return open {file_name} and return an
    #, associated {output_stream} object.


procedure open_buffer@file_output_stream
    takes
	file_name file_name
	buffer_size unsigned
    returns output_stream

    #: This procedure will return open {file_name} for writing and return
    #, an associated {output_stream} object with a backing buffer of size
    #, {buffer_size}.  ??@{output_stream} is returned if the open failed.
    #, An invocation to {status_get}@{unix_system} may give a more
    #, diagnostic reason.

    #: Open the file.

procedure memory_write@file_output_stream
    takes
	file_output_stream file_output_stream
	memory memory
	offset unsigned
	amount_requested unsigned
    returns unsigned

    #: This procedure will attempt to write up to {amount_requested}
    #, bytes from {memory} starting at {offset} to {file_output_stream}.
    #, The number of bytes actually written is returned.  At most
    #, one system call to write(2) is performed.


procedure show@file_output_stream
    takes
	file_output_stream file_output_stream
	label string
	remaining unsigned
	out_stream out_stream
    returns_nothing

    #: This procedure will output the internal state of {file_output_stream}
    #, to {out_stream}.  Note, this routine is for debugging purposes only.


procedure string_write@file_output_stream
    takes
	file_output_stream file_output_stream
	buffer string
	offset unsigned
	amount_requested unsigned
    returns unsigned

    #: This procedure will write up to {amount_requested} characters
    #, from {buffer} starting at {offset} to {file_output_stream}.
    #, The actual number of characters written is returned.


procedure transfer@file_output_stream
    takes
	file_output_stream file_output_stream
	from_memory memory
	from_string string
	from_offset unsigned
	to_offset unsigned
	amount unsigned
    returns_nothing

    #: This procedure will transfer {amount} bytes/characters from
    #, either {from_memory} or {from_string} starting at {from_offset}
    #, and store the result in {file_output_stream}'s buffer starting
    #, at {to_offset}.  If {from_memory} is ??@{memory}, {from_string}
    #, is used, otherwise {from_memory} is used as the source.


procedure write@file_output_stream
    takes
	file_output_stream file_output_stream
	memory memory
	buffer string
	offset unsigned
	amount_requested unsigned
    returns unsigned

    #: This procedure will write up to {amount_requested} bytes from
    #, {memory} or {buffer} starting at {offset} to {file_output_stream}.
    #, The number of bytes actually written is returned.  If {memory}
    #, is ??@{memory}, {buffer} is used; otherwise {memory} is used
    #, to obtain the data.

    #, at most once per call to this procedure.  The reason for this
    #, constraint is because the user might be trying to write a program
    #, that does not block doing I/O.  The Unix select(2) system call will
    #, specify which file descriptors are ready for output, but it will
    #, guarantee at most one byte can be written without blocking.  By
    #, restricting ourselves to only calling write(2) once, we avoid blocking.
    #, So, how is this done.  Basically we do the following: 1) fill the
    #, end of the buffer up as much as possible, 2) if the buffer is full
    #, to the high water mark, write out as much of it as possible, 3) fill
    #, up any remaining buffer space.

#    #debug_stream :@= system.error_out_stream
#    #format@format2[unsigned, unsigned](debug_stream,
#    #  "write(%d%, %d%)\n\", offset, amount_requested)
#
#    to_memory :@= file_output_stream.memory
#    to_memory_size :@= to_memory.size
#    to_offset :@= file_output_stream.offset
#    size :@= file_output_stream.size
#    total_written :@= 0
#
#    # Step 1: If possible fill the memory buffer up as much as possible:
#    end_offset :@= to_offset + remaining
#    if end_offset < to_memory_size
#	# We've still got some space:
#	#show@(file_output_stream, "step 1 ", remaining, debug_stream)
#	available :@= to_memory_size - end_offset
#	request :@=
#	  (amount_requested > available) ? available : amount_requested
#	transfer@(file_output_stream,
#	  memory, buffer, offset, end_offset, request)
#	remaining :+= request
#	amount_requested :-= request
#	offset :+= request
#	total_written :+= request
#
#    # Step 2: If we still have more bytes to write into the buffer,
#    #, let's write out as much of what we've got as we can:
#    if to_offset + remaining >= to_memory_size
#	# We're over the high water mark; try to write some stuff out:
#	#show@(file_output_stream, "step 2 ", remaining, debug_stream)
#	unix_system:: unix_system := ??
#	amount_written :@= write@(unix_system,
#	  file_output_stream.file_descriptor_number,
#	  to_memory, to_offset, to_memory_size - to_offset)
#	assert unix_system.status = ok
#	remaining :-= amount_written
#	to_offset :+= amount_written
#	if to_offset >= to_memory_size
#	    to_offset := 0
#	file_output_stream.offset := to_offset
#
#    # Step 3: If there is still some space in the buffer and we've got
#    #, some more bytes to transfer, let's transfer them:
#    if amount_requested != 0 && to_offset + remaining < to_memory_size
#	# Fill to the end of the buffer:
#	#show@(file_output_stream, "step 3a", remaining, debug_stream)
#	available :@= to_memory_size - (to_offset + remaining)
#	request :@=
#	  (amount_requested > available) ? available : amount_requested
#	transfer@(file_output_stream,
#	  memory, buffer, offset, to_offset, request)
#	remaining :+= request
#	amount_requested :-= request
#	offset :+= request
#	total_written :+= request
#    if amount_requested != 0 && remaining < to_memory_size
#	# Fill the front of the buffer:
#	#show@(file_output_stream, "step 3b", remaining, debug_stream)
#	available :@= to_memory_size - remaining
#	request :@=
#	  (amount_requested > available) ? available : amount_requested
#	transfer@(file_output_stream, memory,
#	  buffer, offset, to_offset + remaining - to_memory_size, request)
#	remaining :+= request
#	amount_requested :-= request	#FIXME: remove!!!
#	offset :+= request		#FIXME: remove!!!
#	total_written :+= request
#    file_output_stream.remaining := remaining
#    #show@(file_output_stream, "done   ", remaining, debug_stream)
#    #format@format1[unsigned](debug_stream, "=>%d%\n\", total_written)
#    return total_written


# Polymorphic implementation using co-types:
#
#define output_stream[buffer]
#    down_type output_stream
#    needs
#	procedure read
#	    takes buffer, unsigned, unsigned
#	    returns unsigned
#	procedure close
#	    takes buffer
#	    returns_nothing
#    record
#	buffer buffer
#	offset unsigned
#	unread unsigned
#    generate allocate, down_convert, erase, print, up_convert
#
#procedure create@output_stream[buffer]
#    takes
#	buffer buffer
#    returns output_stream
#
#    output_stream1 :@= new@output_stream1[buffer]()
#    output_stream1.buffer :@= buffer
#    output_stream :@= down_convert@(output_stream1)
#    return output_stream
#
#procedure read@output_stream
#    up_type output_stream[buffer]
#    takes
#	output_stream output_stream
#	amount unsigned
#    returns unsigned
#
#    output_stream1 :@= up_convert@(output_stream)
#    result :@= read@(output_stream1.buffer,
#      output_stream.offset + output_stream.unread, offset)
#    output_stream.unread :+= result
#    return result
#
#procedure close@output_stream
#    up_type output_stream[buffer]
#    takes
#	output_stream output_stream
#    returns_nothing
#
#    output_stream1 :@= up_convert@(output_stream)
#    close@(output_stream)