Re: Program (not task) Activation

[do_while@ridgecrest.ca.us (Do-While Jones)]

>In article <#CDmPrma9GA.300@ntawwabp.compuserve.com> Jeremy T Smith <75534.2075@CompuServe.COM> writes:
>
>                        Can anyone suggest a way to kick these 
>   off as a series of independant executables, not tasks, from 
>   within Ada95?  They must be launched as if from the command line, 
>   with certain setup options passed as command line parameters.  
>   The rest of the simulation environment is now running correctly, 
>   but we're stuck on this one.  Thanks.
>

An easy way to do this is to make a UNIX shell command from inside your
Ada program.  I've included the code I use below. 

There are two package bodies.  One is for Telesoft (Ada 83) on the SUN. 
The other is for GNAT on the SGI.  I've also included two demo programs.
The first demo program calls the "ls" command.  The second demo program
calls a bogus command to test the error detection logic. 

Just for fun, I tried compiling and running these UNIX Interface
components on my brand-new Windows 95 machine.  (I used the ui02kb02.ada
body.)  The first demo program ran correctly.  Windows 95 responded by
displaying a correct directory listing.  The second demo program made
Windows display "bad command or filename", but it didn't raise the
expected exception. 

Does anyone know why Windows 95 did not return an error code?

Do-While Jones

            +--------------------------------+
            |    Know                 Ada    |
            |        [Ada's Portrait]        |
            |    Will              Travel    |
            | wire do_while@ridgecrest.ca.us |
            +--------------------------------+

-------------------------------------------------------------
--                      ui02ks01.ada
--                      24 January 1995

--                      Do-While Jones
--                      324 Traci Lane
--                      Ridgecrest, CA 93555
--                      (760) 375-4607

package SHELL is

  procedure Command(ARGUMENT : string);
    -- Executes the shell command with the given string
    -- ARGUMENT.  For example, the statement below lists
    -- all the files beginning with ui02.

    --    SHELL.Command("ls ui02*");

    -- Raises SHELL.COMMAND_ERROR if it fails.

  COMMAND_ERROR : exception;

  -- The following functions are useful diagnostics if
  -- COMMAND_ERROR is raised.  They are intended only
  -- for debugging.

  function Error_Code return integer;
    -- Tells you the result code returned by the system call.

  function Invalid_Command return string;
    -- Tells you what string was rejected by the system call.

end SHELL;


-------------------------------------------------------------
--                      ui02kb01.ada
--                      24 January 1995

--                      Do-While Jones
--                      324 Traci Lane
--                      Ridgecrest, CA 93555
--                      (760) 375-4607

-- This body works for the Telesoft Ada compiler on
-- the Sun.

with SYSTEM,
     STANDARD_INTEGERS,  -- part AA01
     ASCII_UTILITIES;    -- part AA02

package body SHELL is

  type UNIX_results is
    new STANDARD_INTEGERS.Integer_32;

  RESULT : UNIX_results;

  BAD_COMMAND_STRING : string(1..70);
  BAD_STRING_LENGTH  : natural := 0;

  function unix_call(addr : SYSTEM.Address)
    return UNIX_results;
  pragma Interface(C, unix_call);
  pragma Interface_Information
    (unix_call, "_system");
  
  procedure Command(ARGUMENT : string) is
    C_STRING : constant string :=
      ARGUMENT & ASCII.NUL;
  begin
    RESULT := unix_call(C_STRING(1)'ADDRESS);
    if RESULT /= 0 then
      ASCII_UTILITIES.String_Copy(
        FROM => ARGUMENT,
        TO   => BAD_COMMAND_STRING);
      BAD_STRING_LENGTH := ARGUMENT'LENGTH;
      raise COMMAND_ERROR;
    end if;
  end Command;

  function Error_Code return integer is
  begin
    return integer(RESULT);
  end Error_Code;

  function Invalid_Command return string is
  begin
    return BAD_COMMAND_STRING(1..BAD_STRING_LENGTH);
  end Invalid_Command;

end SHELL;


-------------------------------------------------------------
--                      ui02kb02.ada
--                      10 April 1997

--                      Do-While Jones
--                      324 Traci Lane
--                      Ridgecrest, CA 93555
--                      (760) 375-4607

-- This body works for the Gnat (Ada 95) compiler on Silicon
-- Graphics.

with SYSTEM,
     STANDARD_INTEGERS,  -- part AA01
     ASCII_UTILITIES;    -- part AA02

package body SHELL is

  type UNIX_results is
    new STANDARD_INTEGERS.Integer_32;

  RESULT : UNIX_results;

  BAD_COMMAND_STRING : string(1..70);
  BAD_STRING_LENGTH  : natural := 0;

  function unix_call(addr : SYSTEM.Address)
    return UNIX_results;
  pragma IMPORT(C, unix_call, "system");
  
  procedure Command(ARGUMENT : string) is
    C_STRING : constant string :=
      ARGUMENT & ASCII.NUL;
  begin
    RESULT := unix_call(C_STRING(1)'ADDRESS);
    if RESULT /= 0 then
      ASCII_UTILITIES.String_Copy(
        FROM => ARGUMENT,
        TO   => BAD_COMMAND_STRING);
      BAD_STRING_LENGTH := ARGUMENT'LENGTH;
      raise COMMAND_ERROR;
    end if;
  end Command;

  function Error_Code return integer is
  begin
    return integer(RESULT);
  end Error_Code;

  function Invalid_Command return string is
  begin
    return BAD_COMMAND_STRING(1..BAD_STRING_LENGTH);
  end Invalid_Command;

end SHELL;
-------------------------------------------------------------
--                      ui02td01.ada
--                      24 January 1995

--                      Do-While Jones
--                      324 Traci Lane
--                      Ridgecrest, CA 93555
--                      (760) 375-4607

with TEXT_IO,
     SHELL;  -- part UI02

procedure UI02TD01 is
begin
  TEXT_IO.New_Line;
  TEXT_IO.Put_Line("The files beginning with ""ui02"" are:");

  SHELL.Command("ls ui02*");

  TEXT_IO.New_Line;

end UI02TD01;

-------------------------------------------------------------
--                      ui02td02.ada
--                      24 January 1995

--                      Do-While Jones
--                      324 Traci Lane
--                      Ridgecrest, CA 93555
--                      (760) 375-4607

with TEXT_IO,
     SHELL;  -- part UI02

procedure UI02TD02 is
begin
  TEXT_IO.New_Line;
  TEXT_IO.Put_Line("Trying ""nonesuch with arguments"" "
    & "which should raise an exception.");
  TEXT_IO.New_Line;

  SHELL.Command("nonesuch with arguments");

  -- Should never get here.
  TEXT_IO.Put_Line("FAILED to raise the exception.");

exception
  when SHELL.COMMAND_ERROR =>
    -- Should jump to here.
    TEXT_IO.New_Line;
    TEXT_IO.Put_Line("SHELL.COMMAND_ERROR was raised.");
    TEXT_IO.Put_Line("The offending command is "
      & SHELL.Invalid_Command & ".");
    TEXT_IO.Put_Line("Error number is"
      & integer'IMAGE(SHELL.Error_Code)
      & ".");
end UI02TD02;