english
version "1.0"
identify "wxyz"

#: Copyright (c) 1995, 1996, 2002 by Wayne C. Gramlich.
#, All rights reserved.
#,
#, Permission to use, copy, modify, distribute, and sell this software
#, for any purpose is hereby granted without fee provided that the above
#, copyright notice and this permission are retained.  The author makes
#, no representations about the suitability of this software for any purpose.
#, It is provided "as is" without express or implied warranty.

module history

#: This module implements the history file for SVMS.  Basically, there is
#, a one-to-one correspondence between an h. file and a {history} object.
#,
#, A {history} object basically corresponds to a vector of {delta} objects
#, and a vector of {version} objects.  A {version} object corresponds to
#, a particular instance of a source file.  A {version} object has no
#, project, timestamp, or ancestor information.  A {delta} object names
#, a {version} object and specifies a corresponding project and timestamp.

import
    address
    character
    chunk
    data_io
    delta
    errors
    file_name
    file_system
    format
    in_stream
    logical
    manage
    misc
    out_stream
    project
    resources
    set
    status
    string
    svms
    timer
    unsigned
    vector
    version

define history				#: A history file in memory
    record
	create_timestamp unsigned	#: Creation timestamp
	deltas vector[delta]		#: Delta list
	major unsigned			#: Major version number
	minor unsigned			#: Minor version number
	project_file project_file	#: Corresponding {project_file}
	ranges_invalid logical		#: Range {chunks} are invalidated
	resources resources		#: Parent {resources} object
	versions vector[version]	#: Version list
    generate address_get, allocate, erase, identical, print


#: {history} procedures:

procedure xallocate@history
    takes
	project_file project_file
    returns history

    #: This procedure will allocate and return a new {history} object
    #, corresponding to {project_file}.

    #: Carefully reinitialize {history}:
    assert project_file !== ??
    resources :@= project_file.resources
    assert resources !== ??
    history :@= history_allocate@(resources)
    deltas :@= history.deltas
    versions :@= history.versions
    erase@(history)
    if deltas == ??
	deltas := allocate@vector[delta]()
    if versions == ??
	versions := allocate@vector[version]()
    history.ranges_invalid := false
    history.resources := resources
    history.project_file := project_file
    history.versions := versions
    return history


procedure create@history
    takes
	project_file project_file
    returns history

    #: This procedure will create and return a fresh {history} object
    #, corresponding to {project_file}.

    resources :@= project_file.resources
    assert resources !== ??
    #debug_stream :@= resources.global.debug_stream
    actual_file_name :@= project_file.actual_file_name
    history_file_name :@= project_file.history_file_name
    #format@format2[file_name, file_name](debug_stream,
    #  'create@history(): actual_file_name:%ds% history_file_name:%ds%\n\',
    #  full_file_name, history_file_name)
    status_update@(actual_file_name)
    status :@= actual_file_name.status
    assert status !== ??
    assert status.modification_time != 0

    history :@= xallocate@history(project_file)
    history.create_timestamp := status.modification_time
    history.major := 1
    history.minor := 0
    assert history.resources !== ??

    return history


procedure deallocate@history
    takes
	history history
    returns_nothing

    #: This procedure will deallocate {history} for subsequent reallocation.

    #debug_stream :@= history.resources.global.debug_stream

    # Deallocate the versions:
    versions :@= history.versions
    size :@= versions.size
    index :@= 0
    loop
	while index < size
	version :@= versions[index]
	deallocate@(version)
	index :+= 1
    truncate@(versions, 0)

    # Deallocate the deltas:
    deltas :@= history.deltas
    size := deltas.size
    index := 0
    loop
	while index < size
	delta :@= deltas[index]
	#format@format2[unsigned, address](debug_stream,
	#  'deallocate@history(): deltas[%d%]: %X%\n\',
	#   index, delta.address)
	deallocate@(delta)
	index :+= 1
    truncate@(deltas, 0)

    history_deallocate@(history.resources, history)


procedure delta_append@history
    takes
	history history
	delta delta
    returns_nothing

    #: This procedurew will append {delta} to the deltas in {history}.

    assert history !== ??
    assert delta !== ??

    #debug_stream :@= delta.resources.global.debug_stream
    #format@format2[address, address](debug_stream,
    #  'delta_append(%X%, %X%)\n\', history.address, delta.address)

    delta.history := history
    deltas :@= history.deltas
    append@(deltas, delta)


#procedure dump@history
#    takes
#	history history
#	message string
#    returns_nothing
#
#    #: This procedure will dump out selected portions of {history} and
#    #, and label each portion with {message}.
#
#    debug_stream :@= history.resources.global.debug_stream
#    deltas :@= history.deltas
#    size :@= deltas.size
#    index :@= 0
#    loop
#	while index < size
#	delta :@= deltas[index]
#	format@format3[string, unsigned, address](debug_stream,
#	  'dump@history(%ds%): deltas[%d%]: %X%\n\',
#	  message, index, delta.address)
#	index :+= 1


procedure ranges_remove@history
    takes
	history history
    returns_nothing

    #: This procedure will remove the range chunks from all {version} objects
    #, in {history}.

    assert history !== ??
    versions :@= history.versions
    size :@= versions.size
    index :@= 0
    loop
	while index < size
	version :@= versions[index]
	ranges_remove@(version)
	index :+= 1


procedure read@history
    takes
	data_in_stream data_in_stream
	project_file project_file
	read_timer timer
    returns history

    #: This procedure will read in the header file information for {history}
    #, from {in_stream}.  If any errors occur, an error message is output
    #, to {error_stream} and {true} is returned.

    assert data_in_stream !== ??
    assert project_file !== ??

    version_timer :@= child_create@(read_timer, 'version read')
    delta_timer :@= child_create@(read_timer, 'delta read')

    # Process the header buffers:
    resources :@= data_in_stream.resources
    history :@= xallocate@history(project_file)
    buffer :@= data_in_stream.buffer

    #debug_stream :@= resources.global.debug_stream
    # put@('read@history()\n\', debug_stream)

    # The format of a header line is `H "SVMS_History_File" major minor':
    tag_check@(data_in_stream, "H"[0])
    trim@(buffer, 0)
    string_read@(data_in_stream, buffer)
    assert buffer = "SVMS_History_File"
    history.major := unsigned_read@(data_in_stream)
    history.minor := unsigned_read@(data_in_stream)
    new_line_read@(data_in_stream)

    # The format of a name line is `N "file_name" create_timestamp'
    tag_check@(data_in_stream, "N"[0])
    trim@(buffer, 0)
    string_read@(data_in_stream, buffer)
    file_name :@= file_name_convert@(buffer)

    history.project_file := project_file
    #format@format3[file_name, file_name, file_name](debug_stream,
    #  'read@history(): relative:%ds% actual:%ds% history:%ds%\n\',
    #  file_name, project_file.full_file_name, project_file.history_file_name)
    create_timestamp :@= timestamp_read@(data_in_stream)
    history.create_timestamp := create_timestamp
    project_file.timestamp := create_timestamp
    new_line_read@(data_in_stream)

    # Read each version:
    capital_v :@= "V"[0]
    capital_x :@= "X"[0]
    loop
	while !(data_in_stream.eof)
	tag :@= tag_read@(data_in_stream)
	if tag = capital_v
	    current_set@(version_timer)
	    version :@= read@version(data_in_stream, history)
	else_if tag = capital_x
	    current_set@(delta_timer)
	    delta :@= read@delta(data_in_stream, history)
	    delta_append@(history, delta)
	else
	    assert false

    current_set@(read_timer)
    ranges_remove@(history)

    # format@format1[unsigned](debug_stream,
    #   'deltas_size: %d%\n\', history.deltas.size)

    return history


procedure save@history
    takes
	history history
	save_timer timer
    returns logical

    #: This procedure will save {history} out to disk.  If any error
    #, occurs, {true} is returned; otherwise, {false} is returned.

    resources :@= history.resources
    assert resources !== ??
    global :@= resources.global
    errors :@= global.errors
    project_file :@= history.project_file
    history_file_name :@= project_file.history_file_name

    #debug_stream :@= resources.global.debug_stream
    #format@format1[file_name](debug_stream,
    #  'save@history: history_file_name: %ds%\n\', history_file_name)

    data_out_stream :@=
      open@data_out_stream(history_file_name, resources, errors)
    if data_out_stream.resources == ??
	return true
    write@(history, data_out_stream, save_timer)
    project_file.history_hash :=
      close@(data_out_stream, global.data_out_delays)
    deallocate@(data_out_stream)
    return false


procedure unshare@history
    takes
	history history
	share_table set[chunk]
    returns_nothing

    #: This procedure will empty out the shared {chunks} in {share_table}.

    assert history !== ??

    versions :@= history.versions
    size :@= versions.size
    index :@= 0
    loop
	while index < size
	version :@= versions[index]
	unshare@(version, share_table)
	index :+= 1
    assert share_table.size = 0


procedure version_append@history
    takes
	history history
	version version
    returns_nothing

    #: This procedurew will append {version} to the versions in {history}.

    assert history !== ??
    assert version !== ??
    version.history := history
    versions :@= history.versions
    append@(versions, version)


procedure write@history
    takes
	history history
	data_out_stream data_out_stream
	write_timer timer
    returns_nothing

    #: This procedure will write {history} to {out_stream}.
    #, {global} contains some useful stuff.

    # Write out the history header:
    header_timer :@= child_create_current@(write_timer, 'header')
    tag_write@(data_out_stream, "H"[0])
    string_write@(data_out_stream, "SVMS_History_File")
    unsigned_write@(data_out_stream, 1)
    unsigned_write@(data_out_stream, 0)
    new_line_write@(data_out_stream)

    tag_write@(data_out_stream, "N"[0])
    string_write@(data_out_stream, history.project_file.actual_file_name.name)
    create_timestamp :@= history.create_timestamp
    assert create_timestamp != 0
    timestamp_write@(data_out_stream, create_timestamp)
    new_line_write@(data_out_stream)

    # Writing out the versions is actually a little tricky.  The goal
    #, here is to obtain determanistic chunk sharing amongst {version}'s
    #, even after merging branches.  The first step is to sort the
    #, versions into a consistent and repeatable order.  The second
    #, step is to assign a unique number to each version.  The third
    #, step is to carefully write out each version looking for sharing
    #, as we go along (that tricky code is in {version}@{write}() .)
    #, The fourth and final step is to clean up the sharing table in
    #, {history}.

    # Step 1 == Sort the versions:
    sort_timer :@= child_create_current@(write_timer, 'sort')
    versions :@= history.versions
    deltas :@= history.deltas
    sort@(versions)
    sort@(deltas)

    # Step 2 -- assign unique version identifier numbers to each version
    #, and delta:
    assign_timer :@= child_create_current@(write_timer, 'assign')
    deltas_size :@= deltas.size
    delta_index :@= 0
    loop
	while delta_index < deltas_size
	delta :@= deltas[delta_index]
	delta.offset := delta_index
	delta_index :+= 1
    versions_size :@= versions.size
    version_index :@= 0
    loop
	while version_index < versions_size
	version :@= versions[version_index]
	version.offset := version_index
	version_index :+= 1

    # Step 3 -- Write out the versions and the deltas.  Lots of magic occurs
    #, in {write}@{version}():
    version_timer :@= child_create_current@(write_timer, 'version')
    version_header_timer :@= child_create@(version_timer, 'header')
    verify_timer :@= child_create@(version_timer, 'verify')
    remove_timer :@= child_create@(version_timer, 'remove')
    share_timer :@= child_create@(version_timer, 'share')
    bind_timer :@= child_create@(version_timer, 'bind')
    sort_timer :@= child_create@(version_timer, 'sort')
    convert_timer :@= child_create@(version_timer, 'convert')
    chunks_timer :@= child_create@(version_timer, 'chunks')
    ranges_timer :@= child_create@(version_timer, 'ranges')
    delta_timer :@= child_create_current@(write_timer, 'delta')
    resources :@= history.resources
    assert resources !== ??
    share_table :@= share_table_allocate@(resources)
    delta_index := 0
    version_index := 0
    loop
	while delta_index < deltas_size && version_index < versions_size
	delta :@= deltas[delta_index]
	version :@= versions[version_index]
	if version.timestamp <= delta.timestamp
	    current_set@(version_timer)
	    write@(version, data_out_stream, share_table,
	      version_header_timer, verify_timer, remove_timer, share_timer,
	      bind_timer, sort_timer, convert_timer, chunks_timer,
	      ranges_timer)
	    version_index :+= 1
	else
	    current_set@(delta_timer)
	    write@(delta, data_out_stream)
	    delta_index :+= 1
    loop
	while version_index < versions_size
	version :@= versions[version_index]
	current_set@(version_timer)
	write@(version, data_out_stream, share_table,
	  version_header_timer, verify_timer, remove_timer, share_timer,
	  bind_timer, sort_timer, convert_timer, chunks_timer,
	  ranges_timer)
	version_index :+= 1
    loop
	while delta_index < deltas_size
	current_set@(delta_timer)
	delta :@= deltas[delta_index]
	write@(delta, data_out_stream)
	delta_index :+= 1

    # Step 4 -- Unshare all of the chunks:
    unshare_timer :@= child_create_current@(write_timer, 'unshare')
    unshare@(history, share_table)
    share_table_deallocate@(resources, share_table)