?? NEWTITLE := 'NOS/VE Job Scheduling : administer objects' ??
MODULE jmm$administer_objects;

{ PURPOSE:
{   This module contains the routines that manage the creating, changing
{   deleting, and rearranging of profile objects.
{
{ DESIGN:
{   Objects are kept as linked lists with a separate list for each object
{   type.  The objects are kept in the users order which means that they
{   are not sorted by the object name and cannot be kept as a binary tree.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
*copyc jmt$profile_object
*copyc jmt$profile_object_list
?? PUSH (LISTEXT := ON) ??
*copyc clt$data_value
*copyc jmc$job_management_id
*copyc jme$profile_object_errors
*copyc jmt$ways_to_change_object
?? POP ??
*copyc clp$count_list_elements
*copyc jmp$copy_attributes
*copyc jmp$delete_attributes
*copyc jmp$internal_error
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc pmp$generate_unique_name
*copyc pmp$get_mainframe_id

*copyc jmv$object_definition
*copyc jmv$object_heap
*copyc jmv$the_profile
*copyc jmv$working_storage
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? NEWTITLE := '[XDCL, #GATE] jmv$current_class_name', EJECT ??

{ PURPOSE:
{   JMV$CURRENT_CLASS_NAME contains the name of the last referenced
{   profile object for each profile object kind.  If ALL was last
{   referenced then it will contain ALL for that object kind.

  VAR
    jmv$current_class_name: [XDCL, #GATE] array [jmt$profile_object_kinds] of
          ^array [1 .. * ] of ost$name := [REP 9 of NIL];

?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] jmv$current_profile_level', EJECT ??

{ PURPOSE:
{   JMV$CURRENT_PROFILE_LEVEL contains the object kind of the last referenced
{   profile object.

  VAR
    jmv$current_profile_level: [XDCL, #GATE] jmt$profile_object_kinds :=
          jmc$profile_job_class;

?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] jmp$add_object', EJECT ??

{ PURPOSE:
{   This interface adds an object to the profile.
{
{ DESIGN:
{   The routine adds the objects to the end of the list of objects of the
{   specified type.
{
{ NOTES:
{   Check for duplicate named objects.  This is valid for job_categories
{   and if it occurs the objects must be added after the last category
{   object with the same name.

  PROCEDURE [XDCL, #GATE] jmp$add_object
    (    the_kind: jmt$profile_object_kinds;
         the_name: string ( * );
         the_attributes: jmt$object_attribute;
     VAR the_object: jmt$profile_object_reference;
     VAR status: ost$status);

    VAR
      attribute_constraints: jmt$attribute_check_routine,
      count: integer,
      i: integer,
      local_status: ost$status,
      new_object: jmt$profile_object_reference,
      object: jmt$profile_object,
      object_default: clt$data_value,
      previous_object: jmt$profile_object_reference,
      size: integer,
      unique_name: ost$unique_name;

    status.normal := TRUE;

    pmp$generate_unique_name (unique_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    object.name := the_name;
    object.kind := the_kind;
    object.behaviour_id := unique_name.value;
    object.definition_id := unique_name.value;
    object.references := 0;
    object.index := 0;
    object.changed := TRUE;
    object.permanent := FALSE;
    object.next_object := NIL;
    object.attributes := the_attributes;

    attribute_constraints := jmv$object_definition [the_kind].check_attributes;
    IF attribute_constraints <> NIL THEN
      attribute_constraints^ (object, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    jmp$get_object (the_name, the_kind, new_object, previous_object,
          local_status);
    IF local_status.normal THEN
      IF the_kind <> jmc$profile_category THEN
        the_object := new_object;
        set_object_error (jme$object_already_known, object, status);
        RETURN;
      IFEND;
      REPEAT
        previous_object := new_object;
        new_object := new_object^.next_object;
      UNTIL (new_object = NIL) OR (new_object^.name <> the_name);
    IFEND;

    IF jmv$the_profile.count [the_kind] =
          jmv$object_definition [the_kind].maximum_number_of_objects THEN
      set_object_error (jme$too_many_objects, object, status);
      RETURN;
    IFEND;

    ALLOCATE new_object IN jmv$object_heap^;
    IF new_object = NIL THEN
      jmp$internal_error (51);
    IFEND;

    new_object^ := object;
    jmp$copy_attributes (object.attributes, new_object^.attributes);
    IF the_attributes.kind = jmc$type THEN
      jmp$delete_attributes (new_object^.attributes.
            attribute_list^ [jmc$object_abbreviation]);
    IFEND;

    object_default.kind := clc$name;
    object_default.name_value := the_name;
    jmp$set_object_default (the_kind, ^object_default);
    jmv$the_profile.definition_id := object.definition_id;

    jmv$the_profile.count [the_kind] := jmv$the_profile.count [the_kind] + 1;

    IF previous_object = NIL THEN
      new_object^.next_object := jmv$the_profile.objects [the_kind];
      jmv$the_profile.objects [the_kind] := new_object;
    ELSE
      new_object^.next_object := previous_object^.next_object;
      previous_object^.next_object := new_object;
    IFEND;
    the_object := new_object;

  PROCEND jmp$add_object;
?? TITLE := '[XDCL, #GATE] jmp$change_object', EJECT ??

{ PURPOSE:
{   This interface updates the attribute list for one or more objects.
{
{ DESIGN:
{   The objects are found and the attribute list changed.  If the request is
{   to replace then the list is replaced as a whole.  Otherwise the list is
{   merged with the old list replacing only those parts of the list that
{   have been newly specified.

  PROCEDURE [XDCL, #GATE] jmp$change_object
    (    object_kind: jmt$profile_object_kinds;
         objects: clt$data_value;
         new_attributes: jmt$object_attribute;
         how: jmt$ways_to_change_object;
     VAR status: ost$status);

    VAR
      attribute_definition: jmt$profile_declaration,
      attribute_constraints: jmt$attribute_check_routine;

?? NEWTITLE := 'change_object', EJECT ??

{ PURPOSE:
{   This interface updates the attribute list for an object.
{
{ DESIGN:
{   The attribute list is changed for the specified object.  If the request is
{   to replace then the list is replaced as a whole.  Otherwise the list is
{   merged with the old list replacing only those parts of the list that
{   have been newly specified.
{
{ NOTES:
{   Objects following with the same name are deleted.
{   If any attribute changed in the membership group then the definition id
{     of both the object and the profile are changed.

    PROCEDURE change_object
      (VAR the_object: jmt$profile_object_reference;
       VAR status: ost$status);

?? NEWTITLE := 'build_merged_list', EJECT ??

{ PURPOSE:
{   Replace the parts of the old attribute list that are changed in the
{   new attribute list.

      PROCEDURE build_merged_list
        (    new_attribute: jmt$object_attribute;
             old_attribute: jmt$object_attribute;
         VAR updated_attribute: jmt$object_attribute);

        TYPE
          item = record
            upper,
            lower: integer,
            attribute: jmt$object_attribute,
            next_item: ^item,
          recend;

        VAR
          new_item: ^item,
          an_item: ^item,
          top_item: ^item,
          another_item: ^item,
          previous_item: ^item,
          items: integer,
          i: integer,
          pair: ^jmt$object_attribute_list,
          result_list: ^jmt$object_attribute_list;

        top_item := NIL;
        items := 0;

{ unpack old_attribute

        IF old_attribute.kind = jmc$editable_list THEN
          FOR i := UPPERBOUND (old_attribute.attribute_list^) DOWNTO 1 DO
            PUSH new_item;
            new_item^.attribute := old_attribute.attribute_list^ [i];
            pair := new_item^.attribute.attribute_list^ [1].attribute_list;
            new_item^.lower := pair^ [1].number;
            new_item^.upper := new_item^.lower;
            IF pair^ [2].kind <> jmc$empty THEN
              new_item^.upper := pair^ [2].number;
            IFEND;
            new_item^.next_item := top_item;
            top_item := new_item;
            items := items + 1;
          FOREND;
        IFEND;

{ unpack new_attribute

        FOR i := 1 TO UPPERBOUND (new_attribute.attribute_list^) DO
          PUSH new_item;
          items := items + 1;
          new_item^.attribute := new_attribute.attribute_list^ [i];
          pair := new_item^.attribute.attribute_list^ [1].attribute_list;
          new_item^.lower := pair^ [1].number;
          new_item^.upper := new_item^.lower;
          IF pair^ [2].kind <> jmc$empty THEN
            new_item^.upper := pair^ [2].number;
            IF new_item^.upper < new_item^.lower THEN
              new_item^.upper := pair^ [1].number;
              new_item^.lower := pair^ [2].number;
            IFEND;
          IFEND;
          an_item := top_item;
          previous_item := NIL;
          WHILE (an_item <> NIL) AND (an_item^.upper < new_item^.lower) DO
            previous_item := an_item;
            an_item := an_item^.next_item;
          WHILEND;
          IF (an_item <> NIL) AND (an_item^.lower < new_item^.lower) THEN
            PUSH another_item;
            another_item^ := an_item^;
            an_item^.next_item := new_item;
            an_item^.upper := new_item^.lower - 1;
            an_item := another_item;
            items := items + 1;
          ELSEIF previous_item = NIL THEN
            top_item := new_item;
          ELSE
            previous_item^.next_item := new_item;
          IFEND;
          WHILE (an_item <> NIL) AND (an_item^.upper <= new_item^.upper) DO
            an_item := an_item^.next_item;
            items := items - 1;
          WHILEND;
          IF (an_item <> NIL) AND (an_item^.lower <= new_item^.upper) THEN
            an_item^.lower := new_item^.upper + 1;
          IFEND;
          new_item^.next_item := an_item;
        FOREND;

{ Build updated_attribute

        updated_attribute.kind := jmc$editable_list;
        ALLOCATE updated_attribute.attribute_list: [1 .. items] IN
              jmv$object_heap^;
        FOR i := 1 TO items DO
          jmp$copy_attributes (top_item^.attribute,
                updated_attribute.attribute_list^ [i]);
          pair := updated_attribute.attribute_list^ [i].attribute_list^ [1].
                attribute_list;
          pair^ [1].number := top_item^.lower;
          IF top_item^.lower = top_item^.upper THEN
            pair^ [2].kind := jmc$empty;
          ELSE
            pair^ [2].kind := pair^ [1].kind;
            pair^ [2].number := top_item^.upper;
          IFEND;
          top_item := top_item^.next_item;
        FOREND;
      PROCEND build_merged_list;

?? NEWTITLE := 'merge_new_attributes', EJECT ??

{ PURPOSE:
{   Replace the parts of the old attribute list that are changed in the
{   new attribute list.

      PROCEDURE merge_new_attributes
        (    new_attribute: jmt$object_attribute;
             old_attribute: jmt$object_attribute;
         VAR updated_attribute: jmt$object_attribute);

        VAR
          default_attribute: [STATIC] jmt$object_attribute := [jmc$default],
          smaller_list_size: jmt$object_attribute_index,
          desired_list_size: jmt$object_attribute_index,
          index: jmt$object_attribute_index;

        CASE new_attribute.kind OF
        = jmc$empty =
          jmp$copy_attributes (old_attribute, updated_attribute);
        = jmc$range =
          jmp$copy_attributes (new_attribute, updated_attribute);
        = jmc$editable_list =
          build_merged_list (new_attribute, old_attribute, updated_attribute);
        = jmc$list, jmc$type =
          updated_attribute := new_attribute;
          desired_list_size := UPPERBOUND (new_attribute.attribute_list^);
          ALLOCATE updated_attribute.attribute_list:
                [1 .. desired_list_size] IN jmv$object_heap^;
          IF updated_attribute.attribute_list = NIL THEN
            jmp$internal_error (52);
          IFEND;
          smaller_list_size := 0;
          IF old_attribute.kind = new_attribute.kind THEN
            smaller_list_size := UPPERBOUND (old_attribute.attribute_list^);
            IF smaller_list_size > desired_list_size THEN
              smaller_list_size := desired_list_size;
            IFEND;
            FOR index := 1 TO smaller_list_size DO
              merge_new_attributes (new_attribute.attribute_list^ [index],
                    old_attribute.attribute_list^ [index],
                    updated_attribute.attribute_list^ [index]);
            FOREND;
          IFEND;
          FOR index := smaller_list_size + 1 TO desired_list_size DO
            merge_new_attributes (new_attribute.attribute_list^ [index],
                  default_attribute, updated_attribute.
                  attribute_list^ [index]);
          FOREND;
        = jmc$name, jmc$object, jmc$file =
          jmp$copy_attributes (new_attribute, updated_attribute);
        ELSE
          updated_attribute := new_attribute;
        CASEND;
      PROCEND merge_new_attributes;
?? TITLE := 'modify_attributes', EJECT ??

{ PURPOSE:
{   Build an updated attribute by adding/removing the elements in lists in
{   attribute_update to/from the lists in old_attribute.

      PROCEDURE modify_attributes
        (    attribute_update: jmt$object_attribute;
             old_attribute: jmt$object_attribute;
         VAR new_attribute: jmt$object_attribute);

        VAR
          default_attribute: [STATIC] jmt$object_attribute := [jmc$default],
          smaller_list_size: jmt$object_attribute_index,
          desired_list_size: jmt$object_attribute_index,
          index: jmt$object_attribute_index;

        CASE attribute_update.kind OF
        = jmc$all =
          new_attribute.kind := jmc$all;
          IF how = jmc$delete_list_items THEN
            new_attribute.kind := jmc$none;
          IFEND;
        = jmc$type =
          new_attribute.kind := attribute_update.kind;
          desired_list_size := UPPERBOUND (attribute_update.attribute_list^);
          NEXT new_attribute.attribute_list: [1 .. desired_list_size] IN
                jmv$working_storage;
          IF new_attribute.attribute_list = NIL THEN
            jmp$internal_error (52);
          IFEND;
          smaller_list_size := 0;
          IF old_attribute.kind = attribute_update.kind THEN
            smaller_list_size := UPPERBOUND (old_attribute.attribute_list^);
            IF smaller_list_size > desired_list_size THEN
              smaller_list_size := desired_list_size;
            IFEND;
            FOR index := 1 TO smaller_list_size DO
              modify_attributes (attribute_update.attribute_list^ [index],
                    old_attribute.attribute_list^ [index],
                    new_attribute.attribute_list^ [index]);
            FOREND;
          IFEND;
          FOR index := smaller_list_size + 1 TO desired_list_size DO
            modify_attributes (attribute_update.attribute_list^ [index],
                  default_attribute, new_attribute.attribute_list^ [index]);
          FOREND;
        = jmc$list =
          update_attribute_list (attribute_update, old_attribute,
                new_attribute);
        ELSE
          new_attribute := attribute_update;
        CASEND;
      PROCEND modify_attributes;
?? TITLE := 'update_attribute_list', EJECT ??

{ PURPOSE:
{   Add to/Remove from the list in old attribute the items in the list in
{   new attribute producing a new updated list in updated attribute.

      PROCEDURE update_attribute_list
        (    attribute_update: jmt$object_attribute;
             old_attribute: jmt$object_attribute;
         VAR new_attribute: jmt$object_attribute);

        VAR
          old_list_size: jmt$object_attribute_index,
          desired_list_size: jmt$object_attribute_index,
          first_object: jmt$profile_object_reference,
          attribute: jmt$object_attribute,
          object: jmt$profile_object_reference,
          object_count: 0 .. jmc$maximum_objects_on_profile,
          last_name: ost$name,
          toggle: 0 .. 1,
          index: jmt$object_attribute_index;

        new_attribute := attribute_update;
        IF attribute_update.attribute_list^ [1].kind <> jmc$object THEN
          RETURN;
        IFEND;
        object := attribute_update.attribute_list^ [1].object_p;
        first_object := jmv$the_profile.objects [object^.kind];
        CASE old_attribute.kind OF
        = jmc$list =
          toggle := 0;
          old_list_size := UPPERBOUND (old_attribute.attribute_list^);
        = jmc$all =
          toggle := 1;
          old_list_size := 0;
        ELSE
          IF how = jmc$delete_list_items THEN
            set_object_error (jme$item_to_delete_is_missing, object^, status);
            EXIT change_object;
          IFEND;
          RETURN;
        CASEND;

{ Represent the old list as 'profile_index=1' in the actual profile
{ objects for those objects in the list.

        object := first_object;
        object_count := 0;
        last_name := '';
        WHILE object <> NIL DO
          object^.profile_index := 0;
          IF object^.name <> last_name THEN
            object_count := object_count + 1;
            object^.profile_index := toggle;
          IFEND;
          last_name := object^.name;
          object := object^.next_object;
        WHILEND;
        desired_list_size := object_count * toggle;
        FOR index := 1 TO old_list_size DO
          attribute := old_attribute.attribute_list^ [index];
          IF attribute.kind = jmc$object THEN
            desired_list_size := desired_list_size -
                  attribute.object_p^.profile_index + 1;
            attribute.object_p^.profile_index := 1;
          IFEND;
        FOREND;

{ Add or Delete items from the list by changing the 'Profile_index' to
{ 1 or 0 respectively in the profile objects to be added or removed.

        toggle := 1;
        IF how = jmc$delete_list_items THEN
          toggle := 0;
        IFEND;
        FOR index := 1 TO UPPERBOUND (attribute_update.attribute_list^) DO
          attribute := attribute_update.attribute_list^ [index];
          IF attribute.kind = jmc$object THEN
            IF attribute.object_p^.profile_index = toggle THEN
              IF toggle = 0 THEN
                set_object_error (jme$item_to_delete_is_missing,
                      attribute.object_p^, status);
              ELSE
                set_object_error (jme$item_to_add_is_present,
                      attribute.object_p^, status);
              IFEND;
              EXIT change_object;
            IFEND;
            desired_list_size := desired_list_size + 2 * toggle - 1;
            attribute.object_p^.profile_index := toggle;
          IFEND;
        FOREND;

{ Build new list with all profile objects with 'profile_index=1'.

        IF desired_list_size = object_count THEN
          new_attribute.kind := jmc$all;
        ELSEIF desired_list_size = 0 THEN
          new_attribute.kind := jmc$none;
        ELSE
          NEXT new_attribute.attribute_list: [1 .. desired_list_size] IN
                jmv$working_storage;
          IF new_attribute.attribute_list = NIL THEN
            jmp$internal_error (52);
          IFEND;

          object := first_object;
          index := 0;
          WHILE object <> NIL DO
            IF object^.profile_index = 1 THEN
              index := index + 1;
              new_attribute.attribute_list^ [index].kind := jmc$object;
              new_attribute.attribute_list^ [index].object_p := object;
            IFEND;
            object := object^.next_object;
          WHILEND;
        IFEND;
      PROCEND update_attribute_list;
?? OLDTITLE, EJECT ??

      VAR
        following_object: jmt$profile_object_reference,
        new_object: jmt$profile_object,
        old_attributes: jmt$object_attribute,
        unique_name: ost$unique_name,
        update_attributes: jmt$object_attribute;

      new_object := the_object^;

      pmp$generate_unique_name (unique_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      new_object.behaviour_id := unique_name.value;
      new_object.changed := TRUE;

      old_attributes := new_object.attributes;
      IF how = jmc$replace THEN
        jmv$the_profile.definition_id := unique_name.value;
        new_object.definition_id := unique_name.value;
        new_object.attributes.kind := jmc$default;
      ELSE
        IF new_attributes.kind = jmc$type THEN
          FOR i := 1 TO UPPERBOUND (new_attributes.attribute_list^) DO
            IF new_attributes.attribute_list^ [i].kind <> jmc$empty THEN
              IF attribute_definition.declarations^ [i]^.group =
                    jmc$membership_group THEN
                new_object.definition_id := unique_name.value;
                jmv$the_profile.definition_id := unique_name.value;
              IFEND;
            IFEND;
          FOREND;
        IFEND;
      IFEND;

      IF how = jmc$replace THEN
        jmp$copy_attributes (new_attributes, new_object.attributes);
      ELSE
        IF how = jmc$update THEN
          update_attributes := new_attributes;
        ELSE
          modify_attributes (new_attributes, old_attributes,
                update_attributes);
        IFEND;

        merge_new_attributes (update_attributes, new_object.attributes,
              new_object.attributes);
      IFEND;

      IF attribute_constraints <> NIL THEN
        attribute_constraints^ (new_object, status);
        IF NOT status.normal THEN
          jmp$delete_attributes (new_object.attributes);
          RETURN;
        IFEND;
      IFEND;
      jmp$delete_attributes (old_attributes);

{ Delete all additional definitions with this same name.

      following_object := new_object.next_object;
      WHILE (following_object <> NIL) AND (following_object^.name =
            new_object.name) DO
        new_object.next_object := following_object^.next_object;
        jmp$delete_attributes (following_object^.attributes);
        FREE following_object IN jmv$object_heap^;
        following_object := new_object.next_object;
      WHILEND;

      the_object^ := new_object;
    PROCEND change_object;
?? OLDTITLE, EJECT ??

    VAR
      abbreviation: ost$name,
      i: integer,
      ignored: jmt$profile_object_reference,
      list_entry: ^clt$data_value,
      object_with_abbreviation: jmt$profile_object_reference,
      the_object: jmt$profile_object_reference;

    status.normal := TRUE;

    attribute_definition := jmv$object_definition [object_kind].declaration;
    attribute_constraints := jmv$object_definition [object_kind].
          check_attributes;

  /change/
    BEGIN
      abbreviation := osc$null_name;
      object_with_abbreviation := NIL;
      IF new_attributes.kind = jmc$type THEN
        IF new_attributes.attribute_list^ [jmc$object_abbreviation].kind =
              jmc$name THEN
          abbreviation := new_attributes.attribute_list^ [
                jmc$object_abbreviation].name^;
          jmp$get_object (abbreviation, object_kind, object_with_abbreviation,
                ignored, status);
          status.normal := TRUE;
        IFEND;
      IFEND;

      IF objects.kind = clc$name THEN
        jmp$get_object (objects.name_value, object_kind, the_object, ignored,
              status);
        IF NOT status.normal THEN
          EXIT /change/;
        IFEND;
        IF (object_with_abbreviation <> NIL) AND
              (object_with_abbreviation <> the_object) THEN
          osp$set_status_abnormal (jmc$job_management_id,
                jme$duplicate_abbreviation, abbreviation, status);
          EXIT /change/;
        IFEND;
        change_object (the_object, status);

      ELSEIF objects.kind = clc$list THEN
        list_entry := ^objects;
        IF (abbreviation <> osc$null_name) AND
              (clp$count_list_elements (list_entry) > 1) THEN
          osp$set_status_abnormal (jmc$job_management_id,
                jme$abbreviation_change_illegal, '', status);
          EXIT /change/;
        IFEND;
        WHILE list_entry <> NIL DO
          IF list_entry^.element_value <> NIL THEN
            jmp$get_object (list_entry^.element_value^.name_value, object_kind,
                  the_object, ignored, status);
            IF NOT status.normal THEN
              EXIT /change/;
            IFEND;
            IF (object_with_abbreviation <> NIL) AND
                  (object_with_abbreviation <> the_object) THEN
              osp$set_status_abnormal (jmc$job_management_id,
                    jme$duplicate_abbreviation, abbreviation, status);
              EXIT /change/;
            IFEND;
            change_object (the_object, status);
            IF NOT status.normal THEN
              EXIT /change/;
            IFEND;
          IFEND;
          list_entry := list_entry^.link;
        WHILEND;

      ELSEIF objects.kind = clc$keyword {ALL} THEN
        the_object := jmv$the_profile.objects [object_kind];
        WHILE the_object <> NIL DO
          change_object (the_object, status);
          IF NOT status.normal THEN
            EXIT /change/;
          IFEND;
          the_object := the_object^.next_object;
        WHILEND;
      IFEND;
      jmp$set_object_default (object_kind, ^objects);
    END /change/;
  PROCEND jmp$change_object;
?? TITLE := '[XDCL, #GATE] jmp$delete_object', EJECT ??

{ PURPOSE:
{   This interface deletes the specified objects from the profile.
{
{ DESIGN:
{   The routine determines the objects to be deleted and calls a subordinate
{   routine to actually delete them.

  PROCEDURE [XDCL, #GATE] jmp$delete_object
    (    object_kind: jmt$profile_object_kinds;
         objects: clt$data_value;
     VAR status: ost$status);

?? NEWTITLE := 'delete_object', EJECT ??

{ PURPOSE:
{   This interface deletes the specified object from the profile.
{
{ DESIGN:
{   The routine locates the object and removes it and any objects following
{   it that have the same name.
{
{ NOTES:
{   Deleting an object causes the profile definition_id to be changed.

    PROCEDURE delete_object
      (    previous_object: jmt$profile_object_reference;
       VAR the_object: jmt$profile_object_reference;
       VAR status: ost$status);

?? NEWTITLE := 'count_self_references', EJECT ??

      FUNCTION count_self_references
        (    attribute: jmt$object_attribute): integer;

        VAR
          i: integer,
          references: integer;

        references := 0;
        IF attribute.kind = jmc$object THEN
          references := $INTEGER (attribute.object_p = the_object);
        ELSEIF attribute.kind <= jmc$range THEN
          FOR i := 1 TO UPPERBOUND (attribute.attribute_list^) DO
            references := references + count_self_references
                  (attribute.attribute_list^ [i]);
          FOREND;
        IFEND;
        count_self_references := references;
      FUNCEND count_self_references;
?? OLDTITLE, EJECT ??

      VAR
        name: ost$name,
        next_object: jmt$profile_object_reference;

      IF the_object^.permanent THEN
        set_object_error (jme$permanent_object, the_object^, status);
        RETURN;
      IFEND;

      IF count_self_references (the_object^.attributes) <
            the_object^.references THEN
        osp$set_status_abnormal (jmc$job_management_id,
              jme$profile_object_referenced, the_object^.name, status);
        RETURN;
      IFEND;

      name := the_object^.name;
      REPEAT
        next_object := the_object^.next_object;
        jmv$the_profile.count [object_kind] :=
              jmv$the_profile.count [object_kind] - 1;
        jmp$delete_attributes (the_object^.attributes);
        FREE the_object IN jmv$object_heap^;
        the_object := next_object;
      UNTIL (next_object = NIL) OR (next_object^.name <> name);

      IF previous_object = NIL THEN
        jmv$the_profile.objects [object_kind] := next_object;
      ELSE
        previous_object^.next_object := next_object;
      IFEND;
      jmv$the_profile.definition_id := unique_name.value;
    PROCEND delete_object;
?? OLDTITLE, EJECT ??

    VAR
      i: integer,
      unique_name: ost$unique_name,
      an_object: ^clt$data_value,
      the_object: jmt$profile_object_reference,
      previous_object: jmt$profile_object_reference;

    pmp$generate_unique_name (unique_name, status);

    IF objects.kind = clc$name THEN
      jmp$get_object (objects.name_value, object_kind, the_object,
            previous_object, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      delete_object (previous_object, the_object, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    ELSEIF objects.kind = clc$list THEN
      an_object := ^objects;
      WHILE an_object <> NIL DO
        jmp$delete_object (object_kind, an_object^.element_value^, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        an_object := an_object^.link;
      WHILEND;

    ELSEIF objects.kind = clc$keyword {ALL} THEN
      WHILE jmv$the_profile.objects [object_kind] <> NIL DO
        the_object := jmv$the_profile.objects [object_kind];
        delete_object (NIL, the_object, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      WHILEND;
    IFEND;
    jmp$set_object_default (object_kind, NIL);

  PROCEND jmp$delete_object;
?? TITLE := '[XDCL] jmp$get_object', EJECT ??

{ PURPOSE:
{   This interface finds the requested object.
{
{ DESIGN:
{   The request makes a sequencial search for the name in the list of objects
{   of the specified type.  Both the name and abbreviation are checked.
{
{ NOTES:
{   The pointer to the first of a list of same-named types is returned.

  PROCEDURE [XDCL] jmp$get_object
    (    the_name: string ( * );
         the_kind: jmt$profile_object_kinds;
     VAR the_object: jmt$profile_object_reference;
     VAR previous_object: jmt$profile_object_reference;
     VAR status: ost$status);

    VAR
      object: jmt$profile_object,
      current_object: jmt$profile_object_reference;

{ Search for object with a matching name of the desired type.

    status.normal := TRUE;

    previous_object := NIL;
    current_object := jmv$the_profile.objects [the_kind];
    WHILE (current_object <> NIL) AND (current_object^.name <> the_name) DO
      previous_object := current_object;
      current_object := current_object^.next_object;
    WHILEND;

    IF current_object <> NIL THEN
      the_object := current_object;
      RETURN;
    IFEND;

{ Search for object with an abbrievation that matches.

    previous_object := NIL;
    current_object := jmv$the_profile.objects [the_kind];
    WHILE (current_object <> NIL) DO
      IF current_object^.attributes.kind = jmc$type THEN
        IF current_object^.attributes.attribute_list^
              [jmc$object_abbreviation].kind = jmc$name THEN
          IF current_object^.attributes.attribute_list^ [
                jmc$object_abbreviation].name^ = the_name THEN
            the_object := current_object;
            RETURN;
          IFEND;
        IFEND;
      IFEND;
      previous_object := current_object;
      current_object := current_object^.next_object;
    WHILEND;
    the_object := NIL;
    object.name := the_name;
    object.kind := the_kind;
    set_object_error (jme$object_not_known, object, status);

  PROCEND jmp$get_object;
?? TITLE := '[XDCL] jmp$move_object', EJECT ??

{ PURPOSE:
{   This interface moves one or more objects to follow the specified object.
{
{ DESIGN:
{   The destination object is found and all objects are found and moved in
{   front of the destination object.

  PROCEDURE [XDCL] jmp$move_object
    (    object_kind: jmt$profile_object_kinds;
         objects: clt$data_value;
         destination_name: string ( * );
     VAR status: ost$status);

    VAR
      destination_object: jmt$profile_object_reference,
      previous_to_destination: jmt$profile_object_reference;

?? NEWTITLE := 'move_object', EJECT ??

{ PURPOSE:
{   This interface moves an object to in front of the destination object.
{
{ DESIGN:
{   Delete the object from the list and then reinsert it in front of the
{   destination object.
{
{ NOTES:
{   Moving an object changes the DEFINITION_ID of the profile.

    PROCEDURE move_object
      (    previous_object: jmt$profile_object_reference;
       VAR object_to_move: jmt$profile_object_reference;
       VAR status: ost$status);

      IF (previous_to_destination = object_to_move) OR
            (destination_object = object_to_move) THEN
        RETURN;
      IFEND;

      IF object_to_move^.name = 'UNASSIGNED' THEN
        set_object_error (jme$cannot_move_unassigned, object_to_move^, status);
        RETURN;
      IFEND;

      IF previous_object = NIL THEN
        jmv$the_profile.objects [object_to_move^.kind] :=
              object_to_move^.next_object;
      ELSE
        previous_object^.next_object := object_to_move^.next_object;
      IFEND;

      object_to_move^.next_object := destination_object;
      IF previous_to_destination = NIL THEN
        jmv$the_profile.objects [object_to_move^.kind] := object_to_move;
      ELSE
        previous_to_destination^.next_object := object_to_move;
      IFEND;
      previous_to_destination := object_to_move;

      jmv$the_profile.definition_id := unique_name.value;
    PROCEND move_object;
?? OLDTITLE, EJECT ??

    VAR
      list_entry: ^clt$data_value,
      previous_object: jmt$profile_object_reference,

      the_object: jmt$profile_object_reference,
      unique_name: ost$unique_name;

    pmp$generate_unique_name (unique_name, status);

    jmp$get_object (destination_name, object_kind, destination_object,
          previous_to_destination, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF objects.kind = clc$name THEN
      jmp$get_object (objects.name_value, object_kind, the_object,
            previous_object, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      move_object (previous_object, the_object, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    ELSEIF objects.kind = clc$list THEN
      list_entry := ^objects;
      WHILE list_entry <> NIL DO
        IF list_entry^.element_value <> NIL THEN
          jmp$get_object (list_entry^.element_value^.name_value, object_kind,
                the_object, previous_object, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          move_object (previous_object, the_object, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        list_entry := list_entry^.link;
      WHILEND;

    ELSEIF objects.kind = clc$keyword {ALL} THEN
      the_object := destination_object^.next_object;
      WHILE the_object <> NIL DO
        move_object (destination_object, the_object, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        the_object := destination_object^.next_object;
      WHILEND;
    IFEND;
    jmp$set_object_default (object_kind, ^objects);

  PROCEND jmp$move_object;
?? OLDTITLE ??
?? NEWTITLE := '[XREF, #GATE] jmp$set_object_default', EJECT ??

{ PURPOSE:
{   Defines the new default for that object type in commands.

  PROCEDURE [XDCL, #GATE] jmp$set_object_default
    (    object_kind: jmt$profile_object_kinds;
         objects: ^clt$data_value);

    VAR
      i: clt$list_size,
      list_size: clt$list_size,
      node: ^clt$data_value;

    IF jmv$current_class_name [object_kind] <> NIL THEN
      FREE jmv$current_class_name [object_kind] IN jmv$object_heap^;
    IFEND;
    jmv$current_class_name [object_kind] := NIL;
    IF (objects <> NIL) THEN
      IF objects^.kind = clc$list THEN
        list_size := clp$count_list_elements (objects);
        IF list_size > 0 THEN
          ALLOCATE jmv$current_class_name [object_kind]: [1 .. list_size] IN
                jmv$object_heap^;
        IFEND;
        node := objects;
        FOR i := 1 TO clp$count_list_elements (objects) DO
          jmv$current_class_name [object_kind]^ [i] :=
                node^.element_value^.name_value;
          node := node^.link;
        FOREND
      ELSE
        ALLOCATE jmv$current_class_name [object_kind]: [1 .. 1] IN
              jmv$object_heap^;
        IF (objects^.kind = clc$keyword) THEN
          jmv$current_class_name [object_kind]^ [1] := objects^.keyword_value;
        ELSE
          jmv$current_class_name [object_kind]^ [1] := objects^.name_value;
        IFEND;
      IFEND;
    IFEND;
    jmv$current_profile_level := object_kind;
  PROCEND jmp$set_object_default;
?? OLDTITLE ??
?? NEWTITLE := 'set_object_error', EJECT ??

{ PURPOSE:
{   This routine builds an error message including both the object name
{   and object kind.

  PROCEDURE set_object_error
    (    the_error: ost$status_condition_code;
         the_object: jmt$profile_object;
     VAR status: ost$status);

    osp$set_status_abnormal (jmc$job_management_id, the_error, the_object.name,
          status);
    osp$append_status_parameter (osc$status_parameter_delimiter,
          jmv$object_definition [the_object.kind].declaration.name, status);
  PROCEND set_object_error;
MODEND jmm$administer_objects;

