english version "1.0" identify "xyz" #: Copyright (c) 1995, 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 data_io #: This module implements the {data_in_stream} and {data_out_stream} types. import address character errors file_name file_system format in_stream logical misc out_stream project resources status string svms unsigned vector version define data_in_stream #: Delta input stream object record buffer string #: Temporary buffer errors errors #: {errors} object to output errors to file_name file_name #: {file_name} object for stream hash unsigned #: Hash value for file in_stream in_stream #: {in_stream} object project project #: {project{ for stream resources resources #: Parent {resources} object generate address_get, allocate, erase, identical, print define data_out_stream #: Delta output stream object record buffer string #: Temporary buffer errors errors #: Error output final_file_name file_name #: Final file name for data file hash unsigned #: Hash value for data new_line string #: New-line sequence for out stream offset unsigned #: Total characters output out_stream out_stream #: {out_stream} object resources resources #: Parent {resources} object side_file_name file_name #: Temporary file name for data file generate address_get, allocate, erase, identical, print define data_out_delay #: Delayed output file renaming record side_file_name file_name #: Side file name (prior to rename) final_file_name file_name #: Final file name (after rename) generate address_get, allocate, erase, identical, print define data_out_delays #: List of delayed output files record debug_stream out_stream #: A debugging stream delays vector[data_out_delay] #: The list of delays file_name file_name #: File name for temporary storage generate address_get, allocate, erase, identical, print #: {data_in_stream} procedures: procedure xallocate@data_in_stream takes resources resources returns data_in_stream #: This procedure will return an unitinialized {data_in_stream} object #, for reading a data file. # Carefully erase everything: data_in_stream :@= data_in_stream_allocate@(resources) buffer :@= data_in_stream.buffer erase@(data_in_stream) if buffer == ?? buffer := allocate@string() data_in_stream.buffer := buffer data_in_stream.resources := resources return data_in_stream procedure bytes_read@data_in_stream takes data_in_stream data_in_stream bytes string returns_nothing #: This procedure will read in a sequence of bytes that was previously #, written using {bytes_write}@{data_out_stream}. The read in bytes #, are appended to {bytes}. assert data_in_stream !== ?? space_read@(data_in_stream) quote :@= "'"[0] hash :@= data_in_stream.hash in_stream :@= data_in_stream.in_stream loop character1 :@= character_get@(in_stream) until character1 = quote nibble1 :@= hexadecimal_convert@(character1) character2 :@= character_get@(in_stream) nibble2 :@= hexadecimal_convert@(character2) byte :@= (nibble1 << 4) | nibble2 character_append@(bytes, character_convert@(byte)) hash :+= byte data_in_stream.hash := hash procedure character_check@data_in_stream takes data_in_stream data_in_stream character character returns_nothing #: This procedure will read in on character from {data_in_stream} #, and verify that it matches {character}. assert data_in_stream !== ?? assert character_read@(data_in_stream) = character procedure character_read@data_in_stream takes data_in_stream data_in_stream returns character #: This procedure will read in one character from {data_in_stream} #, that was written with {character_write}@{data_out_stream}(). character :@= character_get@(data_in_stream.in_stream) data_in_stream.hash :+= unsigned_convert@(character) return character procedure close@data_in_stream takes data_in_stream data_in_stream returns unsigned #: This procedure will close {data_in_stream} and return the computed #, hash value. assert data_in_stream !== ?? close@(data_in_stream.in_stream) data_in_stream.in_stream := ?? return data_in_stream.hash procedure deallocate@data_in_stream takes data_in_stream data_in_stream returns_nothing #: This procedure will deallocate {data_in_stream} and make it #, available for subsequent reallocation. resources :@= data_in_stream.resources if data_in_stream.in_stream !== ?? errors :@= resources.global.errors format@errors1[file_name](errors, '%ds% was not properly closed!\n\', data_in_stream.file_name) close@(data_in_stream.in_stream) data_in_stream.in_stream := ?? data_in_stream_deallocate@(resources, data_in_stream) procedure eof_get@data_in_stream takes data_in_stream data_in_stream returns logical #: This procedure will return {true} if {data_in_stream} is at #, an end of file and {false} otherwise. return data_in_stream.in_stream.eof procedure file_name_read@data_in_stream takes data_in_stream data_in_stream returns file_name #: This procedure will read in a {file_name} forom {data_in_stream}. assert data_in_stream !== ?? resources :@= data_in_stream.resources buffer :@= data_in_stream.buffer trim@(buffer, 0) string_read@(data_in_stream, buffer) file_name:: file_name := ?? if buffer != "" file_name :@= parse@file_name(buffer, resources.global.file_system) return file_name procedure hash_read@data_in_stream takes data_in_stream data_in_stream returns unsigned #: This procedure will write out {hash} to {data_out_stream}. # Mark it as a hash value, so sed scirpts can strip them out. assert data_in_stream !== ?? space_read@(data_in_stream) assert character_read@(data_in_stream) = "#"[0] number :@= 0 loop character :@= character_read@(data_in_stream) while is_digit@(character) # 48 = unsigned_convert@("0"[0]) number := number * 10 + unsigned_convert@(character) - 48 return number procedure header_read@data_in_stream takes data_in_stream data_in_stream tag character file_type string major unsigned minor unsigned returns logical #: This procedure will read in a header line from {data_in_stream}. assert data_in_stream !== ?? errors :@= data_in_stream.errors resources :@= data_in_stream.resources file_name :@= data_in_stream.file_name tag_check@(data_in_stream, tag) actual_file_type :@= string_allocate@(resources) string_read@(data_in_stream, actual_file_type) if actual_file_type != file_type format@errors3[file_name, string, string](errors, 'File %ds% has a type of %ds% instead of %ds%!\n\', file_name, actual_file_type, file_type) string_deallocate@(resources, actual_file_type) return true string_deallocate@(resources, actual_file_type) actual_major :@= unsigned_read@(data_in_stream) if actual_major != major format@errors3[file_name, unsigned, unsigned](errors, 'File %ds% has a major version number of %ds% instead of %ds%!\n\', file_name, actual_major, major) actual_minor :@= unsigned_read@(data_in_stream) if actual_minor != minor format@errors3[file_name, unsigned, unsigned](errors, 'File %ds% has a minor version number of %ds% instead of %ds%!\n\', file_name, actual_minor, minor) new_line_read@(data_in_stream) return false procedure logical_read@data_in_stream takes data_in_stream data_in_stream returns logical assert data_in_stream !== ?? space_read@(data_in_stream) character :@= character_read@(data_in_stream) if character = "T"[0] return true assert character = "F"[0] return false procedure new_line_read@data_in_stream takes data_in_stream data_in_stream returns_nothing #: This procedure will read skip over a new-line sequence in #, {data_in_stream}. assert data_in_stream !== ?? new_line :@= "\n\"[0] in_stream :@= data_in_stream.in_stream loop character :@= character_get@(in_stream) until character = new_line data_in_stream.hash :+= unsigned_convert@("\n\"[0]) procedure open@data_in_stream takes data_in_stream data_in_stream file_name file_name project project errors errors returns logical #: This procedure will open {file_name} for reading. If any errors #, occur, an error message is output to {error_stream} and {true} #, is returned; otherwise, {false} is returned. assert data_in_stream !== ?? in_stream :@= data_in_stream.in_stream if in_stream !== ?? format@errors1[file_name](errors, '%ds% was not properly closed!\n\', data_in_stream.file_name) close@(in_stream) data_in_stream.in_stream := ?? in_stream := read_open@(file_name, errors) if in_stream == ?? return true data_in_stream.errors := errors data_in_stream.file_name := file_name data_in_stream.in_stream := in_stream data_in_stream.project := project return false procedure space_read@data_in_stream takes data_in_stream data_in_stream returns_nothing #: This procedure will read in a space from {data_in_stream}. assert data_in_stream !== ?? character :@= character_read@(data_in_stream) assert character = " "[0] procedure status_mode_read@data_in_stream takes data_in_stream data_in_stream returns status_mode #: This procedure will read in and return a {status_mode} value from #, {data_in_stream}. assert data_in_stream !== ?? resources :@= data_in_stream.resources buffer :@= string_allocate@(resources) string_read@(data_in_stream, buffer) result:: status_mode := other if buffer = "deleted" result := deleted else_if buffer = "directory" result := directory else_if buffer = "regular_file" result := regular_file else_if buffer = "symbolic_link" result := symbolic_link string_deallocate@(resources, buffer) return result procedure string_read@data_in_stream takes data_in_stream data_in_stream buffer string returns_nothing #: This procedure will read in a sequence of bytes that was previously #, written using {line_write}@{data_out_stream}. The read in bytes #, are appended to {bytes}. assert data_in_stream !== ?? hash :@= data_in_stream.hash quote :@= '"'[0] percent :@= "%"[0] space_read@(data_in_stream) character_check@(data_in_stream, quote) in_stream :@= data_in_stream.in_stream loop character :@= character_get@(in_stream) hash :+= unsigned_convert@(character) #FIXME: wrong!! until character = quote if character = percent nibble1 :@= hexadecimal_convert@(character_get@(in_stream)) nibble2 :@= hexadecimal_convert@(character_get@(in_stream)) character :@= character_convert@((nibble1 << 4) | nibble2) character_append@(buffer, character) data_in_stream.hash := hash procedure tag_check@data_in_stream takes data_in_stream data_in_stream tag character returns_nothing #: This procedure will read in a tag character from {data_in_stream} #, and verify that it matches {tag}. assert data_in_stream !== ?? actual_tag :@= tag_read@(data_in_stream) if actual_tag != tag errors :@= data_in_stream.errors format@errors3[file_name, character, character](errors, 'File %ds% encountered a tag of %dc% instead %dc%!\n\', data_in_stream.file_name, actual_tag, tag) procedure tag_read@data_in_stream takes data_in_stream data_in_stream returns character #: This procedure will read in and return a tag charater from #, {data_in_stream{ that was written by {tag_write}@{data_out_stream}(). assert data_in_stream !== ?? return character_read@(data_in_stream) procedure timestamp_read@data_in_stream takes data_in_stream data_in_stream returns unsigned #: This procedure will return a timestamp read from {data_in_stream} #, that was written by {timestamp_write}@{data_out_stream}(). assert data_in_stream !== ?? buffer :@= data_in_stream.buffer trim@(buffer, 0) space_read@(data_in_stream) string_read@(data_in_stream, buffer) timestamp :@= timestamp_lop@(buffer) return timestamp procedure unsigned_fixed_read@data_in_stream takes data_in_stream data_in_stream width unsigned returns unsigned #: This procedure will read in {width} decimal digits #, from {data_in_stream} that were written by #, {unsigned_fixed_write}@{data_in_stream}(). assert data_in_stream !== ?? number :@= 0 index :@= 0 loop while width != 0 character :@= character_read@(data_in_stream) # 48 = unsigned_convert@("0"[0]) digit :@= unsigned_convert@(character) - 48 number := number * 10 + digit width :-= 1 return number procedure unsigned_read@data_in_stream takes data_in_stream data_in_stream returns unsigned #: This procedure will read in and return an {unsigned} #, number from {data_in_stream} that was written via #, {unsigned_write}@{data_in_stream}(). assert data_in_stream !== ?? space_read@(data_in_stream) number :@= unsigned_read_helper@(data_in_stream, "."[0]) return number procedure unsigned_read_helper@data_in_stream takes data_in_stream data_in_stream terminator character returns unsigned #: This procedure will read in number from {data_in_stream} until #, {terminator} is encountered. number :@= 0 loop character :@= character_read@(data_in_stream) until character = terminator # 48 = unsigned_convert@("0"[0]) number := number * 10 + unsigned_convert@(character) - 48 return number #: {data_out_delay} procedures: procedure create@data_out_delay takes side_file_name file_name final_file_name file_name returns data_out_delay #: This procedure will create and return a new {data_out_delay} object #, containing {side_file_name} and {final_file_name}. initialize data_out_delay:: data_out_delay := allocate@data_out_delay() data_out_delay.side_file_name := side_file_name data_out_delay.final_file_name := final_file_name return data_out_delay #: {data_out_delays} procedures: procedure abort@data_out_delays takes data_out_delays data_out_delays returns_nothing #: This procedure will delete all of the side files in {data_out_delays}. delays :@= data_out_delays.delays size :@= delays.size index :@= 0 loop while index < size data_out_delay :@= delays[index] file_delete@(data_out_delay.side_file_name) index :+= 1 truncate@(delays, 0) procedure append@data_out_delays takes data_out_delays data_out_delays side_file_name file_name final_file_name file_name returns_nothing #: This procedure will append a new {data_out_delay} object containing #, {side_file_name} and {final_file_name} to {data_out_delays}. data_out_delay :@= create@data_out_delay(side_file_name, final_file_name) append@(data_out_delays.delays, data_out_delay) procedure commit@data_out_delays takes data_out_delays data_out_delays errors errors returns_nothing #: This procedure will rename all of the side files in {data_out_delays} #, to their appropriate final file names delays :@= data_out_delays.delays size :@= delays.size index :@= 0 loop while index < size data_out_delay :@= delays[index] assert !rename@(data_out_delay.side_file_name, data_out_delay.final_file_name, errors) index :+= 1 truncate@(delays, 0) procedure create@data_out_delays takes file_name file_name debug_stream out_stream returns data_out_delays #: This procedure will create and return an empty {data_out_delays} object. #, {file_name} specifies a temporary file for keeping track of what #, files need to be deleted. #: Eventually we will use initialize data_out_delays:: data_out_delays := allocate@data_out_delays() data_out_delays.debug_stream := debug_stream data_out_delays.delays := allocate@vector[data_out_delay]() data_out_delays.file_name := file_name return data_out_delays #: {data_out_stream} procedures: procedure xallocate@data_out_stream takes resources resources returns data_out_stream #: This procedure will return an unitinialized {data_out_stream} object #, for reading a data file. # Carefully erase everything: assert resources !== ?? data_out_stream :@= data_out_stream_allocate@(resources) erase@(data_out_stream) data_out_stream.buffer := string_allocate@(resources) data_out_stream.new_line := "\n\" data_out_stream.offset := 0 data_out_stream.resources := resources return data_out_stream procedure bytes_write@data_out_stream takes data_out_stream data_out_stream bytes string returns_nothing #: This procedure will write {bytes} out to {data_out_stream} #, as a sequence of hexadecimal numbers. This can easily be #, read back in via a call to {bytes_read}@{data_in_stream}(). hash :@= data_out_stream.hash quote :@= "'"[0] space_write@(data_out_stream) character_write@(data_out_stream, quote) out_stream :@= data_out_stream.out_stream size :@= bytes.size index :@= 0 loop while index < size byte :@= unsigned_convert@(bytes[index]) hash :+= byte put@("0123456789ABCDEF"[byte >> 4], out_stream) put@("0123456789ABCDEF"[byte & 15], out_stream) index :+= 1 data_out_stream.offset :+= size << 1 data_out_stream.hash := hash character_write@(data_out_stream, quote) procedure close@data_out_stream takes data_out_stream data_out_stream data_out_delays data_out_delays returns unsigned #: This procedure will close {data_out_stream}. The hash value #, for {data_out_stream} is returned. debug_stream :@= data_out_stream.resources.global.debug_stream close@(data_out_stream.out_stream) data_out_stream.out_stream := ?? errors :@= data_out_stream.errors side_file_name :@= data_out_stream.side_file_name final_file_name :@= data_out_stream.final_file_name #format@format2[file_name, file_name](debug_stream, # "close: side: %ds%: final: %ds%\n\", side_file_name, final_file_name) if access_mode_change@(side_file_name, 0444, errors) return 0 append@(data_out_delays, side_file_name, final_file_name) return data_out_stream.hash procedure character_write@data_out_stream takes data_out_stream data_out_stream character character returns_nothing #: This procedure will write {character} to {data_out_stream} such #, that it can be read back in by {character_read}@{data_in_stream}(). put@(character, data_out_stream.out_stream) data_out_stream.hash :+= unsigned_convert@(character) data_out_stream.offset :+= 1 procedure deallocate@data_out_stream takes data_out_stream data_out_stream returns_nothing #: This procedure will deallocate {data_out_stream} and make it #, available for subsequent reallocation. resources :@= data_out_stream.resources if data_out_stream.out_stream !== ?? errors :@= resources.global.errors format@errors1[file_name](errors, '%ds% was not properly closed!\n\', data_out_stream.final_file_name) close@(data_out_stream.out_stream) data_out_stream.out_stream := ?? string_deallocate@(resources, data_out_stream.buffer) erase@(data_out_stream) data_out_stream.resources := resources data_out_stream_deallocate@(resources, data_out_stream) procedure file_name_write@data_out_stream takes data_out_stream data_out_stream file_name file_name returns_nothing #: This procedure will write {file_name} out to {data_out_stream} such #, that it can be easily read by {file_name_read}@{data_in_stream}(). #, ??@{file_name} is a legal value. if file_name == ?? string_write@(data_out_stream, "") else file_name_string :@= string_convert@(file_name) string_write@(data_out_stream, file_name_string) procedure hash_write@data_out_stream takes data_out_stream data_out_stream number unsigned returns_nothing #: This procedure will write {hash} out to {data_out_stream} #, such that it can be easily read by {hash_read}@{data_in_stream}(). space_write@(data_out_stream) character_write@(data_out_stream, "#"[0]) unsigned_write_helper@(data_out_stream, number) character_write@(data_out_stream, "."[0]) procedure header_write@data_out_stream takes data_out_stream data_out_stream tag character file_type string major unsigned minor unsigned returns_nothing tag_write@(data_out_stream, tag) string_write@(data_out_stream, file_type) unsigned_write@(data_out_stream, major) unsigned_write@(data_out_stream, minor) new_line_write@(data_out_stream) procedure logical_write@data_out_stream takes data_out_stream data_out_stream value logical returns_nothing #: This procedure will write {value} to {data_out_stream} such that #, it can be read back in by {logica_read}@{data_in_stream}(). space_write@(data_out_stream) character_write@(data_out_stream, (value ? "T" : "F")[0]) procedure new_line_write@data_out_stream takes data_out_stream data_out_stream returns_nothing #: This procedure will write out a new-line sequence to {data_out_stream} #, such that it can be read back in by {new_line_read}@{data_in_stream}(). new_line :@= data_out_stream.new_line size :@= new_line.size put@(new_line, data_out_stream.out_stream) data_out_stream.offset :+= size data_out_stream.hash :+= unsigned_convert@("\n\"[0]) procedure open@data_out_stream takes final_file_name file_name resources resources errors errors returns data_out_stream #: This procedure will open and return a {data_out_stream} object #, that ultimately writes to {final_file_name}. If any error #, occurs, an error message is output to {errors} and #, ??@{data_out_stream} is returned. assert resources !== ?? side_file_name :@= prefix_prepend@(final_file_name, "t.") out_stream :@= write_open@(side_file_name, errors) #debug_stream :@= resources.global.debug_stream #format@format1[file_name](debug_stream, # "Opening %ds% ...", side_file_name) if out_stream == ?? #put@(" Failed!\n\", debug_stream) return ?? #put@(" Succeeded!\n\", debug_stream) data_out_stream :@= xallocate@data_out_stream(resources) data_out_stream.errors := errors data_out_stream.hash := 0 data_out_stream.final_file_name := final_file_name data_out_stream.out_stream := out_stream data_out_stream.new_line := final_file_name.file_system.new_line data_out_stream.side_file_name := side_file_name return data_out_stream procedure space_write@data_out_stream takes data_out_stream data_out_stream returns_nothing #: This procedure will write a space out to {data_out_stream} such #, that it can be read back in by {space_read}@{data_in_stream}(). character_write@(data_out_stream, " "[0]) procedure status_mode_write@data_out_stream takes data_out_stream data_out_stream status_mode status_mode returns_nothing #: This procedure will write {status_mode} out to {data_out_stream} such #, that it can be read back in by {status_mode_read}@{data_in_stream}(). value :@= "other" switch status_mode case deleted value := "deleted" case directory value := "directory" case regular_file value := "regular_file" case symbolic_link value := "symbolic_link" string_write@(data_out_stream, value) procedure string_write@data_out_stream takes data_out_stream data_out_stream line string returns_nothing #: This procedure will write {bytes} out to {data_out_stream} #, as a sequence of charactes and escaped hexadecimal numbers. #, This can easily be read back in via a call to #, {line_read}@{data_in_stream}(). space :@= " "[0] tilde :@= "~"[0] percent :@= "%"[0] quote :@= '"'[0] hash :@= data_out_stream.hash out_stream :@= data_out_stream.out_stream space_write@(data_out_stream) character_write@(data_out_stream, quote) offset :@= data_out_stream.offset size :@= line.size index :@= 0 loop while index < size character :@= line[index] hash :+= unsigned_convert@(character) #FIXME: wrong!! if space <= character && character <= tilde && character != percent && character != quote put@(character, out_stream) offset :+= 1 else put@("%", out_stream) byte :@= unsigned_convert@(character) put@("0123456789ABCDEF"[byte >> 4], out_stream) put@("0123456789ABCDEF"[byte & 15], out_stream) offset :+= 3 index :+= 1 data_out_stream.offset := offset data_out_stream.hash := hash character_write@(data_out_stream, quote) procedure tag_write@data_out_stream takes data_out_stream data_out_stream tag character returns_nothing #: This procedure will write out {tag} to {data_out_stream} so that #, it can easily be read back in by {tag_read}@{data_in_stream}(). character_write@(data_out_stream, tag) procedure timestamp_write@data_out_stream takes data_out_stream data_out_stream timestamp unsigned returns_nothing #: This procedure will interpret {timestamp} as an date measured in #, seconds since January 1, 1970 and write it to {data_out_stream} #, using the format yyyy/mm/dd@hh:mm:ss-GMT. assert timestamp != 0 assert data_out_stream !== ?? buffer :@= data_out_stream.buffer trim@(buffer, 0) timestamp_append@(buffer, timestamp) space_write@(data_out_stream) string_write@(data_out_stream, buffer) assert timestamp_lop@(buffer) = timestamp procedure unsigned_write@data_out_stream takes data_out_stream data_out_stream number unsigned returns_nothing #: This procedure will write {number} out to {data_out_stream} #, such that it can be easily read by {unsigned_read}@{data_in_stream}(). space_write@(data_out_stream) unsigned_write_helper@(data_out_stream, number) character_write@(data_out_stream, "."[0]) procedure unsigned_write_helper@data_out_stream takes data_out_stream data_out_stream number unsigned returns_nothing #: This procedure will write {number} to {data_out_stream} #, as a decimal number. if number >= 10 unsigned_write_helper@(data_out_stream, number / 10) # 48 = unsigned_convert@("0"[0]) character_write@(data_out_stream, character_convert@(48 + number % 10))