|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 13964 (0x368c)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦bb25a46d4⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦bb25a46d4⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦bb25a46d4⟧
└─⟦this⟧
with ASA_DEFINITIONS;
with DEBUG_TOOLS;
with DEVICE_INDEPENDENT_IO;
with DIRECTORY_TOOLS;
with IO;
with LOGGER;
with PROFILE;
with REMOTE_OPERATIONS;
with STRING_UTILITIES;
with UNIX_DEFINITIONS;
pragma ELABORATE (ASA_DEFINITIONS);
package body ASAOPEN is
package ASAC renames ASA_DEFINITIONS.COMMANDS;
package ASAS renames ASA_DEFINITIONS.SWITCHES;
package DIO renames DEVICE_INDEPENDENT_IO;
package DNA renames DIRECTORY_TOOLS.NAMING;
package RO renames REMOTE_OPERATIONS;
package SS renames SIMPLE_STATUS;
package SU renames STRING_UTILITIES;
package UNIX renames UNIX_DEFINITIONS;
LOCAL_ANNOTATIONS : constant STRING :=
ASA_DEFINITIONS.MAIN_CLASS_DIRECTORY & ".ANNOTATIONS";
LOCAL_ANNOTATION_TYPES : constant STRING :=
ASA_DEFINITIONS.MAIN_CLASS_DIRECTORY & ".ANNOTATION_TYPES";
TEMPLATE_ERROR : exception;
function "-" (S1 : in STRING; S2 : in STRING) return STRING is
begin
pragma ASSERT (S1'LENGTH >= S2'LENGTH and then
S1 (S1'LAST - S2'LENGTH + 1 .. S1'LAST) = S2);
return S1 (S1'FIRST .. S1'LAST - S2'LENGTH);
end "-";
-- ------------------------------
-- ( ) Body of external procedure
-- ------------------------------
procedure EXECUTE (IN_CONTEXT : in REMOTE_OPERATIONS.CONTEXT;
MODEL : in STRING;
TEMPLATE_NAME : in STRING;
STATE : in out STATE_RECORD;
STATUS : out SIMPLE_STATUS.CONDITION) is
-- ----------------
-- ( . ) Local data
-- ----------------
S : SS.CONDITION;
ERROR_FILE : IO.FILE_TYPE; -- The remote stderr and stdout.
NULL_INPUT_FILE : DIO.FILE_TYPE;
OUTPUT_FILE : IO.FILE_TYPE; -- The result of executing the script.
SCRIPT_FILE : IO.FILE_TYPE;
TEMPLATE_FILE : IO.FILE_TYPE;
REMOTE_ANNOTATIONS : constant STRING :=
UNIX.TEMPORARY_FILENAME (ASAC.ANNOTATIONS_EXTENSION);
REMOTE_ANNOTATION_TYPES : constant STRING :=
UNIX.TEMPORARY_FILENAME (ASAC.ANNOTATION_TYPES_EXTENSION);
REMOTE_OUTPUT : constant STRING := UNIX.TEMPORARY_FILENAME ("");
REMOTE_PROCESSED_MODEL : constant STRING :=
UNIX.TEMPORARY_FILENAME (ASAC.MODEL_EXTENSION);
REMOTE_SCRIPT : constant STRING :=
UNIX.TEMPORARY_FILENAME (ASAC.ASAOPEN_EXTENSION);
--[bugs]
-- Due to a bug in ASA, the .opn extension cannot be included on
-- the command line.
-- Due to a bug in REMOTE_OPERATIONS.EXECUTE, we put a leading
-- space to make sure that the lower bound of the command string
-- is 1.
--
ASAOPEN_COMMAND : constant STRING :=
' ' &
ASAS.BIN_DIRECTORY (RO.MACHINE (IN_CONTEXT)) &
UNIX.CONTEXT_SEPARATOR &
ASAC.ASAOPEN &
' ' &
(REMOTE_SCRIPT - ASAC.ASAOPEN_EXTENSION);
RM_COMMAND : constant STRING := UNIX.REMOVE &
' ' &
REMOTE_ANNOTATIONS &
' ' &
REMOTE_ANNOTATION_TYPES &
' ' &
REMOTE_OUTPUT &
' ' &
REMOTE_SCRIPT &
' ' &
REMOTE_PROCESSED_MODEL;
SED_COMMAND : constant STRING :=
UNIX.STREAM_EDITOR &
' ' &
UNIX.EDIT &
' ' &
"'/&requirement_[1-9] '""'""'.*'""'""'/s/ /_/g'" &
' ' &
UNIX.EDIT &
' ' &
"'/&requirement_[1-9] '""'""'[^'""'""']*$/,/'""'""';/s/ /_/g'" &
' ' &
UNIX.EDIT &
' ' &
"'/&requirement_[1-9]/s/_*\(&requirement_[1-9]\)_*'""'""'/ \1 '""'""'/'" &
' ' &
UNIX.EDIT &
' ' &
"""s/_*;/;/""" &
' ' &
MODEL &
' ' &
UNIX.OUTPUT_REDIRECT &
' ' &
REMOTE_PROCESSED_MODEL;
-- ------------------------
-- ( . ) Template expansion
-- ------------------------
procedure EXPAND (TEMPLATE_FILE : in IO.FILE_TYPE;
SCRIPT_FILE : in IO.FILE_TYPE) is
use IO;
pragma ASSERT (IO.IS_OPEN (TEMPLATE_FILE) and then
IO.MODE (TEMPLATE_FILE) = IO.IN_FILE and then
IO.IS_OPEN (SCRIPT_FILE) and then
IO.MODE (SCRIPT_FILE) = IO.OUT_FILE);
--
-- A line is decomposed into symbol fields and constant fields.
-- Fields are separated by the separator. The first field of a
-- line is always a constant field. BOUNDARY is the first
-- character of the current field.
--
type FIELD is (CONSTANT_FIELD, SYMBOL_FIELD);
CURRENT_FIELD : FIELD;
BOUNDARY : NATURAL;
THE_SYMBOL : SYMBOL;
begin
while not IO.END_OF_FILE (TEMPLATE_FILE) loop
declare
LINE : constant STRING := IO.GET_LINE (TEMPLATE_FILE);
begin
CURRENT_FIELD := CONSTANT_FIELD;
BOUNDARY := LINE'FIRST;
for I in LINE'FIRST .. LINE'LAST - SEPARATOR'LENGTH + 1 loop
if LINE (I .. I + SEPARATOR'LENGTH - 1) = SEPARATOR then
case CURRENT_FIELD is
when CONSTANT_FIELD =>
--
-- Found the initial symbol separator. First write
-- the text preceding it.
--
IO.PUT (SCRIPT_FILE, LINE (BOUNDARY .. I - 1));
CURRENT_FIELD := SYMBOL_FIELD;
BOUNDARY := I + SEPARATOR'LENGTH;
when SYMBOL_FIELD =>
--
-- Found the final symbol separator. Write the
-- value of the symbol.
--
THE_SYMBOL := SYMBOL'VALUE
(LINE (BOUNDARY .. I - 1));
case THE_SYMBOL is
when ANNOTATIONS =>
IO.PUT (SCRIPT_FILE, REMOTE_ANNOTATIONS);
when ANNOTATION_TYPES =>
IO.PUT (SCRIPT_FILE, REMOTE_ANNOTATION_TYPES);
when ASAOPEN.MODEL =>
IO.PUT (SCRIPT_FILE, REMOTE_PROCESSED_MODEL);
when OUTPUT =>
IO.PUT (SCRIPT_FILE, REMOTE_OUTPUT);
end case;
CURRENT_FIELD := CONSTANT_FIELD;
BOUNDARY := I + SEPARATOR'LENGTH;
end case;
end if;
end loop;
IO.PUT_LINE (SCRIPT_FILE, LINE (BOUNDARY .. LINE'LAST));
end;
end loop;
exception
when others =>
raise TEMPLATE_ERROR;
end EXPAND;
begin
--
-- Create a script file to hold the expanded asaopen text. Open
-- the template, expand it, close it. Reset the script file to
-- read mode.
--
IO.CREATE (FILE => SCRIPT_FILE,
MODE => IO.OUT_FILE,
NAME => "");
IO.OPEN (FILE => TEMPLATE_FILE,
MODE => IO.IN_FILE,
NAME => TEMPLATE_NAME);
LOGGER.NOTE ("Expanding template file " & IO.NAME (TEMPLATE_FILE) &
" into " & IO.NAME (SCRIPT_FILE));
EXPAND (TEMPLATE_FILE => TEMPLATE_FILE,
SCRIPT_FILE => SCRIPT_FILE);
IO.CLOSE (TEMPLATE_FILE);
IO.RESET (FILE => SCRIPT_FILE,
MODE => IO.IN_FILE);
--
-- Download the script file and close it.
--
LOGGER.NOTE ("Copying file " & IO.NAME (SCRIPT_FILE) &
" to " & REMOTE_SCRIPT);
RO.PUT (FROM_FILE => IO.CONVERT (SCRIPT_FILE),
TO_FILE => REMOTE_SCRIPT,
IN_CONTEXT => IN_CONTEXT,
STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => FALSE);
IO.CLOSE (SCRIPT_FILE);
--
-- Download the annotation files.
--
LOGGER.NOTE ("Copying file " & LOCAL_ANNOTATIONS &
" to " & REMOTE_ANNOTATIONS);
RO.PUT (FROM_FILE => LOCAL_ANNOTATIONS,
TO_FILE => REMOTE_ANNOTATIONS,
IN_CONTEXT => IN_CONTEXT,
STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => FALSE);
LOGGER.NOTE ("Copying file " & LOCAL_ANNOTATION_TYPES &
" to " & REMOTE_ANNOTATION_TYPES);
RO.PUT (FROM_FILE => LOCAL_ANNOTATION_TYPES,
TO_FILE => REMOTE_ANNOTATION_TYPES,
IN_CONTEXT => IN_CONTEXT,
STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => FALSE);
--
-- Create error files.
--
IO.CREATE (FILE => ERROR_FILE,
MODE => IO.OUT_FILE,
NAME => "");
--[bug]
-- Due to a bug in asaopen, the blanks are stripped from the
-- requirements' text. Before calling asaopen, we run sed on the
-- model file to change every space into an underscore. The
-- reverse transformation will be made by package HIERARCHY.
--
LOGGER.NOTE ("Executing command """ & SED_COMMAND & '"');
RO.EXECUTE (COMMAND => SED_COMMAND,
IN_CONTEXT => IN_CONTEXT,
INPUT => NULL_INPUT_FILE,
OUTPUT => IO.CONVERT (ERROR_FILE),
ERROR => IO.CONVERT (ERROR_FILE),
STATUS => S,
TIMEOUT => RO.WAIT_FOREVER);
LOGGER.STATUS (S, INTERACTIVE => FALSE);
--
-- Execute asaopen on the downloaded script file. Do not separate
-- output and error flows.
--
LOGGER.NOTE ("Executing command """ & ASAOPEN_COMMAND & '"');
RO.EXECUTE (COMMAND => ASAOPEN_COMMAND,
IN_CONTEXT => IN_CONTEXT,
INPUT => NULL_INPUT_FILE,
OUTPUT => IO.CONVERT (ERROR_FILE),
ERROR => IO.CONVERT (ERROR_FILE),
STATUS => S,
TIMEOUT => RO.WAIT_FOREVER);
--
-- Process the error file.
--
IO.RESET (FILE => ERROR_FILE,
MODE => IO.IN_FILE);
while not IO.END_OF_FILE (ERROR_FILE) loop
LOGGER.DEBUG (IO.GET_LINE (ERROR_FILE));
end loop;
LOGGER.STATUS (S, INTERACTIVE => FALSE);
--
-- Upload the result of execution.
--
IO.CREATE (FILE => OUTPUT_FILE,
MODE => IO.OUT_FILE,
NAME => "");
LOGGER.NOTE ("Copying file " & REMOTE_OUTPUT &
" to " & IO.NAME (OUTPUT_FILE));
RO.GET (FROM_FILE => REMOTE_OUTPUT,
IN_CONTEXT => IN_CONTEXT,
TO_FILE => IO.CONVERT (OUTPUT_FILE),
STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => FALSE);
--
-- Clean up temporary files.
--
IO.RESET (FILE => ERROR_FILE,
MODE => IO.OUT_FILE);
LOGGER.NOTE ("Executing command """ & RM_COMMAND & '"');
RO.EXECUTE (COMMAND => RM_COMMAND,
IN_CONTEXT => IN_CONTEXT,
INPUT => NULL_INPUT_FILE,
OUTPUT => IO.CONVERT (ERROR_FILE),
ERROR => IO.CONVERT (ERROR_FILE),
STATUS => S,
TIMEOUT => RO.WAIT_FOREVER);
--
-- Process the error file and close it.
--
IO.RESET (FILE => ERROR_FILE,
MODE => IO.IN_FILE);
while not IO.END_OF_FILE (ERROR_FILE) loop
declare
THE_LINE : constant STRING := IO.GET_LINE (ERROR_FILE);
begin
if SU.LOCATE (FRAGMENT => "ERROR", WITHIN => THE_LINE) = 0 then
LOGGER.DEBUG (THE_LINE);
else
LOGGER.ERROR (THE_LINE);
end if;
end;
end loop;
IO.CLOSE (ERROR_FILE);
LOGGER.STATUS (S, INTERACTIVE => FALSE);
--
-- Process the output file and close it.
--
IO.RESET (FILE => OUTPUT_FILE,
MODE => IO.IN_FILE);
while not IO.END_OF_FILE (OUTPUT_FILE) loop
PROCESS (STATE => STATE,
LINE => IO.GET_LINE (OUTPUT_FILE));
end loop;
IO.CLOSE (OUTPUT_FILE);
STATUS := S;
exception
when PROFILE.ERROR =>
SS.CREATE_CONDITION
(STATUS => S,
ERROR_TYPE => "",
MESSAGE => "asaopen execution is quitting after errors",
SEVERITY => SS.PROBLEM);
STATUS := S;
when TEMPLATE_ERROR =>
SS.CREATE_CONDITION
(STATUS => S,
ERROR_TYPE => "Asaopen",
MESSAGE => "syntax error in template or template not found",
SEVERITY => SS.PROBLEM);
STATUS := S;
when others =>
SS.CREATE_CONDITION (STATUS => S,
ERROR_TYPE => "Asaopen",
MESSAGE => "execution aborted by exception " &
DEBUG_TOOLS.GET_EXCEPTION_NAME,
SEVERITY => SS.PROBLEM);
STATUS := S;
end EXECUTE;
end ASAOPEN;