|
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: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body U_Env, seg_04b99f
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Language, Unchecked_Conversion, Unchecked_Deallocation;
with System, A_Strings, C_Strings;
use System, A_Strings, C_Strings;
package body U_Env is
procedure Free is new Unchecked_Deallocation (Str_Vector, Argv_Ptr);
Bytes_For_Address : constant Integer := Address'Size / 8;
-- This is the structure that the register sp points to when a unix process
-- starts up. The first kargc pointers in kargv point to the argv strings.
-- This is followed by a null pointer and then an array of pointers to the
-- environment strings.
type Kframe is
record
Kargc : Integer;
Kfirst_Arg : Address; -- more arg pointers follow
end record;
type Kframe_Ptr is access Kframe;
pragma Local_Access (Kframe_Ptr);
-- This is the contents of the sp register when the process
-- was started.
U_Mainp : Kframe_Ptr; -- set by Ada's startup.s
pragma Interface_Name (U_Mainp, "__u_mainp");
Environ : Address;
pragma Interface_Name (Environ, Language.C_Prefix & "environ");
-- This pointer keeps track of where to get the next string
Next : Address := No_Addr;
type Ptr_To_Address is access C_String;
pragma Local_Access (Ptr_To_Address);
function Cvt_Ptr is new Unchecked_Conversion (Address, Ptr_To_Address);
function Next_Str return A_String is
New_Str : A_String;
Str : C_String;
Str_Size : Integer;
begin
if Next = No_Addr then
Next := U_Mainp.Kfirst_Arg;
end if;
Str := Cvt_Ptr (Next).all;
if Str = null then
-- There is a null pointer separating the argv strings from the
-- env strings.
if Next /= U_Mainp.Kfirst_Arg +
Bytes_For_Address * U_Mainp.Kargc then
return null;
end if;
Next := Next + Bytes_For_Address;
Str := Cvt_Ptr (Next).all;
end if;
New_Str := Convert_C_To_A (Str);
Next := Next + Bytes_For_Address;
return New_Str;
end Next_Str;
function U_Argc return Integer is
begin
return Integer (U_Mainp.Kargc);
end U_Argc;
function U_Envc return Integer is
Count : Integer;
Env_P : Address;
begin
-- Since we know argc, we can calculate where the beginning of
-- the environment string pointers is.
Env_P := U_Mainp.Kfirst_Arg + Bytes_For_Address * (U_Mainp.Kargc + 1);
Environ := Env_P;
Count := 0;
while (Cvt_Ptr (Env_P).all /= null) loop
Env_P := Env_P + Bytes_For_Address;
Count := Count + 1;
end loop;
return Count;
end U_Envc;
procedure Initialize_Globals is
begin
Argc := U_Argc;
Argv := new Str_Vector (0 .. Argc - 1);
for I in 0 .. Argc - 1 loop
Argv (I) := Next_Str;
end loop;
Envc := U_Envc;
Envp := new Str_Vector (0 .. Envc - 1);
for I in 0 .. Envc - 1 loop
Envp (I) := Next_Str;
end loop;
end Initialize_Globals;
pragma Inline_Only (Initialize_Globals);
------------------------------------------
-- functions to be used mainly by POSIX --
------------------------------------------
function Env_Name (Env_Var : A_Strings.A_String)
return A_Strings.A_String is
begin
for I in 1 .. Env_Var.Len loop
if (Env_Var.S (I) = '=') then
return new A_Strings.String_Rec'(I - 1, Env_Var.S (1 .. I - 1));
end if;
end loop;
return Env_Var;
end Env_Name;
function Env_Value (Env_Var : A_Strings.A_String)
return A_Strings.A_String is
Value : A_Strings.A_String;
Index : Integer := 1;
begin
for I in 1 .. Env_Var.Len loop
if (Env_Var.S (I) = '=') then
Value := new A_Strings.String_Rec (Env_Var.Len - I);
for J in (I + 1) .. Env_Var.Len loop
Value.S (Index) := Env_Var.S (J);
Index := Index + 1;
end loop;
return Value;
--\x09\x09\x09\x09RETURN new a_strings.string_rec'(env_var.len-i, env_var.s(i+1..env_var.len));
end if;
end loop;
return A_Strings.To_A ("");
end Env_Value;
function Env_Var_Pos (Name : A_Strings.A_String) return Integer is
Envp_Name : A_Strings.A_String;
begin
for I in 0 .. Envc - 1 loop
Envp_Name := Env_Name (Envp (I));
if (Envp_Name.S = Name.S) then
return I;
end if;
end loop;
return -1;
end Env_Var_Pos;
function Is_Env_Var (Name : A_Strings.A_String) return Boolean is
begin
if (Env_Var_Pos (Name) /= -1) then
return True;
end if;
return False;
end Is_Env_Var;
procedure Putenv is
C_Envp : array (0 .. Envc) of System.Address;
begin
for I in 0 .. Envc - 1 loop
C_Envp (I) := C_Strings.C_To_Address
(C_Strings.Convert_A_To_C (Envp (I)));
end loop;
C_Envp (Envc) := System.No_Addr;
Environ := C_Envp (C_Envp'First)'Address;
end Putenv;
procedure Add_Env_Var (Var : A_Strings.A_String) is
New_Envp : Argv_Ptr;
begin
-- copy information into a temp array
Envc := Envc + 1;
New_Envp := new Str_Vector (0 .. Envc - 1);
for I in 0 .. Envc - 2 loop
New_Envp (I) := Envp (I);
end loop;
New_Envp (Envc - 1) := Var;
-- free up old space
Free (Envp);
-- build new envp
Envp := new Str_Vector (0 .. Envc - 1);
for I in 0 .. Envc - 1 loop
Envp (I) := New_Envp (I);
end loop;
Free (New_Envp);
Putenv;
end Add_Env_Var;
procedure Del_Env_Var (Name : A_Strings.A_String) is
Pos : Integer;
New_Envp : Argv_Ptr;
begin
if (not Is_Env_Var (Name)) then
return;
end if;
Pos := Env_Var_Pos (Name);
Envc := Envc - 1;
-- copy information into a temp array
New_Envp := new Str_Vector (0 .. Envc - 1);
for I in 0 .. Pos - 1 loop
New_Envp (I) := Envp (I);
end loop;
for I in Pos + 1 .. Envc loop
New_Envp (I - 1) := Envp (I);
end loop;
-- free up old space
Free (Envp);
-- build new envp
Envp := new Str_Vector (0 .. Envc - 1);
for I in 0 .. Envc - 1 loop
Envp (I) := New_Envp (I);
end loop;
Free (New_Envp);
Putenv;
end Del_Env_Var;
function Getenv (Var_Name : C_Strings.C_String) return C_Strings.C_String is
Name : A_Strings.A_String := C_Strings.To_A (Var_Name);
Pos : Integer := Env_Var_Pos (Name);
begin
if (Pos /= -1) then
return C_Strings.To_C (Env_Value (Envp (Pos)));
end if;
return null;
end Getenv;
function Getenv (Var_Name : A_Strings.A_String) return A_Strings.A_String is
Pos : Integer := Env_Var_Pos (Var_Name);
begin
if (Pos /= -1) then
return Env_Value (Envp (Pos));
end if;
return null;
end Getenv;
begin
Initialize_Globals;
end U_Env;
nblk1=8
nid=0
hdr6=10
[0x00] rec0=1d rec1=00 rec2=01 rec3=050
[0x01] rec0=1f rec1=00 rec2=02 rec3=006
[0x02] rec0=26 rec1=00 rec2=03 rec3=00e
[0x03] rec0=1e rec1=00 rec2=04 rec3=046
[0x04] rec0=1d rec1=00 rec2=05 rec3=04c
[0x05] rec0=22 rec1=00 rec2=06 rec3=01a
[0x06] rec0=23 rec1=00 rec2=07 rec3=030
[0x07] rec0=1d rec1=00 rec2=08 rec3=000
tail 0x21750bcfa868437e1bb79 0x42a00088462060003