⟦408ca9999⟧

TextFile

with ACTION;
with ASA_DEFINITIONS;
with CALENDAR;
with DEBUG_TOOLS;
with DIRECTORY;
with GATEWAYS;
with GATEWAY_OBJECT;
with HIERARCHY;
with LOGGER;
with OBJECT_CLASS;
with OBJECT_SUBCLASS;
with PROFILE;
with SIMPLE_STATUS;
with UNIX_DEFINITIONS;
package body ASA is

   PACKAGE_NAME : constant STRING := "Asa.";

   package ASAP renames ASA_DEFINITIONS.PROPERTIES;
   package DIR renames DIRECTORY;
   package DCP renames DIRECTORY.CONTROL_POINT;
   package DNA renames DIRECTORY.NAMING;
   package GWO renames GATEWAY_OBJECT;  
   package HCHY renames HIERARCHY;
   package SS renames SIMPLE_STATUS;
   package UNIX renames UNIX_DEFINITIONS;

   function MUST_RAISE_ERROR return BOOLEAN is
      use PROFILE;
   begin
      return PROFILE.REACTION = PROFILE.PROPAGATE or else
                PROFILE.REACTION = PROFILE.RAISE_ERROR;
   end MUST_RAISE_ERROR;

   procedure CHECK_REQUIREMENT_NAME (REQUIREMENT_NAME : in STRING;
                                     ACTION_ID : in ACTION.ID;
                                     IS_A_REQUIREMENT : out BOOLEAN;
                                     REQUIREMENT_OBJECT : out DIR.OBJECT;
                                     REQUIREMENT_HANDLE : out GWO.HANDLE) is
      E : DIR.ERROR_STATUS;
      HANDLE : GWO.HANDLE;
      N : DNA.NAME_STATUS;
      OBJECT : DIR.OBJECT;
      S : SS.CONDITION;
      use ASA_DEFINITIONS;
      use DNA;
   begin  
      DNA.RESOLVE (NAME => REQUIREMENT_NAME,  
                   THE_OBJECT => OBJECT,
                   STATUS => N);  
      if N /= DNA.SUCCESSFUL then
         IS_A_REQUIREMENT := FALSE;
         REQUIREMENT_OBJECT := DIR.NIL;
         REQUIREMENT_HANDLE := GWO.NULL_HANDLE;
      elsif DIR.IS_GATEWAY (OBJECT) then
         GWO.OPEN_MAIN_OBJECT (OBJECT => OBJECT,
                               H => HANDLE,
                               UPDATE => FALSE,
                               ACTION_ID => ACTION_ID,
                               ERRORS => S);
         if SS.ERROR (S) or else ASAP.CLASS (HANDLE) /=
                                    ASA_DEFINITIONS.ASA_REQUIREMENT then
            IS_A_REQUIREMENT := FALSE;
            REQUIREMENT_OBJECT := OBJECT;
            REQUIREMENT_HANDLE := GWO.NULL_HANDLE;
         else
            IS_A_REQUIREMENT := TRUE;
            REQUIREMENT_OBJECT := OBJECT;
            REQUIREMENT_HANDLE := HANDLE;
         end if;
      end if;
   end CHECK_REQUIREMENT_NAME;

   procedure CHECK_VIEW_NAME (VIEW_NAME : in STRING;  
                              ACTION_ID : in ACTION.ID;
                              IS_A_COMBINED_VIEW : out BOOLEAN;
                              VIEW_OBJECT : out DIR.OBJECT) is
      E : DIR.ERROR_STATUS;
      N : DNA.NAME_STATUS;
      OBJECT : DIR.OBJECT;
      VIEW : DIR.OBJECT;
      VIEW_SUBCLASS : DIR.SUBCLASS;
      use DIR;
      use DNA;
   begin  
      DNA.RESOLVE (NAME => VIEW_NAME,  
                   THE_OBJECT => OBJECT,
                   STATUS => N,
                   ACTION_ID => ACTION_ID);  
      if N /= DNA.SUCCESSFUL then
         IS_A_COMBINED_VIEW := FALSE;
         VIEW_OBJECT := DIR.NIL;
      else
         if DCP.IS_WORLD (OBJECT) then
            VIEW := OBJECT;
         else
            DCP.PARENT_WORLD
               (THE_OBJECT => OBJECT, THE_WORLD => VIEW, STATUS => E);
            if E /= SUCCESSFUL then
               IS_A_COMBINED_VIEW := FALSE;
               VIEW_OBJECT := DIR.NIL;
            end if;
         end if;
         VIEW_SUBCLASS := DIR.GET_SUBCLASS (VIEW);

         IS_A_COMBINED_VIEW := VIEW_SUBCLASS =
                                  OBJECT_SUBCLASS.COMBINED_VIEW_SUBCLASS;
         VIEW_OBJECT := VIEW;
      end if;
   end CHECK_VIEW_NAME;

   function ROOT_OF (GATEWAY : in DIR.OBJECT; ACTION_ID : in ACTION.ID)
                    return DIR.OBJECT is
      E : DIR.ERROR_STATUS;
      GATEWAY_DATA : DIR.STATISTICS.OBJECT_DATA;
      RESULT : DIR.OBJECT;
      use DIR;
   begin
      RESULT := GATEWAY;
      loop
         DIR.STATISTICS.GET_OBJECT_DATA (THE_OBJECT => RESULT,
                                         THE_DATA => GATEWAY_DATA,
                                         STATUS => E,
                                         ACTION_ID => ACTION_ID);
         exit when DIR.GET_CLASS (DIR.STATISTICS.OBJECT_PARENT (GATEWAY_DATA)) =
                      OBJECT_CLASS.LIBRARY;
         RESULT := DIR.STATISTICS.OBJECT_PARENT (GATEWAY_DATA);
      end loop;
      return RESULT;
   end ROOT_OF;

   procedure CREATE_REQUIREMENT (FOR_OBJECT : in STRING := "<CURSOR>";
                                 NAME : in STRING := ">>Requirement Name<<";
                                 KIND : in REQUIREMENTS.NON_FUNCTIONAL :=
                                    REQUIREMENTS.PERFORMANCE;
                                 COMMENTS : in STRING := "";
                                 WORK_ORDER : in STRING := "<DEFAULT>";
                                 RESPONSE : in STRING := "<PROFILE>") is
      SUBPROGRAM_NAME : constant STRING := "Create_Requirement";
      S : SS.CONDITION;
      THE_ACTION : ACTION.ID;
      THE_STATE : GATEWAYS.STATE;
   begin
      PROFILE.SET (RESPONSE, S);
      THE_ACTION := ACTION.START;

      GATEWAYS.INITIALIZE (THE_STATE => THE_STATE,
                           ACTION_ID => THE_ACTION,
                           WORK_ORDER => WORK_ORDER);
      GATEWAYS.CREATE (IN_GATEWAY => FOR_OBJECT,
                       REQUIREMENT_NAME => NAME,
                       REQUIREMENT_KIND => KIND,
                       REQUIREMENT_TEXT => "",
                       COMMENTS => COMMENTS,
                       THE_STATE => THE_STATE);
      GATEWAYS.FINALIZE (THE_STATE);
      ACTION.FINISH (THE_ACTION, DO_COMMIT => TRUE);
   exception
      when PROFILE.ERROR =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " is quitting after errors",
                       RAISE_ERROR => MUST_RAISE_ERROR);
      when others =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " aborted by exception " &
                       DEBUG_TOOLS.GET_EXCEPTION_NAME,
                       RAISE_ERROR => MUST_RAISE_ERROR);
         ACTION.FINISH (THE_ACTION, DO_COMMIT => FALSE);
   end CREATE_REQUIREMENT;

   procedure COPY_REQUIREMENT (REQUIREMENT : in STRING := "<REGION>";
                               TO_OBJECT : in STRING := "<CURSOR>";
                               COMMENTS : in STRING := "";
                               WORK_ORDER : in STRING := "<DEFAULT>";
                               RESPONSE : in STRING := "<PROFILE>") is
      SUBPROGRAM_NAME : constant STRING := "Copy_Requirement";
      GATEWAY : GWO.HANDLE;  
      GATEWAY_OBJECT : DIR.OBJECT;
      IS_A_REQUIREMENT : BOOLEAN;
      S : SS.CONDITION;
      THE_ACTION : ACTION.ID := ACTION.START;
      THE_STATE : GATEWAYS.STATE;
   begin
      PROFILE.SET (RESPONSE, S);

      CHECK_REQUIREMENT_NAME (REQUIREMENT_NAME => REQUIREMENT,
                              ACTION_ID => THE_ACTION,
                              IS_A_REQUIREMENT => IS_A_REQUIREMENT,
                              REQUIREMENT_OBJECT => GATEWAY_OBJECT,
                              REQUIREMENT_HANDLE => GATEWAY);
      if not IS_A_REQUIREMENT then
         if DIR.IS_NIL (GATEWAY_OBJECT) then
            LOGGER.NEGATIVE (REQUIREMENT & " is not a gateway of class " &
                             ASA_DEFINITIONS.GATEWAY_CLASS'IMAGE
                                (ASA_DEFINITIONS.ASA_REQUIREMENT));
         else
            LOGGER.NEGATIVE (DNA.GET_FULL_NAME (GATEWAY_OBJECT) &
                             " is not a gateway of class " &
                             ASA_DEFINITIONS.GATEWAY_CLASS'IMAGE
                                (ASA_DEFINITIONS.ASA_REQUIREMENT));
         end if;
      end if;

      GATEWAYS.INITIALIZE (THE_STATE => THE_STATE,
                           ACTION_ID => THE_ACTION,
                           WORK_ORDER => WORK_ORDER);

      GATEWAYS.CREATE (IN_GATEWAY => TO_OBJECT,
                       REQUIREMENT_NAME => DNA.GET_SIMPLE_NAME (GATEWAY_OBJECT),
                       REQUIREMENT_KIND => ASAP.ASA_REQUIREMENT_KIND (GATEWAY),
                       REQUIREMENT_TEXT => ASAP.ASA_REQUIREMENT_TEXT (GATEWAY),
                       COMMENTS => COMMENTS,
                       THE_STATE => THE_STATE);

      GATEWAYS.FINALIZE (THE_STATE);
      ACTION.FINISH (THE_ACTION, DO_COMMIT => TRUE);
   exception
      when PROFILE.ERROR =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " is quitting after errors",
                       RAISE_ERROR => MUST_RAISE_ERROR);
      when others =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " aborted by exception " &
                       DEBUG_TOOLS.GET_EXCEPTION_NAME,
                       RAISE_ERROR => MUST_RAISE_ERROR);
         ACTION.FINISH (THE_ACTION, DO_COMMIT => FALSE);
   end COPY_REQUIREMENT;


   procedure MOVE_REQUIREMENT (REQUIREMENT : in STRING := "<REGION>";
                               TO_OBJECT : in STRING := "<CURSOR>";
                               COMMENTS : in STRING := "";
                               WORK_ORDER : in STRING := "<DEFAULT>";
                               RESPONSE : in STRING := "<PROFILE>") is
      SUBPROGRAM_NAME : constant STRING := "Move_Requirement";
      GATEWAY : GWO.HANDLE;  
      GATEWAY_OBJECT : DIR.OBJECT;
      IS_A_REQUIREMENT : BOOLEAN;
      S : SS.CONDITION;
      THE_ACTION : ACTION.ID := ACTION.START;
      THE_STATE : GATEWAYS.STATE;
   begin
      PROFILE.SET (RESPONSE, S);

      CHECK_REQUIREMENT_NAME (REQUIREMENT_NAME => REQUIREMENT,
                              ACTION_ID => THE_ACTION,
                              IS_A_REQUIREMENT => IS_A_REQUIREMENT,
                              REQUIREMENT_OBJECT => GATEWAY_OBJECT,
                              REQUIREMENT_HANDLE => GATEWAY);
      if not IS_A_REQUIREMENT then
         if DIR.IS_NIL (GATEWAY_OBJECT) then
            LOGGER.NEGATIVE (REQUIREMENT & " is not a gateway of class " &
                             ASA_DEFINITIONS.GATEWAY_CLASS'IMAGE
                                (ASA_DEFINITIONS.ASA_REQUIREMENT));
         else
            LOGGER.NEGATIVE (DNA.GET_FULL_NAME (GATEWAY_OBJECT) &
                             " is not a gateway of class " &
                             ASA_DEFINITIONS.GATEWAY_CLASS'IMAGE
                                (ASA_DEFINITIONS.ASA_REQUIREMENT));
         end if;
      end if;

      GATEWAYS.INITIALIZE (THE_STATE => THE_STATE,
                           ACTION_ID => THE_ACTION,
                           WORK_ORDER => WORK_ORDER);

      GATEWAYS.CREATE (IN_GATEWAY => TO_OBJECT,
                       REQUIREMENT_NAME => DNA.GET_SIMPLE_NAME (GATEWAY_OBJECT),
                       REQUIREMENT_KIND => ASAP.ASA_REQUIREMENT_KIND (GATEWAY),
                       REQUIREMENT_TEXT => ASAP.ASA_REQUIREMENT_TEXT (GATEWAY),
                       COMMENTS => COMMENTS,
                       THE_STATE => THE_STATE);

      GATEWAYS.DESTROY (GATEWAY_NAME => DNA.GET_FULL_NAME (GATEWAY_OBJECT),
                        COMMENTS => COMMENTS,
                        THE_STATE => THE_STATE);

      GATEWAYS.FINALIZE (THE_STATE);
      ACTION.FINISH (THE_ACTION, DO_COMMIT => TRUE);
   exception
      when PROFILE.ERROR =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " is quitting after errors",
                       RAISE_ERROR => MUST_RAISE_ERROR);
      when others =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " aborted by exception " &
                       DEBUG_TOOLS.GET_EXCEPTION_NAME,
                       RAISE_ERROR => MUST_RAISE_ERROR);
         ACTION.FINISH (THE_ACTION, DO_COMMIT => FALSE);
   end MOVE_REQUIREMENT;

   procedure ACCEPT_CHANGES (IN_OBJECT : in STRING := "<CURSOR>";
                             COMMENTS : in STRING := "";
                             WORK_ORDER : in STRING := "<DEFAULT>";
                             RESPONSE : in STRING := "<PROFILE>") is
      SUBPROGRAM_NAME : constant STRING := "Accept_Changes";
      BUILD_TIME : CALENDAR.TIME;
      E : DIR.ERROR_STATUS;
      ENCLOSING_LIBRARY : DIR.OBJECT;
      GATEWAY : GWO.HANDLE;  
      GATEWAY_OBJECT : DIR.OBJECT;
      ROOT_ITERATOR : HCHY.MODULE_ITERATOR;
      ROOT_MODULE : HCHY.MODULE;  
      S : SS.CONDITION;  
      THE_ACTION : ACTION.ID := ACTION.START;
      THE_STATE : GATEWAYS.STATE;
   begin
      PROFILE.SET (RESPONSE, S);

      --
      -- Open the specified gateway.
      --
      GWO.OPEN_MAIN_OBJECT (OBJECT => IN_OBJECT,
                            H => GATEWAY,
                            UPDATE => FALSE,
                            ACTION_ID => THE_ACTION,
                            ERRORS => S);
      LOGGER.STATUS (S);

      GATEWAY_OBJECT := GWO.DIRECTORY_OBJECT (GATEWAY);
      DCP.PARENT_LIBRARY (THE_OBJECT => GATEWAY_OBJECT,
                          THE_LIBRARY => ENCLOSING_LIBRARY,
                          STATUS => E);
      LOGGER.STATUS (E);

      declare
         HOST : constant STRING := ASAP.DATA_HOST (GATEWAY);
         MODEL : constant STRING := ASAP.DATA_CONTEXT (GATEWAY) &  
                                       UNIX.CONTEXT_SEPARATOR &  
                                       ASAP.DATA_NAME (GATEWAY);
      begin

         --
         -- Compute module hierarchy for the associated model.
         --
         LOGGER.NOTE ("Building module hierarchy for model " & MODEL);
         HCHY.BUILD (MODEL => MODEL,  
                     HOST => HOST,
                     ROOT => ROOT_MODULE,
                     BUILD_TIME => BUILD_TIME);
         ROOT_ITERATOR := HCHY.MAKE (ROOT_MODULE);

         GWO.CLOSE (GATEWAY, ERRORS => S);
         LOGGER.STATUS (S);

         --
         -- Find the root of the gateway tree.
         --
         GATEWAY_OBJECT := ROOT_OF (GATEWAY => GATEWAY_OBJECT,
                                    ACTION_ID => THE_ACTION);

         GATEWAYS.INITIALIZE (THE_STATE => THE_STATE,
                              ACTION_ID => THE_ACTION,
                              WORK_ORDER => WORK_ORDER);

         --
         -- Delete those gateways that no longer have corresponding
         -- modules.
         --
         GATEWAYS.REDUCE (GATEWAY_NAME => DNA.GET_FULL_NAME (GATEWAY_OBJECT),
                          CANDIDATE_MODULES => ROOT_ITERATOR,
                          COMMENTS => COMMENTS,
                          THE_STATE => THE_STATE);

         --
         -- Create gateways for the new modules.
         --
         GATEWAYS.AUGMENT (FOR_MODULE => ROOT_MODULE,
                           IN_LIBRARY => DNA.GET_FULL_NAME (ENCLOSING_LIBRARY),
                           HOST => HOST,
                           MODEL => MODEL,
                           UPDATE_TIME => BUILD_TIME,
                           COMMENTS => COMMENTS,
                           THE_STATE => THE_STATE);

         GATEWAYS.FINALIZE (THE_STATE);
         ACTION.FINISH (THE_ACTION, DO_COMMIT => TRUE);
      end;

   exception
      when PROFILE.ERROR =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " is quitting after errors",
                       RAISE_ERROR => MUST_RAISE_ERROR);
      when others =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " aborted by exception " &
                       DEBUG_TOOLS.GET_EXCEPTION_NAME,
                       RAISE_ERROR => MUST_RAISE_ERROR);
         ACTION.FINISH (THE_ACTION, DO_COMMIT => FALSE);
   end ACCEPT_CHANGES;

   procedure CREATE_MODEL (MODEL : in STRING := ">>ASA Model Name<<";
                           HOST : in STRING := ">>Machine Name<<";
                           INTO_VIEW : in STRING := "<CURSOR>";
                           COMMENTS : in STRING := "";
                           WORK_ORDER : in STRING := "<DEFAULT>";
                           RESPONSE : in STRING := "<PROFILE>") is
      SUBPROGRAM_NAME : constant STRING := "Create_Model";
      S : SS.CONDITION;  
      BUILD_TIME : CALENDAR.TIME;
      IS_A_COMBINED_VIEW : BOOLEAN;
      ROOT_MODULE : HCHY.MODULE;
      THE_ACTION : ACTION.ID := ACTION.START;
      THE_STATE : GATEWAYS.STATE;
      VIEW : DIR.OBJECT;
      use DIR;
   begin  
      PROFILE.SET (RESPONSE, S);

      CHECK_VIEW_NAME (VIEW_NAME => INTO_VIEW,
                       ACTION_ID => THE_ACTION,
                       IS_A_COMBINED_VIEW => IS_A_COMBINED_VIEW,
                       VIEW_OBJECT => VIEW);

      if not IS_A_COMBINED_VIEW then
         if DIR.IS_NIL (VIEW) then
            LOGGER.NEGATIVE (INTO_VIEW & " is not a combined view");
         else
            LOGGER.NEGATIVE (DNA.GET_FULL_NAME (VIEW) &
                             " is not a combined view");
         end if;
      end if;

      ROOT_MODULE := HCHY.MAKE (IDENTIFIER => UNIX.SIMPLE_NAME (MODEL));

      GATEWAYS.INITIALIZE (THE_STATE => THE_STATE,
                           ACTION_ID => THE_ACTION,
                           WORK_ORDER => WORK_ORDER);
      GATEWAYS.CREATE (FOR_MODULE => ROOT_MODULE,
                       IN_LIBRARY => DNA.GET_FULL_NAME (VIEW) & ".Units",
                       HOST => HOST,
                       MODEL => MODEL,
                       UPDATE_TIME => BUILD_TIME,
                       COMMENTS => COMMENTS,
                       THE_STATE => THE_STATE);
      GATEWAYS.FINALIZE (THE_STATE);
      ACTION.FINISH (THE_ACTION, DO_COMMIT => TRUE);
   exception
      when PROFILE.ERROR =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " is quitting after errors",
                       RAISE_ERROR => MUST_RAISE_ERROR);
      when others =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " aborted by exception " &
                       DEBUG_TOOLS.GET_EXCEPTION_NAME,
                       RAISE_ERROR => MUST_RAISE_ERROR);
         ACTION.FINISH (THE_ACTION, DO_COMMIT => FALSE);
   end CREATE_MODEL;

   procedure IMPORT_MODEL (MODEL : in STRING := ">>ASA Model Name<<";
                           HOST : in STRING := ">>Machine Name<<";
                           INTO_VIEW : in STRING := "<CURSOR>";
                           COMMENTS : in STRING := "";
                           WORK_ORDER : in STRING := "<DEFAULT>";
                           RESPONSE : in STRING := "<PROFILE>") is
      SUBPROGRAM_NAME : constant STRING := "Import_Model";
      S : SS.CONDITION;  
      BUILD_TIME : CALENDAR.TIME;
      IS_A_COMBINED_VIEW : BOOLEAN;
      ROOT_MODULE : HCHY.MODULE;
      THE_ACTION : ACTION.ID := ACTION.START;
      THE_STATE : GATEWAYS.STATE;
      VIEW : DIR.OBJECT;
      use DIR;
   begin  
      PROFILE.SET (RESPONSE, S);

      CHECK_VIEW_NAME (VIEW_NAME => INTO_VIEW,
                       ACTION_ID => THE_ACTION,
                       IS_A_COMBINED_VIEW => IS_A_COMBINED_VIEW,
                       VIEW_OBJECT => VIEW);

      if not IS_A_COMBINED_VIEW then
         if DIR.IS_NIL (VIEW) then
            LOGGER.NEGATIVE (INTO_VIEW & " is not a combined view");
         else
            LOGGER.NEGATIVE (DNA.GET_FULL_NAME (VIEW) &
                             " is not a combined view");
         end if;
      end if;

      LOGGER.NOTE ("Building module hierarchy for model " & MODEL);
      HCHY.BUILD (MODEL => MODEL,  
                  HOST => HOST,
                  ROOT => ROOT_MODULE,
                  BUILD_TIME => BUILD_TIME);

      GATEWAYS.INITIALIZE (THE_STATE => THE_STATE,
                           ACTION_ID => THE_ACTION,
                           WORK_ORDER => WORK_ORDER);
      GATEWAYS.CREATE (FOR_MODULE => ROOT_MODULE,
                       IN_LIBRARY => DNA.GET_FULL_NAME (VIEW) & ".Units",
                       HOST => HOST,
                       MODEL => MODEL,
                       UPDATE_TIME => BUILD_TIME,
                       COMMENTS => COMMENTS,
                       THE_STATE => THE_STATE);
      GATEWAYS.FINALIZE (THE_STATE);
      ACTION.FINISH (THE_ACTION, DO_COMMIT => TRUE);
   exception
      when PROFILE.ERROR =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " is quitting after errors",
                       RAISE_ERROR => MUST_RAISE_ERROR);
      when others =>
         LOGGER.ERROR (PACKAGE_NAME & SUBPROGRAM_NAME &
                       " aborted by exception " &
                       DEBUG_TOOLS.GET_EXCEPTION_NAME,
                       RAISE_ERROR => MUST_RAISE_ERROR);
         ACTION.FINISH (THE_ACTION, DO_COMMIT => FALSE);
   end IMPORT_MODEL;

end ASA;
DataMuseum.dk

Rational R1000/400 Tapes

⟦408ca9999⟧ TextFile

Derivation

TextFile
