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

⟦6d633864f⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Unix_Prcs, seg_04b997

Derivation

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

with Unix;
with U_Env;
with File_Support;

package body Unix_Prcs is
    Max_Args : constant Integer := 127;
    type Str_Vector is array (Integer range <>) of A_Strings.A_String;
    type Argv_Ptr is access Str_Vector;

    function Await (Waitpid : Integer; Cmd : A_String) return Integer is
        Status : Integer;
        Pid : Integer;
    begin
        loop
            Pid := Wait (Status'Address);
            exit when Pid = Waitpid;
            if Pid = -1 then
                if Unix."/=" (Unix.Errnum, Unix.Eintr) then
                    Put_Line ("process failed:  " & Cmd.S);
                    Put_Line ("      with status: " & Integer'Image (Status));
                    raise Program_Error;
                end if;
            end if;
        end loop;
        return Status;
    end Await;

    function Start_Process (Cmd : A_String; Do_Fork : Boolean) return Integer is
        New_Argv : array (0 .. Max_Args) of C_String;
        New_Argc : Integer := 0;
        Start : Integer := 1;
        Finish : Integer;
        Waitpid : Integer;
        Program : C_String;
        Status : Integer;
        No_Process : exception;
    begin
        -- build argv array
        begin
            loop
                Finish := Next (' ', Cmd, Start);
                if Finish /= Start then
                    New_Argv (New_Argc) := Convert_String_To_C
                                              (Cmd.S (Start .. Finish - 1));
                    New_Argc := New_Argc + 1;
                end if;
                Start := Finish + 1;
            end loop;
        exception
            when Not_Found =>
                if Start <= Cmd.Len then
                    New_Argv (New_Argc) := Convert_String_To_C
                                              (Cmd.S (Start .. Cmd.Len));
                    New_Argc := New_Argc + 1;
                end if;
        end;

        Program := New_Argv (0);
        --file_support.flush(file_support.file_ptr(standard_output));
        --file_support.flush(file_support.file_ptr(standard_error));
        if Do_Fork then
            Waitpid := Fork;
            if Waitpid = 0 then
                -- this is the child ...
                Status := Execvp (Program, New_Argv'Address);
                raise No_Process;
            end if;
            return Await (Waitpid, Cmd);
        else
            Status := Execvp (Program, New_Argv'Address);
            raise No_Process;
        end if;
    exception
        when No_Process =>
            Put_Line ("cannot start process:  " & Cmd.S);
            Put_Line ("              status: " & Integer'Image (Status));
            raise;
    end Start_Process;

    function Spawn (Cmd : A_String) return Integer is
    begin
        return Start_Process (Cmd, Do_Fork => True);
    end Spawn;

    function Execute (Cmd : A_String) return Integer is
    begin
        return Start_Process (Cmd, Do_Fork => False);
    end Execute;
end Unix_Prcs;

    nblk1=4
    nid=0
    hdr6=8
        [0x00] rec0=1f rec1=00 rec2=01 rec3=00c
        [0x01] rec0=1c rec1=00 rec2=02 rec3=036
        [0x02] rec0=1c rec1=00 rec2=03 rec3=012
        [0x03] rec0=04 rec1=00 rec2=04 rec3=000
    tail 0x21750bcb6868437aea9da 0x42a00088462060003