DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦fd069c3de⟧ TextFile

    Length: 7946 (0x1f0a)
    Types: TextFile
    Notes: R1k Text-file segment

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦60e79ca99⟧ 
            └─⟦this⟧ 

TextFile

with io_exceptions, file_support;
package text_io is

	type file_type is limited private;

	type file_mode is (in_file, out_file);

	type count		is range 0 .. integer'last;
	subtype positive_count		is count range 1 .. count'last;
	unbounded: constant count := 0;	-- line and page length

	subtype field			is integer range 0 .. integer'last;
	subtype number_base		is integer range 2 .. 16;

	type type_set is (lower_case, upper_case);

	-- file management

	procedure create(file:	in out file_type;
					 mode:	in file_mode := out_file;
					 name:	in string := "";
					 form:	in string := "");

	procedure open	(file:	in out file_type;
					 mode:	in file_mode;
					 name:	in string;
					 form:	in string := "");

	procedure close	(file:	in out file_type);
	procedure delete(file:	in out file_type);
	procedure reset	(file:	in out file_type; mode:	in file_mode);
	procedure reset	(file:	in out file_type);

	function mode	(file:	in file_type) return file_mode;
	function name	(file:	in file_type) return string;
	function form	(file:	in file_type) return string;

	function is_open(file:	in file_type) return boolean;

	-- control of default input and output files

	procedure set_input	(file:	in file_type);
	procedure set_output(file:	in file_type);

	function standard_input		return file_type;
	function standard_output	return file_type;
	function standard_error		return file_type;

	function current_input		return file_type;
	function current_output		return file_type;

	-- specification of line and page lengths

	procedure set_line_length	(file:	in file_type; to:	in count);
	procedure set_line_length	(to:	in count);

	procedure set_page_length	(file:	in file_type; to:	in count);
	procedure set_page_length	(to:	in count);

	function line_length(file:	in file_type) return count;
	function line_length	return count;

	function page_length(file:	in file_type) return count;
	function page_length	return count;

	-- column, line, and page control

	procedure new_line	(file:		in file_type;
						 spacing:	in positive_count := 1);
	procedure new_line	(spacing:	in positive_count := 1);

	procedure skip_line	(file:		in file_type;
						 spacing:	in positive_count := 1);
	procedure skip_line	(spacing:	in positive_count := 1);

	function end_of_line(file:	in file_type) return boolean;
	function end_of_line	return boolean;

	procedure new_page	(file:	in file_type);
	procedure new_page;

	procedure skip_page	(file:	in file_type);
	procedure skip_page;

	function end_of_page(file:	in file_type) return boolean;
	function end_of_page	return boolean;

	function end_of_file(file:	in file_type) return boolean;
	function end_of_file	return boolean;

	procedure set_col	(file:	in file_type; to:	in positive_count);
	procedure set_col	(to:	in positive_count);

	procedure set_line	(file:	in file_type; to:	in positive_count);
	procedure set_line	(to:	in positive_count);

	function col	(file:	in file_type) return positive_count;
	function col	return positive_count;

	function line	(file:	in file_type) return positive_count;
	function line	return positive_count;

	function page	(file:	in file_type) return positive_count;
	function page	return positive_count;

	-- character input-output

	procedure get	(file:	in file_type; item:	out character);
	procedure get	(item:	out character);
	procedure put	(file:	in file_type; item:	in character);
	procedure put	(item:	in character);

	-- string input-output

	procedure get	(file:	in file_type; item:	out string);
	procedure get	(item:	out string);
	procedure put	(file:	in file_type; item:	in string);
	procedure put	(item:	in string);

	procedure get_line(file: in file_type; item: out string; last: out natural);
	procedure get_line(item: out string; last: out natural);
	procedure put_line(file: in file_type; item: in string);
	procedure put_line(item: in string);

	-- generic package for input-output of integer types

	generic
		type num is range <>;
	package integer_io is
		default_width:	field := num'width;
		default_base:	number_base := 10;


		procedure get	(file:	in file_type;
						 item:	out num;
						 width: in field := 0);
		procedure get	(item:	out num;	width: in field := 0);

		procedure put	(file:	in file_type;
						 item:	in num;
						 width:	in field := default_width;
						 base:	in number_base := default_base);
		procedure put	(item:	in num;
						 width:	in field := default_width;
						 base:	in number_base := default_base);

		procedure get	(from:	in string;
						 item:	out num;
						 last:	out positive);
		procedure put	(to:	out string;
						 item:	in num;
						 base:	in number_base := default_base);

	end integer_io;

	-- generic package for input-output of real types

	generic
		type num is digits <>;
	package float_io is
		default_fore:	field := 2;
		default_aft:	field := num'digits - 1;
		default_exp:	field := 3;


		procedure get	(file:	in file_type;
						 item:	out num;
						 width: in field := 0);
		procedure get	(item:	out num;	width: in field := 0);

		procedure put	(file:	in file_type;
						 item:	in num;
						 fore:	in field := default_fore;
						 aft:	in field := default_aft;
						 exp:	in field := default_exp);
		procedure put	(item:	in num;
						 fore:	in field := default_fore;
						 aft:	in field := default_aft;
						 exp:	in field := default_exp);

		procedure get	(from:	in string;
						 item:	out num;
						 last:	out positive);
		procedure put	(to:	out string;
						 item:	in num;
						 aft:	in field := default_aft;
						 exp:	in field := default_exp);

	end float_io;

	generic
		type num is delta <>;
	package fixed_io is
		default_fore:	field := num'fore;
		default_aft:	field := num'aft;
		default_exp:	field := 0;


		procedure get	(file:	in file_type;
						 item:	out num;
						 width: in field := 0);
		procedure get	(item:	out num;	width: in field := 0);

		procedure put	(file:	in file_type;
						 item:	in num;
						 fore:	in field := default_fore;
						 aft:	in field := default_aft;
						 exp:	in field := default_exp);
		procedure put	(item:	in num;
						 fore:	in field := default_fore;
						 aft:	in field := default_aft;
						 exp:	in field := default_exp);

		procedure get	(from:	in string;
						 item:	out num;
						 last:	out positive);
		procedure put	(to:	out string;
						 item:	in num;
						 aft:	in field := default_aft;
						 exp:	in field := default_exp);

	end fixed_io;

	generic
		type enum is (<>);
	package enumeration_io is
		default_width:		field := 0;
		default_setting:	type_set := upper_case;


		procedure get	(file:	in file_type; item:	out enum);
		procedure get	(item:	out enum);

		procedure put	(file:	in file_type;
						 item:	in enum;
						 width:	in field := default_width;
						 set:	in type_set := default_setting);
		procedure put	(item:	in enum;
						 width:	in field := default_width;
						 set:	in type_set := default_setting);

		procedure get	(from:	in string;
						 item:	out enum;
						 last:	out positive);
		procedure put	(to:	out string;
						 item:	in enum;
						 set:	in type_set := default_setting);

	end enumeration_io;

	-- exceptions

	status_error:	exception renames io_exceptions.status_error;
	mode_error:		exception renames io_exceptions.mode_error;
	name_error:		exception renames io_exceptions.name_error;
	use_error:		exception renames io_exceptions.use_error;
	device_error:	exception renames io_exceptions.device_error;
	end_error:		exception renames io_exceptions.end_error;
	data_error:		exception renames io_exceptions.data_error;
	layout_error:	exception renames io_exceptions.layout_error;

private
	type file_type is new file_support.file_ptr;

	std_input	: file_support.file_ptr;
	std_output	: file_support.file_ptr;
	std_error	: file_support.file_ptr;
	cur_input	: file_support.file_ptr;
	cur_output	: file_support.file_ptr;

	pragma share_code(integer_io, true);
	pragma share_code(float_io, true);
	pragma share_code(fixed_io, false);
	pragma share_code(enumeration_io, true);

end text_io