|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
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⟧
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