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

⟦e8887c6f5⟧ TextFile

    Length: 3592 (0xe08)
    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« 
        └─⟦f9e6affc4⟧ 
            └─⟦this⟧ 

TextFile

with transport_defs; use transport_defs;
with system;
with daemon_talk;
with transport_byte_order;

-- This package body is for talk_io (breakpointed Ada I/O).  It's shared
-- between the host (daemons) and target (in the talk_io library).
--
package body transport is

	use transport_byte_order;

	PACKET_LENGTH: constant := 24;

	type byte_array is array(NATURAL range <>) of character;

	subtype packet_data is byte_array(1..PACKET_LENGTH);

	type packet is record
		channel: transport_integer;
		length:  transport_integer;
		more:    transport_integer;
		sum:     transport_integer;
		data:    packet_data;
	end record;

	PKT_SIZE: constant integer := packet'size / 8;

	scanned: boolean;
	pkt: packet;

	procedure send_packet is
	begin
		pkt.sum := 0;
		daemon_talk.do_io(pkt'address, PKT_SIZE, 1);
	end;

	function receive_packet return boolean is
	begin
		daemon_talk.do_io(pkt'address, PKT_SIZE, 2);
		return TRUE;
	end;

	--------------------------------------
	-- Breaks the message up into fixed --
	-- size packets and sends them out. --
	--------------------------------------
	procedure send(
			chan:		in transport_defs.channel_t;
			count:		in natural;
			buf_addr:	in system.address
		)
	is
		L: integer;
		more : boolean;
		current: integer := 0;
		data: byte_array(1..count);
		for data use at buf_addr;
	begin
		pkt.channel := to_transport_integer(integer(chan));
		loop
			L := count - current;
			if L > PACKET_LENGTH then
				L := PACKET_LENGTH;
			end if;
			pkt.data(1..L) := data(current + 1..current + L);
			pkt.length := to_transport_integer(L);
			current := current + L;
			more := current < count;
			pkt.more := to_transport_integer(boolean'pos(more));
			send_packet;
			exit when not more;
		end loop;
	end;

	----------------------------------------------------------------
	-- Reads the channel number and saves it. This call must be   --
	-- followed by a receive call before any send calls are made. --
	----------------------------------------------------------------
	function scan(timeout: boolean := FALSE) return channel_t
	is
	begin
		if not scanned then
			loop
				exit when receive_packet;
				if timeout then
					raise transport_timeout;
				end if;
			end loop;
			scanned := TRUE;
		end if;
		return channel_t(to_local_integer(pkt.channel));
	end;

	------------------------------------
	-- Receive no more than count bytes --
	------------------------------------
	procedure receive(
			chan:		in transport_defs.channel_t;
			count:		in out natural;
			buf_addr:	in system.address;
			rcvd_msg:	out boolean
		)
	is
		L: integer;
		more : boolean;
		current: integer := 0;
		data: byte_array(1..count);
		for data use at buf_addr;
	begin
		if count < 0 then
			raise transport_error;
		end if;
		if scan /= chan then
			scanned := FALSE;
			raise transport_error;
		end if;
		scanned := FALSE;
		loop
			L := to_local_integer(pkt.length);
			if L > count then
				raise transport_error;
			end if;
			data(current + 1..current + L) := pkt.data(1..L);
			current := current + L;
			more := boolean'val(to_local_integer(pkt.more));
			exit when not more;
			if not receive_packet then
				raise transport_error;
			end if;
		end loop;
		count := current; -- bytes
		rcvd_msg := TRUE;
	end;

	procedure put_signal(sig: transport_defs.tdm_sig_t) is
	begin
		null;
	end put_signal;


	procedure reset is
	begin
		scanned := FALSE;
	end;

	procedure initialize(
			verbose:	boolean := FALSE;
			preempt:	boolean := FALSE
		)
	is
	begin
		reset;
	end initialize;

	procedure shutdown is
	begin
		null;
	end shutdown;

begin
	reset;
end transport;