DataMuseum.dk

top - download

    Length: 4695 (0x1257)
    Types: TextFile
    Notes: R1k Text-file segment

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

TextFile

with a_strings;
with unchecked_conversion;
with System; use System;
package body C_strings is

	use ascii;

	function c_length (s : c_string) return integer is
	begin
		for i in s'range loop
			if s(i) = nul then
				return i-1;
			end if;
		end loop;
	end c_length;

	function convert_c_to_string(s : c_string) return string is
	begin
		if s = null then
			return "";
		else
			return s(1..c_length(s));
		end if;
	end convert_c_to_string;

	function convert_c_to_a(s : c_string) return A_strings.a_string is
	begin
		return A_strings.to_a(convert_c_to_string(s));
	end convert_c_to_a;

	function convert_a_to_c(s : A_strings.a_string) return c_string is
	begin
		return address_to_c(A_strings.to_C(s));
	end convert_a_to_c;

	function to_c(s: A_strings.a_string; buf: system.address) return c_string is
		c: c_string := address_to_c(buf);
	begin
		c(1..s.len) := s.s(1..s.len);
		c(s.len + 1) := ascii.nul;
		return c;
	end;

	function convert_string_to_c(s : string) return c_string is
		len: integer := (s'last - s'first + 1) + 1;
		type string_ptr is access string(1 .. len);
		buffer: string_ptr := new string(1 .. len);
	begin
		return to_c(s, buffer(1)'address);
	end convert_string_to_c;

	function to_c(s: string; buf: system.address) return c_string is
		c: c_string := address_to_c(buf);
		len: integer := s'length;
	begin
		c(1..len) := s;
		c(len + 1) := ascii.nul;
		return c;
	end;

	function strcmp(a, b: c_string) return boolean is
		len: integer;
	begin
		if a = null then
			return b = null;
		elsif b = null then
			return FALSE;
		end if;
		len := c_length(a) + 1;
		return a(1..len) = b(1..len);	-- include nul in compare
	end;

	function strcmp(a: c_string; b: A_strings.a_string) return boolean is
		len: integer;
	begin
		if a = null then
			return A_strings."="(b, null);
		elsif A_strings."="(b, null) then
			return FALSE;
		end if;
		len := c_length(a);
		return b.len = len and then a(1..len) = b.s;
	end;

	function strcmp(a: A_strings.a_string; b: c_string) return boolean is
		len: integer;
	begin
		if b = null then
			return A_strings."="(a, null);
		elsif A_strings."="(a, null) then
			return FALSE;
		end if;
		len := c_length(b);
		return a.len = len and then b(1..len) = a.s;
	end;

	function strcmp(a: c_string; b: string) return boolean is
		len: integer;
	begin
		len := c_length(a);
		return b'length = len and then a(1..len) = b;
	end;

	function strcmp(a: string; b: c_string) return boolean is
		len: integer := c_length(b);
	begin
		return a'length = len and then b(1..len) = a;
	end;

	function  strcmp(x, y: c_string) return integer is
		j: integer;
	begin
		j := y'first;
		for i in x'first .. c_length(x) loop
			if x(i) < y(j) then
				return -1;
			elsif x(i) > y(j) then
				return 1;
			end if;
			j := j + 1;
		end loop;
		if j <= c_length(y) then
			return -1;
		else
			return 0;
		end if;
	exception
	when constraint_error =>
		return 1;
	end;

	function strcpy(to: c_string; from: string) return c_string
	is
		i : integer;
	begin
		i := 1;
		for j in from'range loop
			to(i) := from(j);
			i := i + 1;
		end loop;
		to(i) := ascii.nul;
		return to;
	end;

	function strcpy(to: c_string; from: a_strings.a_string) return c_string
	is
		i : integer;
	begin
		i := 1;
		for j in 1 .. from.len loop
			to(i) := from.s(j);
			i := i + 1;
		end loop;
		to(i) := ascii.nul;
		return to;
	end;

	function strcpy(to: c_string; from: c_string) return c_string
	is
		i : integer;
	begin
		i := 1;
		for j in 1 .. c_length(from) loop
			to(i) := from(j);
			i := i + 1;
		end loop;
		to(i) := ascii.nul;
		return to;
	end;

	function strcat(to: c_string; from: string) return c_string
	is
		i : integer;
	begin
		i := c_length(to) + 1;
		for j in from'range loop
			to(i) := from(j);
			i := i + 1;
		end loop;
		to(i) := ascii.nul;
		return to;
	end;

	function strcat(to: c_string; from: a_strings.a_string) return c_string
	is
		i : integer;
	begin
		i := c_length(to) + 1;
		for j in 1 .. from.len loop
			to(i) := from.s(j);
			i := i + 1;
		end loop;
		to(i) := ascii.nul;
		return to;
	end;

	function strcat(to: c_string; from: c_string) return c_string
	is
		i : integer;
	begin
		i := c_length(to) + 1;
		for j in 1 .. c_length(from) loop
			to(i) := from(j);
			i := i + 1;
		end loop;
		to(i) := ascii.nul;
		return to;
	end;

	function string_copy(a: c_string) return c_string is
	begin
		return convert_a_to_c(A_strings.to_a(a(1..c_length(a))));
	end;

	function rindex(str : c_strings.c_string; ch : character) return integer
	is
		last : integer := 0;
	begin
		for i in str'range loop
			if str(i) = ch then
				last := i;
			elsif str(i) = ascii.nul then
				return last;
			end if;
		end loop;
		return 0;
	end;
end C_strings