|
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 - metrics - downloadIndex: B T
Length: 23600 (0x5c30)
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 ASAOPEN;
with DEVICE_INDEPENDENT_IO;
with JOB_SEGMENT;
with GATEWAY_OBJECT;
separate (ACTIONS)
package body MODEL is
package ASAC renames ASA_DEFINITIONS.COMMANDS;
package DIIO renames DEVICE_INDEPENDENT_IO;
ANNOTATIONS : constant STRING :=
ASA_DEFINITIONS.MAIN_CLASS_DIRECTORY & ".ANNOTATIONS";
ANNOTATION_TYPES : constant STRING :=
ASA_DEFINITIONS.MAIN_CLASS_DIRECTORY & ".ANNOTATION_TYPES";
ASSOCIATED : constant STRING :=
ASA_DEFINITIONS.MAIN_CLASS_DIRECTORY & ".ASSOCIATED";
procedure IMAGE_NAME (HANDLE : DC.GATEWAY_HANDLE;
VISIBLE : BOOLEAN;
READ_ONLY : BOOLEAN;
NO_IMAGE : out BOOLEAN;
SHOW_PROPERTY_IMAGE : out BOOLEAN;
ID : out DC.IMAGE_IDENTITY) is
GATEWAY_OBJECT : constant DIR.OBJECT := GWO.DIRECTORY_OBJECT (HANDLE);
S : SS.CONDITION;
begin
SHOW_PROPERTY_IMAGE := FALSE;
ID := (I1 => DIR.UNIQUE (GATEWAY_OBJECT), I2 => 0);
NO_IMAGE := TRUE;
if not READ_ONLY then
S := CHECK_WRITEABLE (HANDLE);
LOGGER.STATUS (S);
end if;
exception
when PROFILE.ERROR =>
LOGGER.ERROR ("Image construction is quitting after errors",
RAISE_ERROR => FALSE);
end IMAGE_NAME;
procedure BUILD_IMAGE (HANDLE : DC.GATEWAY_HANDLE;
VISIBLE : BOOLEAN;
IN_PLACE : BOOLEAN;
FIRST_TIME : BOOLEAN;
READ_ONLY : in out BOOLEAN;
IMAGE : DC.IMAGE_ID;
NO_IMAGE : out BOOLEAN;
UNDERLYING_OBJECT : out DIRECTORY.OBJECT) is
ACTION_ID : ACTION.ID;
C : RO.CONTEXT;
DIRECTORY_EXISTS : BOOLEAN;
FILE_EXISTS : BOOLEAN;
HAS_DESTROYED_GATEWAY : BOOLEAN;
S : SS.CONDITION;
GATEWAY_OBJECT : constant DIR.OBJECT := GWO.DIRECTORY_OBJECT (HANDLE);
GATEWAY_FULL_NAME : constant STRING :=
DIR.NAMING.GET_FULL_NAME (GATEWAY_OBJECT);
HOST : constant STRING := ASAP.DATA_HOST (HANDLE);
MODEL : constant STRING := ASAP.DATA_CONTEXT (HANDLE) &
UNIX.CONTEXT_SEPARATOR &
ASAP.DATA_NAME (HANDLE);
use GATEWAYS;
begin
NO_IMAGE := TRUE;
UNDERLYING_OBJECT := GATEWAY_OBJECT;
if not READ_ONLY then
if SS.ERROR (CHECK_WRITEABLE (HANDLE)) then
return;
end if;
end if;
RO.ACQUIRE (A_CONTEXT => C,
STATUS => S,
MACHINE => HOST,
INSTANCE => ASA_DEFINITIONS.ASA);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
if not IS_UP_TO_DATE (HANDLE, IN_CONTEXT => C) then
case ASAS.ACTION_WHEN_OUT_OF_DATE is
when ASAS.ABANDON =>
LOGGER.NEGATIVE
("The gateway object " & GATEWAY_FULL_NAME &
" may not be up-to-date. Use Asa.Accept_Changes " &
"to update it");
when ASAS.ACCEPT_CHANGES =>
LOGGER.POSITIVE
("The gateway object " & GATEWAY_FULL_NAME &
" may not be up-to-date. Changes are being accepted");
GWO.CLOSE (HANDLE, S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
ACTION_ID := ACTION.START;
ACCEPT_CHANGES
(GATEWAY_OBJECT => GATEWAY_OBJECT,
IN_CONTEXT => C,
MODEL => MODEL,
COMMENTS => "Automatic Accept_Changes issued by " &
"Build_Image from object " &
GATEWAY_FULL_NAME,
WORK_ORDER => "<DEFAULT>",
ACTION_ID => ACTION_ID,
HAS_DESTROYED_GATEWAY => HAS_DESTROYED_GATEWAY);
ACTION.FINISH (THE_ACTION => ACTION_ID, DO_COMMIT => TRUE);
if HAS_DESTROYED_GATEWAY then
LOGGER.ERROR
("Gateway object " & GATEWAY_FULL_NAME &
" has been destroyed while accepting changes. " &
"Unable to create an image for it.");
else
GWO.OPEN_OBJECT (OBJECT => GATEWAY_FULL_NAME,
SLOT => GWO.MAIN_SLOT,
H => HANDLE,
ERRORS => S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
end if;
when ASAS.CONTINUE =>
LOGGER.WARNING ("The gateway object " & GATEWAY_FULL_NAME &
" may not be up-to-date.");
end case;
end if;
--
-- Before calling asaedit we check the existence of the file,
-- because asaedit won't tell much it they do not exist.
--
RO.FILE_EXISTS (THE_FILE => ASAP.DATA_CONTEXT (HANDLE),
IN_CONTEXT => C,
STATUS => S,
EXISTS => DIRECTORY_EXISTS);
LOGGER.STATUS (S);
if DIRECTORY_EXISTS then
if READ_ONLY then
RO.FILE_EXISTS
(THE_FILE =>
ASAP.DATA_CONTEXT (HANDLE) & UNIX.CONTEXT_SEPARATOR &
ASAP.DATA_NAME (HANDLE),
IN_CONTEXT => C,
STATUS => S,
EXISTS => FILE_EXISTS);
LOGGER.STATUS (S);
if not FILE_EXISTS then
LOGGER.NEGATIVE ("Remote file " & ASAP.DATA_CONTEXT (HANDLE) &
UNIX.CONTEXT_SEPARATOR &
ASAP.DATA_NAME (HANDLE) & " does not exist");
end if;
end if;
else
LOGGER.NEGATIVE ("Remote directory " &
ASAP.DATA_CONTEXT (HANDLE) & " does not exist");
end if;
declare
REMOTE_ANNOTATIONS : constant STRING :=
UNIX.TEMPORARY_FILENAME (ASAC.ANNOTATIONS_EXTENSION);
REMOTE_ANNOTATION_TYPES : constant STRING :=
UNIX.TEMPORARY_FILENAME (ASAC.ANNOTATION_TYPES_EXTENSION);
ASAEDIT_COMMAND : constant STRING :=
ASAS.BIN_DIRECTORY (ASAP.DATA_HOST (HANDLE)) &
UNIX.CONTEXT_SEPARATOR &
ASAC.ASAEDIT &
' ' &
ASAP.DATA_CONTEXT (HANDLE) &
UNIX.CONTEXT_SEPARATOR &
ASAP.DATA_NAME (HANDLE) &
' ' &
ASAC.START_NODE &
' ' &
ASAP.ASA_NODE_NUMBER (HANDLE) &
' ' &
ASAC.NO_WARNINGS &
' ' &
ASAC.ANNOTATIONS &
' ' &
REMOTE_ANNOTATIONS &
' ' &
ASAC.ANNOTATION_TYPES &
' ' &
REMOTE_ANNOTATION_TYPES;
RM_COMMAND : constant STRING := UNIX.REMOVE &
' ' &
REMOTE_ANNOTATIONS &
' ' &
REMOTE_ANNOTATION_TYPES;
begin
LOGGER.NOTE ("Copying file " & ANNOTATIONS &
" to " & REMOTE_ANNOTATIONS);
RO.PUT (FROM_FILE => ANNOTATIONS,
TO_FILE => REMOTE_ANNOTATIONS,
IN_CONTEXT => C,
STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
LOGGER.NOTE ("Copying file " & ANNOTATION_TYPES &
" to " & REMOTE_ANNOTATION_TYPES);
RO.PUT (FROM_FILE => ANNOTATION_TYPES,
TO_FILE => REMOTE_ANNOTATION_TYPES,
IN_CONTEXT => C,
STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
if READ_ONLY then
EXECUTE (COMMAND => ASAEDIT_COMMAND &
' ' &
ASAC.READ_ONLY &
UNIX.COMMAND_SEPARATOR &
RM_COMMAND,
INTERACTIVE => TRUE,
IN_CONTEXT => C,
TIMEOUT => RO.WAIT_FOREVER);
else
EXECUTE (COMMAND => ASAEDIT_COMMAND &
UNIX.COMMAND_SEPARATOR &
RM_COMMAND,
INTERACTIVE => TRUE,
IN_CONTEXT => C,
TIMEOUT => RO.WAIT_FOREVER);
end if;
end;
RO.RELEASE (A_CONTEXT => C, STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
exception
when PROFILE.ERROR =>
LOGGER.ERROR ("Image construction is quitting after errors",
RAISE_ERROR => FALSE);
end BUILD_IMAGE;
--[bug]
-- Due to a bug in DISPATCH, the CMVC operations are called with an
-- handle that it not open under the action used for the operation.
-- To avoid locking problems, we immediately close the handle and
-- reopen the same object with the appropriate action. However there
-- is still an interesting issue: when the handle is reopen for the
-- post operation (with a new action), a locking error may be
-- detected, and the post operation may be called with a closed
-- handle. We have to live with this...
--
function REOPEN (HANDLE : in GWO.HANDLE; ACTION_ID : in ACTION.ID)
return GWO.HANDLE is
RESULT : GWO.HANDLE;
S : SS.CONDITION;
THE_OBJECT : constant DIR.OBJECT := GWO.DIRECTORY_OBJECT (HANDLE);
begin
GWO.CLOSE (HANDLE);
GWO.OPEN_MAIN_OBJECT (OBJECT => THE_OBJECT,
H => RESULT,
UPDATE => FALSE,
ACTION_ID => ACTION_ID,
ERRORS => S);
LOGGER.STATUS (S);
return RESULT;
end REOPEN;
procedure PRE_CHECK_IN (HANDLE : DC.GATEWAY_HANDLE;
SUBOBJECT : DIRECTORY.OBJECT;
RESPONSE : PROFILE.RESPONSE_PROFILE;
ACTION_ID : ACTION.ID;
ERRORS : in out DC.ERROR_COUNTS) is
THE_HANDLE : DC.GATEWAY_HANDLE := REOPEN (HANDLE, ACTION_ID);
C : RO.CONTEXT;
HAS_DESTROYED_GATEWAY : BOOLEAN;
S : SS.CONDITION;
THE_ACTION : ACTION.ID := ACTION_ID;
GATEWAY_OBJECT : constant DIR.OBJECT := GWO.DIRECTORY_OBJECT (THE_HANDLE);
GATEWAY_FULL_NAME : constant STRING :=
DIR.NAMING.GET_FULL_NAME (GATEWAY_OBJECT);
HOST : constant STRING := ASAP.DATA_HOST (THE_HANDLE);
MODEL : constant STRING := ASAP.DATA_CONTEXT (THE_HANDLE) &
UNIX.CONTEXT_SEPARATOR &
ASAP.DATA_NAME (THE_HANDLE);
begin
PROFILE.SET (RESPONSE);
RO.ACQUIRE (A_CONTEXT => C,
STATUS => S,
MACHINE => HOST,
INSTANCE => ASA_DEFINITIONS.ASA);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
if not IS_UP_TO_DATE (THE_HANDLE, IN_CONTEXT => C) then
LOGGER.POSITIVE ("Accepting changes from model " & MODEL);
GWO.CLOSE (THE_HANDLE, S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
ACCEPT_CHANGES (GATEWAY_OBJECT => GATEWAY_OBJECT,
IN_CONTEXT => C,
MODEL => MODEL,
COMMENTS => "Automatic Accept_Changes issued by " &
"Check_In from object " &
GATEWAY_FULL_NAME,
WORK_ORDER => "<DEFAULT>",
ACTION_ID => ACTION_ID,
HAS_DESTROYED_GATEWAY => HAS_DESTROYED_GATEWAY);
if HAS_DESTROYED_GATEWAY then
LOGGER.WARNING ("The gateway object " & GATEWAY_FULL_NAME &
" has been destroyed while accepting " &
"changes. Cmvc.Check_In is unable to proceed");
ACTION.FINISH (THE_ACTION => THE_ACTION, DO_COMMIT => TRUE);
ERRORS := (WARNINGS => 0, ERRORS => 0, FATAL => TRUE);
return;
end if;
end if;
RO.RELEASE (A_CONTEXT => C, STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
ERRORS := (WARNINGS => 0, ERRORS => 0, FATAL => FALSE);
exception
when PROFILE.ERROR =>
ERRORS := (WARNINGS => 0, ERRORS => 1, FATAL => FALSE);
end PRE_CHECK_IN;
procedure PRE_CMVC_COPY (HANDLE : DC.GATEWAY_HANDLE;
SUBOBJECT : DIRECTORY.OBJECT;
RELEASE : BOOLEAN;
CONTROLLED : BOOLEAN;
JOINED : BOOLEAN;
SOURCE_VIEW : DIRECTORY.OBJECT;
DESTINATION_VIEW : DIRECTORY.OBJECT;
FIRST_CALL : BOOLEAN;
DO_NOT_COPY : out BOOLEAN;
RESPONSE : PROFILE.RESPONSE_PROFILE;
ACTION_ID : ACTION.ID;
ERRORS : in out DC.ERROR_COUNTS) is
THE_HANDLE : DC.GATEWAY_HANDLE := REOPEN (HANDLE, ACTION_ID);
C : RO.CONTEXT;
HAS_DESTROYED_GATEWAY : BOOLEAN;
S : SS.CONDITION;
THE_ACTION : ACTION.ID := ACTION_ID;
GATEWAY_OBJECT : constant DIR.OBJECT := GWO.DIRECTORY_OBJECT (THE_HANDLE);
GATEWAY_FULL_NAME : constant STRING :=
DIR.NAMING.GET_FULL_NAME (GATEWAY_OBJECT);
HOST : constant STRING := ASAP.DATA_HOST (THE_HANDLE);
MODEL : constant STRING := ASAP.DATA_CONTEXT (THE_HANDLE) &
UNIX.CONTEXT_SEPARATOR &
ASAP.DATA_NAME (THE_HANDLE);
begin
PROFILE.SET (RESPONSE);
RO.ACQUIRE (A_CONTEXT => C,
STATUS => S,
MACHINE => HOST,
INSTANCE => ASA_DEFINITIONS.ASA);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
if not IS_UP_TO_DATE (THE_HANDLE, IN_CONTEXT => C) then
LOGGER.POSITIVE ("Accepting changes from model " & MODEL);
GWO.CLOSE (THE_HANDLE, S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
ACCEPT_CHANGES (GATEWAY_OBJECT => GATEWAY_OBJECT,
IN_CONTEXT => C,
MODEL => MODEL,
COMMENTS => "Automatic Accept_Changes issued by " &
"view copy" & GATEWAY_FULL_NAME,
WORK_ORDER => "<DEFAULT>",
ACTION_ID => ACTION_ID,
HAS_DESTROYED_GATEWAY => HAS_DESTROYED_GATEWAY);
end if;
RO.RELEASE (A_CONTEXT => C, STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
ERRORS := (WARNINGS => 0, ERRORS => 0, FATAL => FALSE);
DO_NOT_COPY := FALSE;
exception
when PROFILE.ERROR =>
ERRORS := (WARNINGS => 0, ERRORS => 1, FATAL => FALSE);
DO_NOT_COPY := TRUE;
end PRE_CMVC_COPY;
procedure POST_CMVC_COPY (HANDLE : DC.GATEWAY_HANDLE;
SUBOBJECT : DIRECTORY.OBJECT;
SOURCE_OBJECT : DIRECTORY.OBJECT;
RELEASE : BOOLEAN;
CONTROLLED : BOOLEAN;
JOINED : BOOLEAN;
SOURCE_VIEW : DIRECTORY.OBJECT;
DESTINATION_VIEW : DIRECTORY.OBJECT;
FIRST_CALL : BOOLEAN;
RESPONSE : PROFILE.RESPONSE_PROFILE;
ACTION_ID : ACTION.ID;
ERRORS : in out DC.ERROR_COUNTS) is
THE_HANDLE : DC.GATEWAY_HANDLE := REOPEN (HANDLE, ACTION_ID);
ARCHIVE_FILE : DIIO.FILE_TYPE;
C : RO.CONTEXT;
S : SS.CONDITION;
type ACCESS_STRING is access STRING;
pragma SEGMENTED_HEAP (ACCESS_STRING);
CONTEXT : constant STRING := ASAP.DATA_CONTEXT (THE_HANDLE);
HOST : constant STRING := ASAP.DATA_HOST (THE_HANDLE);
MODEL : constant STRING := CONTEXT & UNIX.CONTEXT_SEPARATOR &
ASAP.DATA_NAME (THE_HANDLE);
GATEWAY_OBJECT : constant DIR.OBJECT := GWO.DIRECTORY_OBJECT (THE_HANDLE);
ARCHIVE_FILE_NAME : constant STRING :=
DNA.GET_FULL_NAME (GATEWAY_OBJECT) & ".Archive";
REMOTE_TARFILE : constant STRING :=
UNIX.TEMPORARY_FILENAME (UNIX.TARFILE_EXTENSION);
CD_COMMAND : constant STRING := UNIX.CHANGE_DIRECTORY &
' ' &
CONTEXT;
TAR_COMMAND : constant STRING := UNIX.TAPE_ARCHIVE &
' ' &
UNIX.CREATE &
UNIX.ARCHIVE_FILE &
' ' &
REMOTE_TARFILE &
' ' &
MODEL;
RM_COMMAND : constant STRING := UNIX.REMOVE &
' ' &
REMOTE_TARFILE;
MY_STATE : ACCESS_STRING;
procedure PROCESS (STATE : in out ACCESS_STRING;
LINE : in STRING) is
begin
pragma ASSERT (STATE = null);
STATE := new STRING'(LINE);
pragma HEAP (JOB_SEGMENT.GET);
end PROCESS;
procedure EXECUTE_SCRIPT is
new ASAOPEN.EXECUTE (STATE_RECORD => ACCESS_STRING,
PROCESS => PROCESS);
begin
if RELEASE then
PROFILE.SET (RESPONSE);
--
-- Acquire a connection.
--
RO.ACQUIRE (A_CONTEXT => C,
STATUS => S,
MACHINE => HOST,
INSTANCE => ASA_DEFINITIONS.ASA);
LOGGER.STATUS (S);
--
-- Find the associated files.
--
EXECUTE_SCRIPT (IN_CONTEXT => C,
MODEL => MODEL,
TEMPLATE_NAME => ASSOCIATED,
STATE => MY_STATE,
STATUS => S);
LOGGER.STATUS (S);
--
-- Archive all the files, from the appropriate directory.
--
EXECUTE (COMMAND => CD_COMMAND &
UNIX.COMMAND_SEPARATOR &
TAR_COMMAND &
' ' &
MY_STATE.all,
INTERACTIVE => FALSE,
IN_CONTEXT => C,
TIMEOUT => DEFAULT_TIMEOUT);
--
-- Upload the tar file.
--
DIIO.CREATE (FILE => ARCHIVE_FILE,
MODE => DIIO.OUT_FILE,
NAME => ARCHIVE_FILE_NAME,
ACTION_ID => GWO.ACTION_ID (THE_HANDLE));
RO.GET (FROM_FILE => REMOTE_TARFILE,
IN_CONTEXT => C,
TO_FILE => ARCHIVE_FILE,
STATUS => S);
LOGGER.STATUS (S);
DIIO.CLOSE (FILE => ARCHIVE_FILE);
--
-- Delete the remote tarfile.
--
EXECUTE (COMMAND => RM_COMMAND,
INTERACTIVE => FALSE,
IN_CONTEXT => C,
TIMEOUT => DEFAULT_TIMEOUT);
--
-- Release the connection.
--
RO.RELEASE (A_CONTEXT => C, STATUS => S);
LOGGER.STATUS (S);
end if;
ERRORS := (WARNINGS => 0, ERRORS => 0, FATAL => FALSE);
exception
when PROFILE.ERROR =>
ERRORS := (WARNINGS => 0, ERRORS => 1, FATAL => TRUE);
end POST_CMVC_COPY;
procedure PRE_MAKE_CONTROLLED (HANDLE : DC.GATEWAY_HANDLE;
SUBOBJECT : DIRECTORY.OBJECT;
SAVE_SOURCE : BOOLEAN;
ALLOW_CONTROLLED : out BOOLEAN;
RESPONSE : PROFILE.RESPONSE_PROFILE;
ACTION_ID : ACTION.ID;
ERRORS : in out DC.ERROR_COUNTS) is
THE_HANDLE : DC.GATEWAY_HANDLE := REOPEN (HANDLE, ACTION_ID);
C : RO.CONTEXT;
HAS_DESTROYED_GATEWAY : BOOLEAN;
S : SS.CONDITION;
THE_ACTION : ACTION.ID := ACTION_ID;
GATEWAY_OBJECT : constant DIR.OBJECT := GWO.DIRECTORY_OBJECT (THE_HANDLE);
GATEWAY_FULL_NAME : constant STRING :=
DIR.NAMING.GET_FULL_NAME (GATEWAY_OBJECT);
HOST : constant STRING := ASAP.DATA_HOST (THE_HANDLE);
MODEL : constant STRING := ASAP.DATA_CONTEXT (THE_HANDLE) &
UNIX.CONTEXT_SEPARATOR &
ASAP.DATA_NAME (THE_HANDLE);
begin
PROFILE.SET (RESPONSE);
ALLOW_CONTROLLED := TRUE;
if SAVE_SOURCE then
LOGGER.NEGATIVE (ASA_DEFINITIONS.ASA &
" gateway objects cannot be source-controlled");
ERRORS := (WARNINGS => 0, ERRORS => 1, FATAL => FALSE);
else
RO.ACQUIRE (A_CONTEXT => C,
STATUS => S,
MACHINE => HOST,
INSTANCE => ASA_DEFINITIONS.ASA);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
if not IS_UP_TO_DATE (THE_HANDLE, IN_CONTEXT => C) then
LOGGER.POSITIVE ("Accepting changes from model " & MODEL);
GWO.CLOSE (THE_HANDLE, S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
ACCEPT_CHANGES (GATEWAY_OBJECT => GATEWAY_OBJECT,
IN_CONTEXT => C,
MODEL => MODEL,
COMMENTS => "Automatic Accept_Changes issued by " &
"Cmvc.Make_Controlled from object " &
GATEWAY_FULL_NAME,
WORK_ORDER => "<DEFAULT>",
ACTION_ID => ACTION_ID,
HAS_DESTROYED_GATEWAY => HAS_DESTROYED_GATEWAY);
if HAS_DESTROYED_GATEWAY then
LOGGER.WARNING ("The gateway object " & GATEWAY_FULL_NAME &
" has been destroyed while accepting " &
"changes. Cmvc.Make_Controlled is " &
"unable to proceed");
ACTION.FINISH (THE_ACTION => THE_ACTION, DO_COMMIT => TRUE);
ERRORS := (WARNINGS => 0, ERRORS => 0, FATAL => TRUE);
return;
end if;
end if;
RO.RELEASE (A_CONTEXT => C, STATUS => S);
LOGGER.STATUS (S, INTERACTIVE => TRUE);
ERRORS := (WARNINGS => 0, ERRORS => 0, FATAL => FALSE);
end if;
exception
when PROFILE.ERROR =>
ERRORS := (WARNINGS => 0, ERRORS => 1, FATAL => FALSE);
end PRE_MAKE_CONTROLLED;
procedure TERMINATE_SERVER (REASON : in DC.TERMINATION_CONDITION) is
begin
if REASON = DC.GATEWAY_CLASS_DEACTIVATED then
SWITCH_REGISTRATION.STOP;
end if;
end TERMINATE_SERVER;
end MODEL;