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 resources #: This module implements the resource allocation. import address character chunk data_io delta errors file_name file_system format history in_stream logical manage misc out_stream project set slice status string svms unsigned vector version define resources #: Delta memory management object record chunk manage[chunk] #: Free {chunk}'s chunk_range manage[chunk_range] #: Free {chunk_range}'s chunk_ranges manage[chunk_ranges] #: Free {chunk_ranges}'s chunks manage[chunks] #: Free {chunks}'s data_in_stream manage[data_in_stream] #: Free {data_in_stream}'s data_out_stream manage[data_out_stream] #: Free {data_out_stream}'s delta manage[delta] #: Free {delta}'s global global #: Global information history manage[history] #: Free {history}'s project manage[project] #: Free {project}'s project_directory manage[project_directory] project_directorys manage[project_directorys] project_file manage[project_file] #: Free {project_file}'s project_files manage[project_files] #: Free {project_files}'s project_name manage[project_name] #: Free {project_name}'s share_table manage[set[chunk]] #: Free share table list slice manage[slice] #: Free {slice}'s string manage[string] # Free (writable) {string}'s strings manage[vector[string]] # Free strings version manage[version] #: Free {version}'s generate allocate, erase, identical, print #: {resources} procedures for managing memory: procedure create@resources takes debug logical global global returns resources #: This procedure will create and return a new {resources} object allocated #, from {global}. If {debug} is {true}, an dellocations are checked #, very carefully for duplicate dallocations. errors :@= global.errors assert global !== ?? assert errors !== ?? initialize resources:: resources := allocate@resources() resources.chunk := create@manage[chunk]("chunk", debug, errors) resources.chunk_range := create@manage[chunk_range]("chunk_range", debug, errors) resources.chunk_ranges := create@manage[chunk_ranges]("chunk_ranges", debug, errors) resources.chunks := create@manage[chunks]("chunks", debug, errors) resources.data_in_stream := create@manage[data_in_stream]("data_in_stream", debug, errors) resources.data_out_stream := create@manage[data_out_stream]("data_out_stream", debug, errors) resources.delta := create@manage[delta]("delta", debug, errors) resources.global := global resources.history := create@manage[history]("history", debug, errors) resources.project := create@manage[project]("project", debug, errors) resources.project_directory := create@manage[project_directory]("project_directory", debug, errors) resources.project_directorys := create@manage[project_directorys]("project_directorys", debug, errors) resources.project_file := create@manage[project_file]("project_file", debug, errors) resources.project_files := create@manage[project_files]("project_files", debug, errors) resources.project_name := create@manage[project_name]("project_name", debug, errors) resources.share_table := create@manage[set[chunk]]("share_table", debug, errors) resources.slice := create@manage[slice]("slice", debug, errors) resources.string := create@manage[string]("string", debug, errors) resources.strings := create@manage[vector[string]]("strings", debug, errors) resources.version := create@manage[version]("version", debug, errors) return resources procedure leaks_check@resources takes resources resources errors errors returns logical #: This procedure will verify that all of the object being managed #, {resources} have been returned. If any objects have not been returned #, an error message is output to {error_stream} and {true} is returned. assert resources !== ?? result:: logical := false result :|= leaks_check@(resources.chunk) result :|= leaks_check@(resources.chunk_range) result :|= leaks_check@(resources.chunk_ranges) result :|= leaks_check@(resources.chunks) result :|= leaks_check@(resources.data_in_stream) result :|= leaks_check@(resources.data_out_stream) result :|= leaks_check@(resources.delta) result :|= leaks_check@(resources.history) result :|= leaks_check@(resources.project) result :|= leaks_check@(resources.project_directory) result :|= leaks_check@(resources.project_directorys) result :|= leaks_check@(resources.project_file) result :|= leaks_check@(resources.project_files) result :|= leaks_check@(resources.project_name) result :|= leaks_check@(resources.share_table) result :|= leaks_check@(resources.slice) result :|= leaks_check@(resources.string) result :|= leaks_check@(resources.strings) result :|= leaks_check@(resources.version) return result procedure chunk_allocate@resources takes resources resources returns chunk #: This procedure will allocate a new {chunk} object from {resources}. assert resources !== ?? debug_stream :@= resources.global.debug_stream chunk :@= xallocate@(resources.chunk) chunk.resources := resources #format@format1[address](debug_stream, # "chunk_allocate()=>%X%\n\", chunk.address) return chunk procedure chunk_deallocate@resources takes resources resources chunk chunk returns_nothing #: This routine will return {chunk} to {resources} for subsequent #, reallocation. assert resources !== ?? deallocate@(resources.chunk, chunk) procedure chunk_range_allocate@resources takes resources resources returns chunk_range #: This procedure will allocate a new {chunk_range} object from #, {resources}. assert resources !== ?? chunk_range :@= xallocate@(resources.chunk_range) chunk_range.resources := resources return chunk_range procedure chunk_range_deallocate@resources takes resources resources chunk_range chunk_range returns_nothing #: This routine will return {chunk_range} to {resources} for subsequent #, reallocation. assert resources !== ?? deallocate@(resources.chunk_range, chunk_range) procedure chunk_ranges_allocate@resources takes resources resources returns chunk_ranges #: This procedure will allocate a new {chunk_ranges} object from #, {resources}. assert resources !== ?? chunk_ranges :@= xallocate@(resources.chunk_ranges) chunk_ranges.resources := resources return chunk_ranges procedure chunk_ranges_deallocate@resources takes resources resources chunk_ranges chunk_ranges returns_nothing #: This routine will return {chunk_ranges} to {resources} for subsequent #, reallocation. assert resources !== ?? deallocate@(resources.chunk_ranges, chunk_ranges) procedure chunks_allocate@resources takes resources resources returns chunks #: This procedure will allocate a new {chunks} object from {resources}. assert resources !== ?? chunks :@= xallocate@(resources.chunks) chunks.resources := resources return chunks procedure chunks_deallocate@resources takes resources resources chunks chunks returns_nothing #: This routine will return {chunks} to {resources} for subsequent #, reallocation. assert resources !== ?? deallocate@(resources.chunks, chunks) procedure data_in_stream_allocate@resources takes resources resources returns data_in_stream #: This procedure will allocate a new {data_in_stream} object from #, {resources}. assert resources !== ?? data_in_stream :@= xallocate@(resources.data_in_stream) data_in_stream.resources := resources return data_in_stream procedure data_in_stream_deallocate@resources takes resources resources data_in_stream data_in_stream returns_nothing #: This routine will return {data_in_stream} to {resources} for subsequent #, reallocation. assert resources !== ?? deallocate@(resources.data_in_stream, data_in_stream) procedure data_out_stream_allocate@resources takes resources resources returns data_out_stream #: This procedure will allocate a new {data_out_stream} object from #, {resources}. assert resources !== ?? data_out_stream :@= xallocate@(resources.data_out_stream) data_out_stream.resources := resources return data_out_stream procedure data_out_stream_deallocate@resources takes resources resources data_out_stream data_out_stream returns_nothing #: This routine will return {data_out_stream} to {resources} for #, subsequent reallocation. assert resources !== ?? deallocate@(resources.data_out_stream, data_out_stream) procedure delta_allocate@resources takes resources resources returns delta #: This procedure will allocate a new {delta} object from {resources}. assert resources !== ?? delta :@= xallocate@(resources.delta) delta.resources := resources return delta procedure delta_deallocate@resources takes resources resources delta delta returns_nothing #: This routine will return {delta} to {resources} for subsequent #, reallocation. assert resources !== ?? deallocate@(resources.delta, delta) procedure history_allocate@resources takes resources resources returns history #: This procedure will allocate a new {history} object from {resources}. assert resources !== ?? history :@= xallocate@(resources.history) history.resources := resources return history procedure history_deallocate@resources takes resources resources history history returns_nothing #: This routine will return {history} to {resources} for subsequent #, reallocation. assert resources !== ?? assert history !== ?? deallocate@(resources.history, history) procedure project_allocate@resources takes resources resources returns project #: This procedure will allocate a new {project} object from {resources}. assert resources !== ?? project :@= xallocate@(resources.project) return project procedure project_deallocate@resources takes resources resources project project returns_nothing #: This routine will return {project} to {resources} for subsequent #, reallocation. assert resources !== ?? assert project !== ?? deallocate@(resources.project, project) procedure project_directory_allocate@resources takes resources resources returns project_directory #: This procedure will allocate a new {project_driectory} object #, from {resources} and return it. assert resources !== ?? project_directory :@= xallocate@(resources.project_directory) return project_directory procedure project_directory_deallocate@resources takes resources resources project_directory project_directory returns_nothing #: This routine will return {project_directory} to {resources} for #, subsequent reallocation. assert resources !== ?? assert project_directory !== ?? deallocate@(resources.project_directory, project_directory) procedure project_directorys_allocate@resources takes resources resources returns project_directorys #: This procedure will allocate a new {vector}[{project_directory}] object #, from {resources} and return it. assert resources !== ?? project_directorys :@= xallocate@(resources.project_directorys) return project_directorys procedure project_directorys_deallocate@resources takes resources resources project_directorys project_directorys returns_nothing #: This routine will return {project_directorys} to {resources} for #, subsequent reallocation. assert resources !== ?? assert project_directorys !== ?? deallocate@(resources.project_directorys, project_directorys) procedure project_file_allocate@resources takes resources resources returns project_file #: This procedure will allocate a new {project_driectory} object #, from {resources} and return it. assert resources !== ?? project_file :@= xallocate@(resources.project_file) return project_file procedure project_file_deallocate@resources takes resources resources project_file project_file returns_nothing #: This routine will return {project_file} to {resources} for #, subsequent reallocation. assert resources !== ?? assert project_file !== ?? deallocate@(resources.project_file, project_file) procedure project_files_allocate@resources takes resources resources returns project_files #: This procedure will allocate a new {project_directorys} object #, from {resources} and return it. assert resources !== ?? project_files :@= xallocate@(resources.project_files) return project_files procedure project_files_deallocate@resources takes resources resources project_files project_files returns_nothing #: This routine will return {project_files} to {resources} for #, subsequent reallocation. assert resources !== ?? assert project_files !== ?? deallocate@(resources.project_files, project_files) procedure project_name_allocate@resources takes resources resources returns project_name #: This procedure will allocate a new {project_name} object from #, {resources} and return it. assert resources !== ?? project_name :@= xallocate@(resources.project_name) return project_name procedure project_name_deallocate@resources takes resources resources project_name project_name returns_nothing #: This routine will return {project_name} to {resources} for subsequent #, reallocation. assert resources !== ?? assert project_name !== ?? deallocate@(resources.project_name, project_name) procedure share_table_allocate@resources takes resources resources returns set[chunk] #: This procedure will allocate a new share table from {resources} assert resources !== ?? if resources.share_table.free_count = 0 share_table :@= xcreate@set[chunk](100) free_append@(resources.share_table, share_table) share_table :@= xallocate@(resources.share_table) return share_table procedure share_table_deallocate@resources takes resources resources share_table set[chunk] returns_nothing assert resources !== ?? deallocate@(resources.share_table, share_table) procedure slice_allocate@resources takes resources resources returns slice #: This procedure will allocate a new {slice} object from {resources}. assert resources !== ?? slice :@= xallocate@(resources.slice) #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # 'Allocated slice %X%\n\', slice.address) return slice procedure slice_deallocate@resources takes resources resources slice slice returns_nothing #: This routine will return {slice} to {resources} for subsequent #, reallocation. assert resources !== ?? #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # 'Deallocated slice %X%\n\', slice.address) deallocate@(resources.slice, slice) procedure string_allocate@resources takes resources resources returns string #: This procedure will allocate a new {string} object from {resources}. assert resources !== ?? string :@= xallocate@(resources.string) #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # "string_allocate@resources()=>%X%\n\", string.address) return string procedure string_deallocate@resources takes resources resources string string returns_nothing #: This routine will return {string} to {resources} for subsequent #, reallocation. assert resources !== ?? if !(string.is_buffered) debug_stream :@= resources.global.debug_stream format@format1[string](debug_stream, 'Deallocating read only string %ds%\n\', string) assert false trim@(string, 0) #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # "string_deallocate@resources(%X%)\n\", string.address) deallocate@(resources.string, string) procedure strings_allocate@resources takes resources resources returns vector[string] #: This procedure will allocate a new string list object from {resources}. assert resources !== ?? strings :@= xallocate@(resources.strings) return strings procedure strings_deallocate@resources takes resources resources strings vector[string] returns_nothing #: This routine will return {strings} to {resources} for subsequent #, reallocation. assert resources !== ?? size :@= strings.size index :@= 0 loop while index < size string :@= strings[index] string_deallocate@(resources, string) index :+= 1 truncate@(strings, 0) deallocate@(resources.strings, strings) procedure version_allocate@resources takes resources resources returns version #: This procedure will allocate a new {version} object from {resources}. assert resources !== ?? version :@= xallocate@(resources.version) version.resources := resources return version procedure version_deallocate@resources takes resources resources version version returns_nothing #: This routine will return {version} to {resources} for subsequent #, reallocation. assert resources !== ?? deallocate@(resources.version, version)