?? NEWTITLE := 'NOS/VE : Job Leveler Task' ??
MODULE jmm$job_leveler_task;

{ PURPOSE:
{   This module contains the code for the NOS/VE Job Leveler Task.  The Job
{   Leveler Task is responsible for controlling the load of jobs on a mainframe
{   in relation to other mainframes in a set of systems connected by the NOS/VE
{   File Server.  The job leveler is responsible for the assignment of jobs
{   from one mainframe to another (this includes the ability to "unassign"
{   a job that has not been initiated).
{
{ DESIGN:
{   The job leveler task executes in ring 6.
{
{   The job leveler will assign and unassign jobs every job leveler cycle.  It
{   will determine how many jobs the mainframe requires for each job class and
{   perform requests to all server mainframes to request jobs for assignment.
{   At the same time, it will return jobs to the server mainframes that it
{   believes will not be initiated before the job leveler executes again.  When
{   the server assigns jobs to the client mainframe on which the job leveler is
{   executing, the jobs are added to the Known Job List (KJL) on the client.
{   Once in the KJL, the jobs are initiated in the same fashion that
{   non-leveled jobs are.
{
{   A sequence is used to contain data - this allows the requests to always
{   pass a container large enough to contain all data that could be returned.
{   After returning from the request, the containers are reset to occupy only
{   the space actually required (i.e., the data returned by the request)
{   instead of the maximum.  This should allow the task's working set to
{   remain as small as possible.  This is particularly important since the task
{   executes in the system job.
{
{ NOTES:
{   The Job Management Project has a detail design document that describes the
{   operations of the job leveler in detail, "NOS/VE Queue File Management
{   Detail Design."
{
{   In a future release of NOS/VE this module is intended to be made available
{   in source form as a site hook.  At that time, additional documentation will
{   be added to document in much more detail the functions of the job leveler
{   at a high level.  With this in mind, the module will have a module width
{   of the CYBIL default (i.e., 79).

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$parameter_list
*copyc ost$status
?? POP ??
*copyc dfp$get_partner_mainframes
*copyc dfp$store_leveler_status
*copyc jmp$assign_server_jobs
*copyc jmp$call_job_leveler_server
*copyc jmp$clear_server_job_classes
*copyc jmp$determine_needed_priorities
*copyc jmp$determine_need_for_jobs
*copyc jmp$discard_server_jobs
*copyc jmp$get_client_scheduling_data
*copyc jmp$leveler_wait
*copyc jmp$register_job_leveler
*copyc jmp$unassign_server_jobs
*copyc jmp$update_server_priorities
*copyc jmp$verify_inactive_server
*copyc mmp$create_scratch_segment
*copyc osp$establish_block_exit_hndlr
*copyc pmp$long_term_wait
?? OLDTITLE ??
?? NEWTITLE := 'update_leveler_status', EJECT ??

{ This procedure updates the leveler status for the file server display.

  PROCEDURE update_leveler_status
    (    server_mainframe_id: pmt$binary_mainframe_id;
         leveler_state: jmt$jl_job_leveler_state;
         cleanup_completed: boolean);

    VAR
      ignore_status: ost$status,
      leveler_status: jmt$jl_job_leveler_status;

    leveler_status.leveler_state := leveler_state;
    leveler_status.cleanup_completed := cleanup_completed;
    dfp$store_leveler_status (server_mainframe_id, leveler_status,
          ignore_status);
  PROCEND update_leveler_status;
?? OLDTITLE ??
?? NEWTITLE := 'jmp$job_leveler_task', EJECT ??

{ PURPOSE:
{   This procedure is the NOS/VE Job Leveler Task.

  PROGRAM jmp$job_leveler_task
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      highest_server_class_priorities: jmt$jl_server_job_priorities,
      job_class: jmt$job_class,
      leveler_job_class_data: jmt$jl_job_class_data,
      scheduling_data: jmt$jl_scheduling_data,
      scratch_segment_pointer: amt$segment_pointer,
      scratch_sequence_p: ^SEQ ( * ),
      server_inactive: boolean,
      server_mainframe_count: dft$partner_mainframe_count,
      server_mainframe_id: pmt$binary_mainframe_id,
      server_mainframe_index: dft$partner_mainframe_count,
      server_mainframe_list_p: ^dft$partner_mainframe_list;

?? NEWTITLE := 'handle_block_exit', EJECT ??

{ PURPOSE:
{   The purpose of this request is to cleanup when the job leveler task
{ is terminated.
{
{ DESIGN:
{   Unassign the jobs from all server mainframes that are still active
{ or are deactivated.  The server mainframe is then signed off.

    PROCEDURE handle_block_exit
      (    condition: pmt$condition;
           condition_information_p: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      NEXT server_mainframe_list_p: [1 .. dfc$maximum_partner_mainframes] IN
            scratch_sequence_p;
      dfp$get_partner_mainframes ({ partners_are_servers } TRUE,
            server_mainframe_list_p, server_mainframe_count);
      RESET scratch_sequence_p TO server_mainframe_list_p;
      IF server_mainframe_count > 0 THEN
        NEXT server_mainframe_list_p: [1 .. server_mainframe_count] IN
              scratch_sequence_p;
      ELSE
        server_mainframe_list_p := NIL;
      IFEND;

      FOR server_mainframe_index := 1 TO server_mainframe_count DO
        server_mainframe_id := server_mainframe_list_p^
              [server_mainframe_index].mainframe_id;
        CASE server_mainframe_list_p^ [server_mainframe_index].partner_state OF
        = dfc$active =
          signoff_request (server_mainframe_id);

        = dfc$deactivated =
          signoff_request (server_mainframe_id);

        = dfc$inactive =
          ; { do nothing

        = dfc$terminated, dfc$awaiting_recovery =
          jmp$discard_server_jobs (server_mainframe_id);

        = dfc$recovering =
          ; { do nothing

        ELSE
        CASEND;

        update_leveler_status (server_mainframe_id, jmc$jl_leveler_disabled,
              { cleanup_completed } TRUE);
      FOREND;

      jmp$clear_server_job_classes;
    PROCEND handle_block_exit;
?? OLDTITLE ??
?? NEWTITLE := 'normal_request', EJECT ??

{ PURPOSE:
{   The purpose of this request is to send the "normal" leveler request to
{   the server mainframe.  This request includes unassigning jobs and
{   requesting assignment of additional jobs.

    PROCEDURE normal_request
      (    server_mainframe_id: pmt$binary_mainframe_id;
           leveler_job_class_data: jmt$jl_job_class_data;
           scheduling_data: jmt$jl_scheduling_data;
       VAR highest_server_class_priorities: jmt$jl_server_job_priorities);

      VAR
        assigned_job_index: jmt$job_count_range,
        job_class: jmt$job_class,
        leveler_server_request: jmt$jl_leveler_server_request,
        local_status: ost$status,
        successful_assigned_job_count: jmt$job_count_range,
        unassigned_job_count: jmt$job_count_range,
        unassigned_job_list_p: ^jmt$jl_unassigned_job_list;

      leveler_server_request.request_kind := jmc$jl_normal_request;
      leveler_server_request.normal_request.leveler_job_class_data :=
            leveler_job_class_data;
      leveler_server_request.normal_request.initiation_required_categories :=
            scheduling_data.initiation_required_categories;
      leveler_server_request.normal_request.initiation_excluded_categories :=
            scheduling_data.initiation_excluded_categories;
      leveler_server_request.normal_request.active_profile_id :=
            scheduling_data.profile_identification;

      jmp$determine_needed_priorities (leveler_server_request.normal_request.
            leveler_job_class_data, leveler_server_request.normal_request.
            job_class_priorities);
      NEXT leveler_server_request.normal_request.unassigned_job_list_p:
            [1 .. jmc$maximum_job_count] IN scratch_sequence_p;
      jmp$unassign_server_jobs (server_mainframe_id,
            { unassign_all_jobs } FALSE, leveler_server_request.normal_request.
            job_class_priorities, leveler_server_request.normal_request.
            unassigned_job_list_p, unassigned_job_count);
      RESET scratch_sequence_p TO leveler_server_request.normal_request.
            unassigned_job_list_p;
      IF unassigned_job_count = 0 THEN
        leveler_server_request.normal_request.unassigned_job_list_p := NIL;
      ELSE
        NEXT leveler_server_request.normal_request.unassigned_job_list_p:
              [1 .. unassigned_job_count] IN scratch_sequence_p;
      IFEND;

{ Call the server and request jobs via the Remote Procedure Call (RPC)
{ mechanism.

      NEXT leveler_server_request.normal_request.assigned_job_list_p:
            [1 .. jmc$maximum_job_count] IN scratch_sequence_p;
      jmp$call_job_leveler_server (server_mainframe_id, leveler_server_request,
            status);
      IF status.normal THEN
        FOR job_class := LOWERVALUE (job_class) TO UPPERVALUE (job_class) DO
          IF leveler_server_request.normal_request.
                server_job_priorities [job_class] >
                highest_server_class_priorities [job_class] THEN
            highest_server_class_priorities [job_class] :=
                  leveler_server_request.normal_request.
                  server_job_priorities [job_class];
          IFEND;
        FOREND;
        RESET scratch_sequence_p TO leveler_server_request.normal_request.
              assigned_job_list_p;
        IF (leveler_server_request.normal_request.profile_mismatch) OR
              (NOT leveler_server_request.normal_request.job_leveling_enabled)
              THEN

{ Return all jobs to the server.

          unassign_jobs_request (server_mainframe_id);
          IF leveler_server_request.normal_request.profile_mismatch THEN
            update_leveler_status (server_mainframe_id,
                  jmc$jl_server_profile_mismatch, { cleanup_completed } TRUE);
          ELSE
            update_leveler_status (server_mainframe_id,
                  jmc$jl_leveler_disabled, { cleanup_completed } TRUE);
          IFEND;

        ELSE

          IF leveler_server_request.normal_request.assigned_job_count > 0 THEN

{ Put the jobs assigned by the server into the Known Job List (KJL).

            NEXT leveler_server_request.normal_request.assigned_job_list_p:
                  [1 .. leveler_server_request.normal_request.
                  assigned_job_count] IN scratch_sequence_p;
            jmp$assign_server_jobs (server_mainframe_id,
                  leveler_server_request.normal_request.assigned_job_list_p,
                  successful_assigned_job_count, status);
            IF NOT status.normal THEN
              IF leveler_server_request.normal_request.assigned_job_count >
                    successful_assigned_job_count THEN
                NEXT unassigned_job_list_p: [1 .. leveler_server_request.
                      normal_request.assigned_job_count -
                      successful_assigned_job_count] IN scratch_sequence_p;
                FOR assigned_job_index := successful_assigned_job_count +
                      1 TO leveler_server_request.normal_request.
                      assigned_job_count DO
                  unassigned_job_list_p^ [assigned_job_index -
                        successful_assigned_job_count].system_job_name :=
                        leveler_server_request.normal_request.
                        assigned_job_list_p^ [assigned_job_index].
                        system_job_name;
                  unassigned_job_list_p^ [assigned_job_index -
                        successful_assigned_job_count].server_kjl_index :=
                        leveler_server_request.normal_request.
                        assigned_job_list_p^ [assigned_job_index].
                        server_kjl_index;
                FOREND;
                leveler_server_request.request_kind :=
                      jmc$jl_unassign_jobs_request;
                leveler_server_request.unassign_jobs_request.
                      unassigned_job_list_p := unassigned_job_list_p;
                jmp$call_job_leveler_server (server_mainframe_id,
                      leveler_server_request, { ignore } local_status);
              IFEND;
            IFEND;
          IFEND;
          update_leveler_status (server_mainframe_id, jmc$jl_leveler_enabled,
                { cleanup_completed } FALSE);
        IFEND;

      ELSE

{ The server has terminated - throw away all jobs assigned by the server.

        jmp$discard_server_jobs (server_mainframe_id);
        update_leveler_status (server_mainframe_id, jmc$jl_leveler_disabled,
              { cleanup_completed } TRUE);
      IFEND;
    PROCEND normal_request;
?? OLDTITLE ??
?? NEWTITLE := 'signoff_request', EJECT ??

{ PURPOSE:
{   The purpose of this request is signoff to the server mainframe.  This
{ request
{   is performed only when the job leveler task is being deactivated.

    PROCEDURE signoff_request
      (    server_mainframe_id: pmt$binary_mainframe_id);

      VAR
        ignore_status: ost$status,
        job_class: jmt$job_class,
        job_class_priorities: jmt$jl_job_class_priorities,
        leveler_server_request: jmt$jl_leveler_server_request,
        unassigned_job_count: jmt$job_count_range;

      leveler_server_request.request_kind := jmc$jl_signoff_request;
      FOR job_class := LOWERVALUE (job_class) TO UPPERVALUE (job_class) DO
        job_class_priorities [job_class].job_priority := 0;
        job_class_priorities [job_class].based_on_selection_priority := FALSE;
      FOREND;

      NEXT leveler_server_request.signoff_request.unassigned_job_list_p:
            [1 .. jmc$maximum_job_count] IN scratch_sequence_p;
      jmp$unassign_server_jobs (server_mainframe_id,
            { unassign_all_jobs } TRUE, job_class_priorities,
            leveler_server_request.signoff_request.unassigned_job_list_p,
            unassigned_job_count);
      RESET scratch_sequence_p TO leveler_server_request.signoff_request.
            unassigned_job_list_p;
      IF unassigned_job_count = 0 THEN
        leveler_server_request.signoff_request.unassigned_job_list_p := NIL;
      ELSE
        NEXT leveler_server_request.signoff_request.unassigned_job_list_p:
              [1 .. unassigned_job_count] IN scratch_sequence_p;
      IFEND;
      jmp$call_job_leveler_server (server_mainframe_id, leveler_server_request,
            ignore_status);
      update_leveler_status (server_mainframe_id, jmc$jl_leveler_disabled,
            { cleanup_completed } TRUE);
    PROCEND signoff_request;
?? OLDTITLE ??
?? NEWTITLE := 'unassign_jobs_request', EJECT ??

{ PURPOSE:
{   The purpose of this request is to unconditionally unassign all jobs for
{ the indicated server mainframe.

    PROCEDURE unassign_jobs_request
      (    server_mainframe_id: pmt$binary_mainframe_id);

      VAR
        ignore_status: ost$status,
        job_class: jmt$job_class,
        job_class_priorities: jmt$jl_job_class_priorities,
        leveler_server_request: jmt$jl_leveler_server_request,
        unassigned_job_count: jmt$job_count_range;

      leveler_server_request.request_kind := jmc$jl_unassign_jobs_request;
      FOR job_class := LOWERVALUE (job_class) TO UPPERVALUE (job_class) DO
        job_class_priorities [job_class].job_priority := 0;
        job_class_priorities [job_class].based_on_selection_priority := FALSE;
      FOREND;

      NEXT leveler_server_request.unassign_jobs_request.
            unassigned_job_list_p: [1 .. jmc$maximum_job_count] IN
            scratch_sequence_p;
      jmp$unassign_server_jobs (server_mainframe_id,
            { unassign_all_jobs } TRUE, job_class_priorities,
            leveler_server_request.unassign_jobs_request.unassigned_job_list_p,
            unassigned_job_count);
      RESET scratch_sequence_p TO leveler_server_request.unassign_jobs_request.
            unassigned_job_list_p;
      IF unassigned_job_count = 0 THEN
        leveler_server_request.unassign_jobs_request.unassigned_job_list_p :=
              NIL;
      ELSE
        NEXT leveler_server_request.unassign_jobs_request.
              unassigned_job_list_p: [1 .. unassigned_job_count] IN
              scratch_sequence_p;
      IFEND;
      jmp$call_job_leveler_server (server_mainframe_id, leveler_server_request,
            ignore_status);
    PROCEND unassign_jobs_request;
?? OLDTITLE ??
?? EJECT ??

{ Register the job leveler task with Queue File Management.  This will identify
{ the executing task as the one and only job leveler task.

    jmp$register_job_leveler;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random,
          scratch_segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    scratch_sequence_p := scratch_segment_pointer.sequence_pointer;
    #SPOIL (scratch_sequence_p);

    osp$establish_block_exit_hndlr (^handle_block_exit);

    WHILE TRUE DO
      RESET scratch_sequence_p;
      jmp$get_client_scheduling_data (scheduling_data);

      FOR job_class := LOWERVALUE (job_class) TO UPPERVALUE (job_class) DO
        highest_server_class_priorities [job_class] := 0;
      FOREND;

{ If there are servers to communicate with, determine the number of jobs that
{ are needed by this mainframe.

      NEXT server_mainframe_list_p: [1 .. dfc$maximum_partner_mainframes] IN
            scratch_sequence_p;
      dfp$get_partner_mainframes ({ partners_are_servers } TRUE,
            server_mainframe_list_p, server_mainframe_count);
      RESET scratch_sequence_p TO server_mainframe_list_p;
      IF server_mainframe_count > 0 THEN
        NEXT server_mainframe_list_p: [1 .. server_mainframe_count] IN
              scratch_sequence_p;
      ELSE
        server_mainframe_list_p := NIL;
      IFEND;

      jmp$determine_need_for_jobs (leveler_job_class_data);

      FOR server_mainframe_index := 1 TO server_mainframe_count DO
        server_mainframe_id := server_mainframe_list_p^
              [server_mainframe_index].mainframe_id;

        CASE server_mainframe_list_p^ [server_mainframe_index].partner_state OF
        = dfc$active =

{ For each ACTIVE server determine the priority required for jobs to be
{ assigned, and unassign any jobs unlikely to be initiated.  Retrieve the
{ mainframe's required and excluded categories and the active scheduling
{ profile id.

          IF scheduling_data.profile_loading_in_progress OR
                (NOT scheduling_data.job_leveling_enabled) THEN
            unassign_jobs_request (server_mainframe_id);
            update_leveler_status (server_mainframe_id,
                  jmc$jl_leveler_disabled, { cleanup_complete } TRUE);
          ELSE
            normal_request (server_mainframe_id, leveler_job_class_data,
                  scheduling_data, highest_server_class_priorities);
          IFEND;

        = dfc$deactivated =

{ For each DEACTIVATED server unassign any non-initiated jobs assigned by
{ the server mainframe.

          unassign_jobs_request (server_mainframe_id);
          update_leveler_status (server_mainframe_id, jmc$jl_leveler_disabled,
                { cleanup_complete } TRUE);

        = dfc$inactive =

{ For each server that is INACTIVE verify that there are no unassigned jobs on
{ this mainframe.  It is not possible to communicate with the server if it
{ is in the INACTIVE state.

          jmp$verify_inactive_server (server_mainframe_id, server_inactive);
          update_leveler_status (server_mainframe_id, jmc$jl_leveler_disabled,
                { cleanup_complete } TRUE);

        = dfc$terminated, dfc$awaiting_recovery =

{ For each TERMINATED server remove any non-initiated jobs assigned by the
{ server mainframe from the KJL.  It is not possible to communicate with the
{ server if it is in the TERMINATED state.
{ For each server that is AWAITING_RECOVERY remove any non-initiated jobs
{ assigned by the server mainframe from the KJL.  It is not possible to
{ communicate with the server in the AWAITING_RECOVERY state.  It is possible
{ for jobs to be in the KJL when the server crashes and the leveler must
{ remove them.


          jmp$discard_server_jobs (server_mainframe_id);
          update_leveler_status (server_mainframe_id, jmc$jl_leveler_disabled,
                { cleanup_complete } TRUE);

        = dfc$recovering =
          ; { Do nothing

        ELSE
        CASEND;

      FOREND;

{ Update the highest priority unassigned server job that is available for each
{ job class.

      IF server_mainframe_count > 0 THEN
        jmp$update_server_priorities (highest_server_class_priorities);
      ELSE
        jmp$clear_server_job_classes;
      IFEND;

{ Wait for the job leveling interval.

      jmp$leveler_wait (scheduling_data.job_leveling_interval);
    WHILEND;
  PROCEND jmp$job_leveler_task;
?? OLDTITLE ??
MODEND jmm$job_leveler_task;
