?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Job Management : job scheduler ring 2' ??
MODULE jmm$job_scheduler_ring_2;

{ PURPOSE:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$value
*copyc jse$condition_codes
*copyc jmc$kjl_maximum_entries
*copyc jmc$null_ajl_ordinal
*copyc jmc$system_family
*copyc jme$job_scheduler_conditions
*copyc jmt$active_job_queue
*copyc jmt$ajl_ordinal
*copyc jmt$clock_time
*copyc jmt$dispatching_control_info
*copyc jmt$dispatching_priority
*copyc jmt$job_scheduler_statistics
*copyc jmt$job_scheduler_table
*copyc jmt$lock_functions
*copyc jmt$operator_request_list
*copyc jmt$node
*copyc jmt$rb_scheduler_requests
*copyc jmt$service_class_set
*copyc jmt$service_class_name
*copyc jmt$system_supplied_name
*copyc ost$global_task_id
*copyc ost$status
*copyc pmd$log_entries
*copyc pmt$signal
?? POP ??
*copyc dmp$set_eoi
*copyc dpp$put_critical_message
*copyc i#call_monitor
*copyc jmp$adjust_swapin_cand_prio
*copyc jmp$add_to_maxaj_limit_set
*copyc jmp$allocate_more_ijl_space
*copyc jmp$change_dispatching_prior_r1
*copyc jmp$clear_memory_res_swap_field
*copyc jmp$clear_scheduler_event
*copyc jmp$compute_total_memory_used
*copyc jmp$decrement_lw_threshold
*copyc jmp$delete_ijl_entry
*copyc jmp$find_and_insert_swapin_cand
*copyc jmf$ijle_p
*copyc jmp$get_ijle_p
*copyc jmp$idle_advance_lw_jobs
*copyc jmp$idling_swapfile_update
*copyc jmp$incr_sched_serv_statistics
*copyc jmp$incr_scheduler_statistics
*copyc jmp$increment_ijl_in_use_count
*copyc jmp$initiate_job_from_scheduler
*copyc jmp$perform_physical_swapout
*copyc jmp$refresh_job_candidates
*copyc jmp$relink_to_end_of_swapin_q
*copyc jmp$reset_advance_lw_swaps
*copyc jmp$reset_activate_event
*copyc jmp$reset_activate_events_sels
*copyc jmp$reset_ijl_search_block
*copyc jmp$restore_job_environment
*copyc jmp$select_job_for_thrashing
*copyc jmp$select_reset_disp_pr
*copyc jmp$select_sched_memory_event
*copyc jmp$select_scheduler_ajlo_event
*copyc jmp$select_sched_service_wait
*copyc jmp$select_scheduler_short_wait
*copyc jmp$set_all_jobs_swapped_var
*copyc jmp$set_class_below_maxaj_limit
*copyc jmp$set_event_and_ready_sched
*copyc jmp$set_high_swapin_priority
*copyc jmp$set_sched_thrashing_event
*copyc jmp$set_unable_to_swap_flag
*copyc lgp$add_entry_to_system_log
*copyc osp$append_status_parameter
*copyc osp$generate_log_message
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc pfp$purge
*copy  syp$disable_job_recovery
?? EJECT ??
*copyc jmv$ajl_p
*copyc jmv$candidate_queued_jobs
*copyc jmv$classes_in_maxaj_limit_wait
*copyc jmv$idle_dispatching_controls
*copyc jmv$ijl_p
*copyc jmv$jcb
*copyc jmv$job_class_table_p
*copyc jmv$job_counts
*copyc jmv$job_scheduler_event
*copyc jmv$job_scheduler_table
*copyc jmv$max_ajl_ordinal_in_use
*copyc jmv$max_service_class_in_use
*copyc jmv$maximum_job_class_in_use
*copyc jmv$null_ijl_ordinal
*copyc jmv$number_free_ajl_entries
*copyc jmv$prevent_activation_of_jobs
*copyc jmv$refresh_job_candidates
*copyc jmv$service_classes
*copyc jmv$swapin_candidate_queue
*copyc jmv$system_ajl_ordinal
*copyc jmv$system_ijl_ordinal
*copyc jmv$system_job_ssn
*copyc jsv$ijl_swap_queue_list
*copyc mmv$aggressive_aging_level
*copyc mmv$max_working_set_size
*copyc mmv$gpql
*copyc mmv$reassignable_page_frames
*copyc mmv$reserved_page_count
*copyc mmv$resident_job_target
*copyc mmv$last_active_shared_queue
*copyc mtv$mx_ajl_entries
*copyc osv$job_pageable_heap
*copyc tmv$null_global_task_id
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??
  VAR
    jmv$total_pageable_pages: [XDCL] integer := 0,

    v$active_job_queue_free_index: jmt$active_job_queue_range,
    v$active_job_queue_header: jmt$active_job_queue_header,
    v$active_job_queue_p: ^jmt$active_job_queue,
    v$preemptable_memory: integer;

?? OLDTITLE ??
?? NEWTITLE := 'activate_jobs', EJECT ??

{ PURPOSE:
{   This procedure will swapin and initiate all jobs possible.  If any jobs cannot be activated,
{   jobs that are currently active will be preempted, if possible, to free resources for the
{   jobs waiting to be activated.

  PROCEDURE activate_jobs
    (    examine_input_queue: boolean;
         current_time: jmt$clock_time);

    VAR
      activation_violation: boolean,
      activation_violation_classes: jmt$service_class_set,
      active_queues_built: boolean,
      available_memory: integer,
      can_preempt: boolean,
      class: jmt$service_class_index,
      ijl_p: ^jmt$initiated_job_list_entry,
      memory_flushed_from_lw_queue: mmt$page_frame_index,
      need_ajl: boolean,
      needed_memory: integer,
      next_sc_ijl_p: ^jmt$initiated_job_list_entry,
      node: jmt$node,
      none_left: boolean,
      pages_used_to_init_jobs: integer,
      queue: mmt$global_page_queue_index,
      relink_count: integer,
      required_memory: integer,
      starting_block_number: jmt$ijl_block_number,
      starting_block_index: jmt$ijl_block_index,
      status: ost$status,
      sum_shared: integer,
      ws_greater_than_system_max: boolean;

?? NEWTITLE := 'get_free_ijl_entry', EJECT ??

    PROCEDURE get_free_ijl_entry
      (VAR free_ijl: jmt$ijl_ordinal);

      VAR
        found: boolean,
        ijl_bi: jmt$ijl_block_index,
        ijl_bn: jmt$ijl_block_number,
        ijl_p: ^jmt$initiated_job_list_entry,
        new_starting_block_index: jmt$ijl_block_index,
        new_starting_block_number: jmt$ijl_block_number;

      found := FALSE;

    /get_ijl_entry/
      FOR ijl_bn := starting_block_number TO jmv$ijl_p.max_block_in_use DO
        IF jmv$ijl_p.block_p^ [ijl_bn].index_p <> NIL THEN
          FOR ijl_bi := starting_block_index TO UPPERVALUE (jmt$ijl_block_index) DO
            ijl_p := ^jmv$ijl_p.block_p^ [ijl_bn].index_p^ [ijl_bi];
            IF ijl_p^.entry_status = jmc$ies_entry_free THEN
              free_ijl.block_number := ijl_bn;
              free_ijl.block_index := ijl_bi;
              found := TRUE;
              IF ijl_bi = UPPERVALUE (jmt$ijl_block_index) THEN

                IF ijl_bn = jmv$ijl_p.max_block_in_use THEN

                  { A new ijl must be allocated before the new_starting_block_number can be incremented.
                  { We may not need it if this is the last time through the /activation_loop/ in activate
                  { jobs.  Leave the new_starting_block_index at UPPERVALUE so we will exit the loop quickly
                  { if this is not the last time through.

                  new_starting_block_index := ijl_bi;
                  new_starting_block_number := ijl_bn;
                ELSE
                  new_starting_block_index := LOWERVALUE (jmt$ijl_block_index);
                  new_starting_block_number := ijl_bn + 1;
                IFEND;

              ELSE
                new_starting_block_index := ijl_bi + 1;
                new_starting_block_number := ijl_bn;
              IFEND;
              EXIT /get_ijl_entry/;
            IFEND;
          FOREND;
        ELSE
          EXIT /get_ijl_entry/;
        IFEND;
      FOREND /get_ijl_entry/;

      IF NOT found THEN
        IF ijl_bn = jmv$ijl_p.max_block_in_use THEN
          ijl_bn := ijl_bn + 1;
        IFEND;
        jmp$allocate_more_ijl_space (ijl_bn);
        free_ijl.block_number := ijl_bn;
        free_ijl.block_index := LOWERVALUE (jmt$ijl_block_index);
        new_starting_block_number := ijl_bn;
        new_starting_block_index := LOWERVALUE (jmt$ijl_block_index) + 1;
      IFEND;

      starting_block_number := new_starting_block_number;
      starting_block_index := new_starting_block_index;
      jmp$increment_ijl_in_use_count (ijl_bn);

    PROCEND get_free_ijl_entry;
?? OLDTITLE ??
?? NEWTITLE := 'activate', EJECT ??

    PROCEDURE activate
      (VAR pages_used_to_init_jobs: integer;
       VAR available_memory: integer;
       VAR status: ost$status);

      VAR
        ijlo: jmt$ijl_ordinal;

      status.normal := TRUE;

      CASE node.qtype OF
      = queued_thd =
        get_free_ijl_entry (ijlo);
        jmp$initiate_job_from_scheduler (node, ijlo, class, status);
        IF NOT status.normal THEN
          jmp$delete_ijl_entry (ijlo);
          RETURN;
        IFEND;
      = swapped =
        jmp$restore_job_environment (node, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
      CASEND;

      IF node.qtype <> swapped THEN
        pages_used_to_init_jobs := pages_used_to_init_jobs + required_memory;
      IFEND;
      available_memory := mmv$reassignable_page_frames.now - mmv$resident_job_target -
            pages_used_to_init_jobs - mmv$reserved_page_count;

      { Reset the memory needed by scheduler, if the counts have already been set up.

      IF active_queues_built THEN
        jmp$decrement_lw_threshold (node);
      IFEND;

    PROCEND activate;
?? OLDTITLE ??
?? EJECT ??

    active_queues_built := FALSE;
    activation_violation_classes := jmv$classes_in_maxaj_limit_wait;
    available_memory := mmv$reassignable_page_frames.now - mmv$resident_job_target - mmv$reserved_page_count;
    memory_flushed_from_lw_queue := 0;
    relink_count := 0;
    pages_used_to_init_jobs := 0;
    none_left := FALSE;
    starting_block_number := jmv$ijl_p.start_search_block;
    starting_block_index := LOWERVALUE (jmt$ijl_block_index);

  /activation_loop/
    WHILE TRUE DO
      select_highest_priority (examine_input_queue, current_time, activation_violation_classes, node, class,
            none_left);
      IF none_left THEN
        IF activation_violation_classes = $jmt$service_class_set [] THEN
          jmp$incr_scheduler_statistics (jmc$queues_emptied_count);
        ELSE
          jmp$incr_scheduler_statistics (jmc$none_left_activation_viol);
        IFEND;
        EXIT /activation_loop/;
      IFEND;

      activation_violation := (jmv$job_counts.service_class_counts [class].scheduler_initiated_jobs -
            jmv$job_counts.service_class_counts [class].swapped_jobs) >=
            jmv$service_classes [class]^.attributes.maximum_active_jobs;

      required_memory := node.ws;
      ws_greater_than_system_max := ((node.qtype = swapped) AND (node.ws > mmv$max_working_set_size));
      need_ajl := TRUE;
      IF node.qtype = swapped THEN
        jmp$get_ijle_p (node.ijl_ord, ijl_p);
        IF ijl_p^.swap_status < jmc$iss_initiate_swapout_io THEN
          required_memory := ijl_p^.memory_reserve_request.requested_page_count;
        ELSE
          required_memory := required_memory + ijl_p^.memory_reserve_request.requested_page_count;
        IFEND;
        need_ajl := (ijl_p^.ajl_ordinal = jmc$null_ajl_ordinal);
      IFEND;

{Quick exit when no free AJLs and no preemtion
      IF need_ajl AND (jmv$number_free_ajl_entries = 0) AND
            (jmv$service_classes [class]^.attributes.attempt_preemption = FALSE) THEN
        jmp$select_sched_service_wait;
        jmp$select_scheduler_ajlo_event (class);
        jmp$incr_sched_serv_statistics (jmc$ajlo_wait_no_preempt_attemp, class);
        EXIT /activation_loop/;
      IFEND;

      IF ws_greater_than_system_max OR activation_violation OR (available_memory < required_memory) OR
            ((jmv$number_free_ajl_entries <= 0) AND need_ajl) THEN

        IF NOT active_queues_built THEN

          { It is necessary to try to preempt, so a list of swappable jobs is built.  Also the threshold of
          { pages needed by scheduler to activate all swapin candidates is set (this controls whether jobs
          { stay in the long wait queue or not).  Start the IO on jobs in the long wait queue if necessary
          { or possible.

          build_active_job_queues (node);
          jmp$reset_advance_lw_swaps (memory_flushed_from_lw_queue);
          active_queues_built := TRUE;
        IFEND;

        IF ws_greater_than_system_max THEN

          IF ijl_p^.swapin_candidate_queue <> jmv$null_ijl_ordinal THEN
            jmp$get_ijle_p (ijl_p^.swapin_candidate_queue, next_sc_ijl_p);
          IFEND;

          { If swapping the job in will drive memory below target, but still be above thrashing, swap it in.
          { Memory manager algorithms will cause the jobs working set to decrease.

          IF node.ws < (available_memory + mmv$resident_job_target - mmv$aggressive_aging_level) THEN
            activate (pages_used_to_init_jobs, available_memory, status);
            IF NOT status.normal THEN
              jmp$incr_scheduler_statistics (jmc$large_ws_bad_status_on_act);
            ELSE
              jmp$incr_scheduler_statistics (jmc$large_ws_job_activated);
            IFEND;
            jmp$select_scheduler_short_wait;
            EXIT /activation_loop/;

          ELSEIF ((ijl_p^.swapin_candidate_queue = jmv$null_ijl_ordinal) OR
                (ijl_p^.scheduling_dispatching_priority > next_sc_ijl_p^.scheduling_dispatching_priority)) AND
                (jmv$max_ajl_ordinal_in_use = jmv$system_ajl_ordinal) THEN

            { If there are no other jobs contending for memory, swap the job in if there is enough memory in
            { the shared queue that can be freed up.  Swapper algorithms will cause the shared queue to be
            { raided.

            sum_shared := 0;
            FOR queue := mmc$pq_shared_first TO mmv$last_active_shared_queue DO
              sum_shared := sum_shared + mmv$gpql [queue].pqle.count;
            FOREND;
            IF (sum_shared - 10 + available_memory + mmv$resident_job_target - mmv$aggressive_aging_level) >
                  required_memory THEN
              activate (pages_used_to_init_jobs, available_memory, status);
              IF NOT status.normal THEN
                jmp$incr_scheduler_statistics (jmc$age_shared_q_bad_status);
              ELSE
                jmp$incr_scheduler_statistics (jmc$age_shared_q_activated);
              IFEND;
              jmp$select_scheduler_short_wait;
              EXIT /activation_loop/;
            ELSE
              activation_violation_classes := activation_violation_classes + $jmt$service_class_set [class];
            IFEND;

          ELSEIF (node.ws <
                mmv$max_working_set_size + mmv$resident_job_target - mmv$aggressive_aging_level) AND
                (node.ws < available_memory + v$preemptable_memory + mmv$resident_job_target) THEN

            { If there are jobs that can be preempted to get memory, preempt them.

            needed_memory := required_memory - available_memory;
            IF memory_flushed_from_lw_queue > needed_memory THEN
              memory_flushed_from_lw_queue := memory_flushed_from_lw_queue - needed_memory;
              available_memory := 0;
              needed_memory := 0;
              jmp$incr_scheduler_statistics (jmc$large_ws_mem_avail_in_lw_q);
            ELSE
              needed_memory := needed_memory - memory_flushed_from_lw_queue;
            IFEND;
            determine_if_can_preempt (FALSE, activation_violation, node, class, needed_memory, can_preempt);
            IF can_preempt THEN
              preempt (FALSE, activation_violation, node, class, needed_memory, status);
              jmp$incr_scheduler_statistics (jmc$large_ws_preempt_for_memory);
              jmp$select_sched_memory_event (required_memory, class);
              jmp$set_high_swapin_priority (node.ijl_ord);
              EXIT /activation_loop/;
            ELSE
              IF (ijl_p^.swapin_candidate_queue <> jmv$null_ijl_ordinal) AND
                    (relink_count < jmv$swapin_candidate_queue [class].number_of_jobs_in_queue) THEN
                jmp$relink_to_end_of_swapin_q (node.ijl_ord);
                jmp$incr_scheduler_statistics (jmc$large_ws_relink_no_preempt);
                relink_count := relink_count + 1;
              ELSE
                activation_violation_classes := activation_violation_classes + $jmt$service_class_set [class];
              IFEND;
            IFEND;

          ELSEIF (ijl_p^.swapin_candidate_queue <> jmv$null_ijl_ordinal) AND
                (ijl_p^.scheduling_dispatching_priority = next_sc_ijl_p^.scheduling_dispatching_priority) AND
                (relink_count < jmv$swapin_candidate_queue [class].number_of_jobs_in_queue) THEN

            { If this class has other jobs in the swapin queue, relink so they can be considered.

            jmp$relink_to_end_of_swapin_q (node.ijl_ord);
            jmp$incr_scheduler_statistics (jmc$large_ws_relink_job_too_big);
            relink_count := relink_count + 1;

          ELSE

            { Turn off considering candidates of this job class; this job cannot swap in now.

            activation_violation_classes := activation_violation_classes + $jmt$service_class_set [class];
          IFEND;
          jmp$select_sched_service_wait;
          jmp$select_sched_memory_event (required_memory, class);

        ELSEIF activation_violation THEN
          IF available_memory > required_memory THEN
            determine_if_can_preempt (TRUE, activation_violation, node, class, 0, can_preempt);
            IF can_preempt THEN

              { Only one job needs to be preempted so that the number of active jobs allowed for this class
              { is not exceeded.  The count of active jobs for the class will be decremented before preempt
              { returns, so the job scheduler is trying to activate will not be an activation_violation on
              { the next pass through the loop.

              preempt (TRUE, activation_violation, node, class, 0, status);
            ELSE
              activation_violation_classes := activation_violation_classes + $jmt$service_class_set [class];
              jmp$add_to_maxaj_limit_set (class);
              jmp$select_sched_service_wait;
              jmp$incr_scheduler_statistics (jmc$ajlo_wait_act_viol);
            IFEND;
          ELSE
            needed_memory := required_memory - available_memory;
            IF memory_flushed_from_lw_queue > needed_memory THEN
              memory_flushed_from_lw_queue := memory_flushed_from_lw_queue - needed_memory;
              determine_if_can_preempt (TRUE, activation_violation, node, class, 0, can_preempt);
              needed_memory := 0;
            ELSE
              needed_memory := needed_memory - memory_flushed_from_lw_queue;
              IF (available_memory + v$preemptable_memory) > required_memory THEN
                determine_if_can_preempt (FALSE, activation_violation, node, class, needed_memory,
                      can_preempt);
              ELSE
                can_preempt := FALSE;
              IFEND;
            IFEND;

            IF can_preempt THEN

              { Swapout (preempt) as many active jobs as necessay to get enough memory.  The job cannot be
              { activated until the memory is freed, so mark the class as an activation violation class to
              { prevent selecting the job again.  The job will be selected for activation when scheduler runs
              { again.

              preempt ((needed_memory = 0), activation_violation, node, class, needed_memory, status);
              available_memory := 0;
              IF needed_memory > 0 THEN
                memory_flushed_from_lw_queue := 0;
              IFEND;
              jmp$select_sched_memory_event (required_memory, class);
              jmp$incr_scheduler_statistics (jmc$wait_for_memory);
            ELSE
              jmp$add_to_maxaj_limit_set (class);
              jmp$incr_scheduler_statistics (jmc$memory_wait_act_viol);
            IFEND;
            jmp$select_sched_service_wait;
            activation_violation_classes := activation_violation_classes + $jmt$service_class_set [class];
          IFEND;

        ELSEIF available_memory < required_memory THEN

         /try_to_age_not_swap/
          BEGIN
            needed_memory := required_memory - available_memory;
            IF memory_flushed_from_lw_queue > needed_memory THEN
              memory_flushed_from_lw_queue := memory_flushed_from_lw_queue - needed_memory;
              available_memory := 0;
              jmp$incr_scheduler_statistics (jmc$memory_available_in_lw_q);
            ELSE
              needed_memory := needed_memory - memory_flushed_from_lw_queue;
              IF (available_memory + v$preemptable_memory) > required_memory THEN
                determine_if_can_preempt (FALSE, activation_violation, node, class, needed_memory,
                      can_preempt);
                IF can_preempt THEN

                  { Swapout (preempt) as many active jobs as necessay to get enough memory.  The job cannot be
                  { activated until the memory is freed, so mark the class as an activation violation class to
                  { prevent selecting the job again.  The job will be selected for activation when scheduler
                  { runs again.

                  preempt (FALSE, activation_violation, node, class, needed_memory, status);
                  IF NOT status.normal AND (status.condition = jse$job_aged_not_swapped) THEN
                    activate (pages_used_to_init_jobs, available_memory, status);
                    IF NOT status.normal THEN
                      jmp$incr_scheduler_statistics (jmc$bad_status_after_age_job);
                      jmp$select_scheduler_short_wait;
                      EXIT /activation_loop/;
                    ELSE
                      jmp$incr_scheduler_statistics (jmc$activate_after_age_job);
                      EXIT /try_to_age_not_swap/;
                    IFEND;
                  IFEND;
                  available_memory := 0;
                  memory_flushed_from_lw_queue := 0;
                  jmp$incr_scheduler_statistics (jmc$wait_for_memory);
                ELSE
                  jmp$incr_sched_serv_statistics (jmc$memory_wait_no_preempt, class);
                IFEND;
              ELSE
                jmp$incr_sched_serv_statistics (jmc$memory_wait_no_preempt, class);
              IFEND;
            IFEND;
            jmp$select_sched_service_wait;
            jmp$select_sched_memory_event (required_memory, class);
            activation_violation_classes := activation_violation_classes + $jmt$service_class_set [class];
          END /try_to_age_not_swap/;

        ELSE { jmv$number_free_ajl_entries = 0 AND need_ajl }
          determine_if_can_preempt (TRUE, activation_violation, node, class, 0, can_preempt);
          IF can_preempt THEN

            { Swapout (preempt) one active job to free an ajl ordinal.  EXIT the activation loop.
            { The job will be selected for activation when scheduler runs again.

            preempt (TRUE, activation_violation, node, class, 0, status);
            jmp$select_scheduler_ajlo_event (class);
            jmp$incr_scheduler_statistics (jmc$wait_for_ajlo);
          ELSE
            jmp$select_sched_service_wait;
            jmp$select_scheduler_ajlo_event (class);
            jmp$incr_sched_serv_statistics (jmc$ajlo_wait_no_preempt, class);
          IFEND;
          EXIT /activation_loop/;
        IFEND;

      ELSE
        activate (pages_used_to_init_jobs, available_memory, status);
        IF NOT status.normal THEN
          jmp$incr_scheduler_statistics (jmc$bad_status_on_activate);
          jmp$select_scheduler_short_wait;
          EXIT /activation_loop/;
        IFEND;
      IFEND;
    WHILEND /activation_loop/;

    jmp$reset_ijl_search_block (starting_block_number);

    { Active_queues_built = False means scheduler never had to try to preempt.  Reset the long_wait_
    { swap_threshold.  It may be higher from the previous time scheduler ran.

    IF NOT active_queues_built THEN
      jmp$reset_advance_lw_swaps (memory_flushed_from_lw_queue);
    IFEND;

  PROCEND activate_jobs;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] priority_allows_preemption', EJECT ??

  FUNCTION [INLINE] priority_allows_preemption
    (    dispatching_priority: jmt$dispatching_priority;
         priority: jmt$job_priority;
         queue_index: jmt$active_job_queue_range): boolean;

    priority_allows_preemption := (dispatching_priority >
          v$active_job_queue_p^ [queue_index].node.dispatching_priority) OR
          ((dispatching_priority = v$active_job_queue_p^ [queue_index].node.dispatching_priority) AND
          (priority >= v$active_job_queue_p^ [queue_index].node.priority));

  FUNCEND priority_allows_preemption;
?? OLDTITLE ??
?? NEWTITLE := 'determine_if_can_preempt', EJECT ??

  PROCEDURE determine_if_can_preempt
    (    singleton: boolean;
         activation_violation: boolean;
         node: jmt$node;
         class: jmt$service_class_index;
         needed_memory: integer;
     VAR can_preempt: boolean);

    VAR
      can_preempt_for_act_viol: boolean,
      class_index: jmt$service_class_index,
      ijl_ordinal: jmt$ijl_ordinal,
      in_memory: boolean,
      next_index: jmt$active_job_queue_range,
      queue_index: jmt$active_job_queue_range,
      within_queue_index: integer,
      ws_obtained: integer;

    can_preempt := FALSE;
    IF singleton THEN

      { Need to be able to preempt only one job, either because there are too many active jobs for a
      { certain class, or an ajl ordinal is needed.

      IF activation_violation THEN

        { Find a job in memory in order to preempt it.

        in_memory := FALSE;

        WHILE NOT in_memory AND (v$active_job_queue_header [class] <> 0) DO
          ijl_ordinal := v$active_job_queue_p^ [v$active_job_queue_header [class]].node.ijl_ord;
          IF jmf$ijle_p (ijl_ordinal) ^.entry_status = jmc$ies_job_in_memory THEN
            in_memory := TRUE;
            queue_index := v$active_job_queue_header [class];
            can_preempt := priority_allows_preemption (node.dispatching_priority, node.priority, queue_index);
          ELSE
            delete_active_job_from_q (v$active_job_queue_header [class], class);
          IFEND;
        WHILEND;
        RETURN;
      IFEND;

      { Else, determine if any job can be preempted to get a free ajl_ord.

      FOR class_index := jmc$system_service_class TO jmv$max_service_class_in_use DO
        in_memory := FALSE;
        WHILE NOT in_memory AND (v$active_job_queue_header [class_index] <> 0) DO
          queue_index := v$active_job_queue_header [class_index];
          ijl_ordinal := v$active_job_queue_p^ [queue_index].node.ijl_ord;
          IF jmf$ijle_p (ijl_ordinal) ^.entry_status = jmc$ies_job_in_memory THEN
            in_memory := TRUE;
            IF priority_allows_preemption (node.dispatching_priority, node.priority, queue_index) THEN
              can_preempt := TRUE;
              RETURN;
            IFEND;
          ELSE
            delete_active_job_from_q (queue_index, class_index);
          IFEND;
        WHILEND;
      FOREND;
      RETURN;

    ELSE

      { Jobs need to be preempted before others can be activated because memory is getting low.

      can_preempt_for_act_viol := FALSE;
      ws_obtained := 0;

      IF activation_violation THEN

        { Need to be able to preempt at least one job of the specified class.  Find a job in memory in order
        { to preempt it.

        in_memory := FALSE;
        WHILE NOT in_memory AND (v$active_job_queue_header [class] <> 0) DO
          queue_index := v$active_job_queue_header [class];
          ijl_ordinal := v$active_job_queue_p^ [queue_index].node.ijl_ord;
          IF jmf$ijle_p (ijl_ordinal) ^.entry_status = jmc$ies_job_in_memory THEN
            in_memory := TRUE;
            can_preempt_for_act_viol :=
                  priority_allows_preemption (node.dispatching_priority, node.priority, queue_index);
          ELSE
            delete_active_job_from_q (queue_index, class);
          IFEND;
        WHILEND;

        IF can_preempt_for_act_viol THEN
          ws_obtained := ws_obtained + v$active_job_queue_p^ [queue_index].node.ws;
          IF ws_obtained >= needed_memory THEN
            can_preempt := TRUE;
            RETURN;
          IFEND;
        ELSE
          RETURN;
        IFEND;
      IFEND;

      { Now look for jobs of lower priority in any service class that can be swapped to get enough memory.
      { Here the queues are searched by class, because it only needs to be determined that there are jobs that
      { can be swapped that will provide enough memory.  The procedure preempt however, will search across
      { service classes and swap out jobs according to priority.

      { Reset ws_obtained--if we went through activation_violation, the ws_obtained there will be re_added in
      { the following FOR loops.

      ws_obtained := 0;

      FOR class_index := jmc$system_service_class TO jmv$max_service_class_in_use DO
        queue_index := v$active_job_queue_header [class_index];

      /search_each_class/
        WHILE queue_index <> jmc$null_active_job_queue_link DO
          ijl_ordinal := v$active_job_queue_p^ [queue_index].node.ijl_ord;
          IF jmf$ijle_p (ijl_ordinal)^.entry_status = jmc$ies_job_in_memory THEN
            IF priority_allows_preemption (node.dispatching_priority, node.priority, queue_index) THEN
              ws_obtained := ws_obtained + v$active_job_queue_p^ [queue_index].node.ws;
              IF ws_obtained >= needed_memory THEN
                can_preempt := TRUE;
                RETURN;
              IFEND;
              next_index := v$active_job_queue_p^ [queue_index].link;
            ELSE
              EXIT /search_each_class/;
            IFEND;
          ELSE
            next_index := v$active_job_queue_p^ [queue_index].link;
            delete_active_job_from_q (queue_index, class);
          IFEND;
          queue_index := next_index;
        WHILEND /search_each_class/;
      FOREND;
    IFEND;

  PROCEND determine_if_can_preempt;
?? OLDTITLE ??
?? NEWTITLE := 'preempt', EJECT ??

  PROCEDURE preempt
    (    singleton: boolean;
         activation_violation: boolean;
         node: jmt$node;
         class: jmt$service_class_index;
         needed_memory: integer;
     VAR status: ost$status);

    VAR
      best_class: jmt$service_class_index,
      best_dispatching_priority: jmt$dispatching_priority,
      best_priority: jmt$job_priority,
      class_index: jmt$service_class_index,
      queue_index: jmt$active_job_queue_range,
      required_memory: integer,
      swap_candidate_found: boolean,
      swap_node: jmt$node;

    status.normal := TRUE;

    IF singleton THEN
      IF activation_violation THEN

        { Swap the lowest priority job of the service class.

        swap_node := v$active_job_queue_p^ [v$active_job_queue_header [class]].node;
        jmp$perform_physical_swapout (swap_node, jmc$sr_lower_priority, class, 0, status);
        delete_active_job_from_q (v$active_job_queue_header [class], class);
        v$preemptable_memory := v$preemptable_memory - swap_node.ws;
        RETURN;
      IFEND;

      { Preempt a job of any class in order to get an ajl_ord.

      swap_candidate_found := FALSE;
      best_dispatching_priority := node.dispatching_priority;
      best_priority := node.priority;

      FOR class_index := jmc$system_service_class TO jmv$max_service_class_in_use DO
        queue_index := v$active_job_queue_header [class_index];
        IF queue_index <> 0 THEN
          IF priority_allows_preemption (best_dispatching_priority, best_priority, queue_index) THEN
            best_class := class_index;
            best_priority := v$active_job_queue_p^ [queue_index].node.priority;
            best_dispatching_priority := v$active_job_queue_p^ [queue_index].node.dispatching_priority;
            swap_candidate_found := TRUE;
          IFEND;
        IFEND;
      FOREND;

      IF swap_candidate_found THEN
        swap_node := v$active_job_queue_p^ [v$active_job_queue_header [best_class]].node;
        jmp$perform_physical_swapout (swap_node, jmc$sr_lower_priority, best_class, 0, status);
        delete_active_job_from_q (v$active_job_queue_header [best_class], best_class);
        v$preemptable_memory := v$preemptable_memory - swap_node.ws;
        RETURN;
      IFEND;

    ELSE

      { Swap out as many lower priority jobs as necessary to get enough memory to activate a job.

      required_memory := needed_memory;
      IF activation_violation THEN

        { Swap out the lowest priority job of the service class to resolve the activation violation.

        swap_node := v$active_job_queue_p^ [v$active_job_queue_header [class]].node;
        jmp$perform_physical_swapout (swap_node, jmc$sr_lower_priority, class, 0, status);
        delete_active_job_from_q (v$active_job_queue_header [class], class);
        v$preemptable_memory := v$preemptable_memory - swap_node.ws;
        required_memory := required_memory - swap_node.ws;
      IFEND;

      { Now swap the lowest priority job of all the service classes; repeat until enough memory is acquired.

      WHILE required_memory > 0 DO
        swap_candidate_found := FALSE;
        best_dispatching_priority := node.dispatching_priority;
        best_priority := node.priority;

        FOR class_index := jmc$system_service_class TO jmv$max_service_class_in_use DO
          queue_index := v$active_job_queue_header [class_index];
          IF queue_index <> 0 THEN
            IF priority_allows_preemption (best_dispatching_priority, best_priority, queue_index) THEN
              best_class := class_index;
              best_priority := v$active_job_queue_p^ [queue_index].node.priority;
              best_dispatching_priority := v$active_job_queue_p^ [queue_index].node.dispatching_priority;
              swap_candidate_found := TRUE;
            IFEND;
          IFEND;
        FOREND;

        IF NOT swap_candidate_found THEN
          RETURN;
        IFEND;

        swap_node := v$active_job_queue_p^ [v$active_job_queue_header [best_class]].node;
        jmp$perform_physical_swapout (swap_node, jmc$sr_lower_priority, best_class, required_memory,
              status);
        IF NOT status.normal AND (status.condition = jse$job_aged_not_swapped) THEN

          { Desired memory was retrieved from aging, no more swapping is needed.

          RETURN;
        IFEND;
        delete_active_job_from_q (v$active_job_queue_header [best_class], best_class);
        required_memory := required_memory - swap_node.ws;
        v$preemptable_memory := v$preemptable_memory - swap_node.ws;
      WHILEND;
    IFEND;

  PROCEND preempt;
?? OLDTITLE ??
?? NEWTITLE := 'select_highest_priority', EJECT ??

{ PURPOSE:
{   This procedure selects the highest priority initiation candidate from across all queues.

  PROCEDURE select_highest_priority
    (    examine_input_queue: boolean;
         current_time: jmt$clock_time;
         activation_violation_classes: jmt$service_class_set;
     VAR best_node: jmt$node;
     VAR best_class: jmt$service_class_index;
     VAR none_left: boolean);

    VAR
      age_interval: integer,
      best_queued_class: jmt$service_class_index,
      best_queued_node: jmt$node,
      best_swapped_class: jmt$service_class_index,
      best_swapped_node: jmt$node,
      dispatching_priority: jmt$dispatching_priority,
      initiation_age_interval: integer,
      job_class: jmt$job_class,
      job_priority: jmt$job_priority,
      max_queued_dispatching_prio: jmt$dispatching_priority,
      max_swapped_dispatching_prio: jmt$dispatching_priority,
      maximum_queued_job_priority: jmt$job_priority,
      maximum_swapped_job_priority: jmt$job_priority,
      queue_type: jmt$phases,
      sc_ijle_p: ^jmt$initiated_job_list_entry,
      sc_ijlo: jmt$ijl_ordinal,
      service_class: jmt$service_class_index;

    max_queued_dispatching_prio := jmc$null_dispatching_priority;
    max_swapped_dispatching_prio := jmc$null_dispatching_priority;
    maximum_swapped_job_priority := 0;
    maximum_queued_job_priority := 0;
    none_left := FALSE;

    IF examine_input_queue AND jmv$refresh_job_candidates THEN
      jmp$refresh_job_candidates;
    IFEND;

    { Retrieve the highest priority candidate among the queued jobs.

    FOR job_class := jmc$system_job_class TO jmv$maximum_job_class_in_use DO
      IF jmv$candidate_queued_jobs [job_class].candidate_available AND
            NOT (jmv$job_class_table_p^ [job_class].initial_service_class_index IN
            activation_violation_classes) THEN
        dispatching_priority := jmv$service_classes [jmv$job_class_table_p^ [job_class].
              initial_service_class_index]^.attributes.dispatching_control [jmc$min_dispatching_control].
              dispatching_priority;
        IF NOT jmv$idle_dispatching_controls.controls [dispatching_priority].blocked THEN
          initiation_age_interval := jmv$job_class_table_p^ [job_class].initiation_age_interval;
          IF initiation_age_interval <> jmc$unlimited_prio_age_interval THEN
            age_interval := (current_time - jmv$candidate_queued_jobs [job_class].job_submission_time) DIV
                  initiation_age_interval;
          ELSE
            age_interval := 0; { no aging
          IFEND;
          job_priority := age_interval * jmv$job_class_table_p^ [job_class].selection_priority.increment +
                jmv$job_class_table_p^ [job_class].selection_priority.initial;
          IF job_priority > jmv$job_class_table_p^ [job_class].selection_priority.maximum THEN
            job_priority := jmv$job_class_table_p^ [job_class].selection_priority.maximum;
          IFEND;
          IF (dispatching_priority > max_queued_dispatching_prio) OR
                ((dispatching_priority = max_queued_dispatching_prio) AND
                (job_priority > maximum_queued_job_priority)) THEN
            best_queued_node.dispatching_priority := dispatching_priority;
            best_queued_node.priority := job_priority;
            best_queued_node.ws := jmv$job_class_table_p^ [job_class].initial_working_set;
            best_queued_node.qtype := queued_thd;
            best_queued_node.job_class := job_class;
            max_queued_dispatching_prio := dispatching_priority;
            maximum_queued_job_priority := job_priority;
            best_queued_class := jmv$job_class_table_p^ [job_class].initial_service_class_index;
          IFEND;
        IFEND;
      IFEND;
    FOREND;

    { Retrieve the highest priority candidate among the swapped jobs.

    FOR service_class := jmc$system_service_class TO jmv$max_service_class_in_use DO
      sc_ijlo := jmv$swapin_candidate_queue [service_class].swapin_candidate_queue;
      IF (sc_ijlo <> jmv$system_ijl_ordinal) AND
            NOT (service_class IN activation_violation_classes) THEN
        sc_ijle_p := jmf$ijle_p (sc_ijlo);
        dispatching_priority := sc_ijle_p^.scheduling_dispatching_priority;
        IF NOT jmv$idle_dispatching_controls.controls [dispatching_priority].blocked THEN
          jmp$adjust_swapin_cand_prio (sc_ijlo, current_time);
          IF (dispatching_priority > max_swapped_dispatching_prio) OR
                ((dispatching_priority = max_swapped_dispatching_prio) AND
                (sc_ijle_p^.job_scheduler_data.priority > maximum_swapped_job_priority)) THEN
            best_swapped_node.qtype := swapped;
            best_swapped_node.dispatching_priority := dispatching_priority;
            best_swapped_node.priority := sc_ijle_p^.job_scheduler_data.priority;
            best_swapped_node.ws := sc_ijle_p^.swap_data.swapped_job_page_count;
            best_swapped_node.ijl_ord := jmv$swapin_candidate_queue [service_class].swapin_candidate_queue;
            max_swapped_dispatching_prio := dispatching_priority;
            maximum_swapped_job_priority := sc_ijle_p^.job_scheduler_data.priority;
            best_swapped_class := service_class;
          IFEND;
        IFEND;
      IFEND;
    FOREND;

    { Pick the highest priority candidate among the highest queued job and the highest swapped job.

    IF (maximum_queued_job_priority = 0) AND (maximum_swapped_job_priority = 0) THEN
      none_left := TRUE;
      RETURN;
    ELSEIF (max_queued_dispatching_prio > max_swapped_dispatching_prio) OR
          ((max_queued_dispatching_prio = max_swapped_dispatching_prio) AND
          (maximum_queued_job_priority >= maximum_swapped_job_priority)) THEN
      best_node := best_queued_node;
      best_class := best_queued_class;
    ELSE
      best_node := best_swapped_node;
      best_class := best_swapped_class;
    IFEND;

  PROCEND select_highest_priority;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] jmp$process_activate_job', EJECT ??

  PROCEDURE [XDCL, #GATE] jmp$process_activate_job;

    VAR
      approaching_thrashing: boolean,
      current_time: jmt$clock_time,
      examine_input_queue: boolean;

    jmv$total_pageable_pages := mmv$reassignable_page_frames.now + mmv$reassignable_page_frames.soon;

    approaching_thrashing := (jmv$total_pageable_pages < jmv$job_scheduler_table.scheduling_memory_levels.
          thrashing);

    IF approaching_thrashing THEN
      jmp$incr_scheduler_statistics (jmc$thrashing_in_activate_jobs);
      jmp$set_sched_thrashing_event;
    ELSE

      examine_input_queue := jmv$job_scheduler_event [jmc$examine_input_queue];
      jmp$reset_activate_events_sels;
      current_time := #FREE_RUNNING_CLOCK (0);

      IF NOT jmv$prevent_activation_of_jobs THEN

        IF jmv$job_scheduler_event [jmc$ready_task_in_job] THEN
          jmp$find_and_insert_swapin_cand (current_time);
        IFEND;

        activate_jobs (examine_input_queue, current_time);

        jmp$reset_activate_event;
      IFEND;
    IFEND;

  PROCEND jmp$process_activate_job;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] jmp$process_thrashing', EJECT ??

  PROCEDURE [XDCL, #GATE] jmp$process_thrashing;

    VAR
      class_index: jmt$service_class_index,
      current_memory: integer,
      node: jmt$node,
      none_left: boolean,
      reason: jmt$swapout_reasons,
      swap_status: ost$status,
      working_set_size: integer;

    jmp$clear_scheduler_event (jmc$system_is_thrashing);

    current_memory := mmv$reassignable_page_frames.now + mmv$reassignable_page_frames.soon;

  /pick_thrashing_candidate/
    WHILE (current_memory < mmv$resident_job_target) DO

      { Select a candidate to swap.

      jmp$select_job_for_thrashing (node, class_index, working_set_size, none_left);
      IF none_left THEN
        jmp$incr_scheduler_statistics (jmc$exit_thrashing_none_to_swap);
        EXIT /pick_thrashing_candidate/;
      IFEND;

      reason := jmc$sr_thrashing;
      jmp$perform_physical_swapout (node, reason, class_index, 0, swap_status);
      IF swap_status.normal THEN
        current_memory := current_memory + node.ws;
      IFEND;
    WHILEND /pick_thrashing_candidate/;

    jmp$select_scheduler_short_wait;

  PROCEND jmp$process_thrashing;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] jmp$swap_job_for_memory_reserve', EJECT ??

  PROCEDURE [XDCL, #GATE] jmp$swap_job_for_memory_reserve;

    VAR
      class: jmt$service_class_index,
      ijl_bi: jmt$ijl_block_index,
      ijl_bn: jmt$ijl_block_number,
      ijle_p: ^jmt$initiated_job_list_entry,
      ijlo: jmt$ijl_ordinal,
      node: jmt$node,
      reason: jmt$swapout_reasons,
      status: ost$status;

    jmp$clear_scheduler_event (jmc$swap_job_for_memory_reserve);

  /search_for_job/
    FOR ijl_bn := LOWERBOUND (jmv$ijl_p.block_p^) TO jmv$ijl_p.max_block_in_use DO
      IF jmv$ijl_p.block_p^ [ijl_bn].index_p <> NIL THEN
        FOR ijl_bi := LOWERVALUE (jmt$ijl_block_index) TO UPPERVALUE (jmt$ijl_block_index) DO
          ijle_p := ^jmv$ijl_p.block_p^ [ijl_bn].index_p^ [ijl_bi];
          IF ijle_p^.memory_reserve_request.swapout_job THEN
            ijlo.block_number := ijl_bn;
            ijlo.block_index := ijl_bi;
            jmp$clear_memory_res_swap_field (ijlo);
            IF (ijle_p^.entry_status = jmc$ies_job_in_memory) THEN
              node.qtype := active;
              node.ijl_ord := ijlo;
              class := ijle_p^.job_scheduler_data.service_class;
              reason := jmc$sr_memory_reserve_request;
              jmp$perform_physical_swapout (node, reason, class, 0, status);
            IFEND;
          IFEND;
        FOREND;
      IFEND;
    FOREND /search_for_job/;

  PROCEND jmp$swap_job_for_memory_reserve;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] jmp$swap_jobs_for_lower_maxaj', EJECT ??

  PROCEDURE [XDCL, #GATE] jmp$swap_jobs_for_lower_maxaj;

    VAR
      class: jmt$service_class_index,
      class_still_over_limit: boolean,
      excess_active_jobs: integer,
      status: ost$status,
      swap_node: jmt$node;

    build_lower_maxaj_swap_queue;

    class_still_over_limit := FALSE;

    FOR class := jmc$system_service_class TO jmv$max_service_class_in_use DO

      IF jmv$service_classes [class] <> NIL THEN

        excess_active_jobs := jmv$job_counts.service_class_counts [class].scheduler_initiated_jobs -
              jmv$job_counts.service_class_counts [class].swapped_jobs;

      /swapout_jobs/
        WHILE (excess_active_jobs > jmv$service_classes [class]^.attributes.maximum_active_jobs) DO

          { The system job (ajl and ijl = 0) is not initiated by scheduler; therefore it is not counted in the
          { scheduler_initiated_jobs count.  While scheduler_initiatied_jobs is used, the above while loop
          { is okay; if initiated jobs is ever used the following if condition must be checked because the
          { system job cannot be  swapped out. (ie, there will always be 1 system class job active)

          {  IF (class = jmc$system_service_class) AND (excess_active_jobs = 1) THEN
          {    EXIT /swapout_jobs/;
          {  IFEND;

          IF v$active_job_queue_header [class] > 0 THEN
            swap_node := v$active_job_queue_p^ [v$active_job_queue_header [class]].node;
            jmp$perform_physical_swapout (swap_node, jmc$sr_lower_priority, class, 0, status);
            excess_active_jobs := excess_active_jobs - 1;
            delete_active_job_from_q (v$active_job_queue_header [class], class);
          ELSE
            class_still_over_limit := TRUE;
            EXIT /swapout_jobs/;
          IFEND;
        WHILEND /swapout_jobs/;
      IFEND;
    FOREND;

    IF NOT class_still_over_limit THEN
      jmp$clear_scheduler_event (jmc$swap_jobs_for_lower_maxaj);
    IFEND; { Else the event stays set to be processed when scheduler runs again. }

  PROCEND jmp$swap_jobs_for_lower_maxaj;
?? OLDTITLE ??
?? NEWTITLE := 'build_lower_maxaj_swap_queue', EJECT ??

  PROCEDURE build_lower_maxaj_swap_queue;

    VAR
      ajl_index: jmt$ajl_ordinal,
      class: jmt$service_class_index,
      ijl_ord: jmt$ijl_ordinal,
      ijl_p: ^jmt$initiated_job_list_entry,
      index: jmt$active_job_queue_range,
      job_memory: 0 .. osc$max_page_frames,
      temp_node: jmt$node;

    FOR class := jmc$system_service_class TO jmv$max_service_class_in_use DO
      v$active_job_queue_header [class] := 0;
    FOREND;

    v$active_job_queue_free_index := LOWERBOUND (v$active_job_queue_p^);
    v$preemptable_memory := 0;

  /build_active_job_queue/
    FOR ajl_index := LOWERBOUND (jmv$ajl_p^) TO jmv$max_ajl_ordinal_in_use DO
      IF (jmv$ajl_p^ [ajl_index].in_use <> 0) AND (ajl_index <> jmv$system_ajl_ordinal) THEN
        ijl_ord := jmv$ajl_p^ [ajl_index].ijl_ordinal;
        ijl_p := jmf$ijle_p (ijl_ord);
        IF ijl_p^.ajl_ordinal = ajl_index THEN
          IF ijl_p^.entry_status = jmc$ies_job_in_memory THEN
            class := ijl_p^.job_scheduler_data.service_class;
            temp_node.qtype := active;
            temp_node.ijl_ord := ijl_ord;
            temp_node.dispatching_priority := ijl_p^.scheduling_dispatching_priority;
            temp_node.priority := ijl_p^.job_scheduler_data.priority;
            temp_node.service_since_swap := ijl_p^.job_scheduler_data.service_accumulator_since_swap;
            jmp$compute_total_memory_used (ijl_p, job_memory);
            temp_node.ws := job_memory;
            insert_active_job_in_queue (temp_node, class);
            v$preemptable_memory := v$preemptable_memory + job_memory;
          IFEND;
        IFEND;
      IFEND;
    FOREND /build_active_job_queue/;

  PROCEND build_lower_maxaj_swap_queue;
?? OLDTITLE ??
?? NEWTITLE := 'build_active_job_queues', EJECT ??

{ PURPOSE:
{   This procedure is used to build a queue of possible preemption (swapout) candidates.
{ DESIGN:
{   All jobs that have a lower dispatching priority than the highest priority swapin candidate
{   or that have an equal dispatching priority and have exceeded guaranteed service and have a
{   lower or equal scheduling priority than the highest priority swapin candidate are queued.

  PROCEDURE build_active_job_queues
    (    highest_priority_swapin_node: jmt$node);

    VAR
      ajl_index: jmt$ajl_ordinal,
      class: jmt$service_class_index,
      class_gsq: jmt$service_accumulator,
      ijl_ord: jmt$ijl_ordinal,
      ijl_p: ^jmt$initiated_job_list_entry,
      index: jmt$active_job_queue_range,
      job_memory: 0 .. osc$max_page_frames,
      temp_node: jmt$node;

    FOR class := jmc$system_service_class TO jmv$max_service_class_in_use DO
      v$active_job_queue_header [class] := 0;
    FOREND;

    v$active_job_queue_free_index := LOWERBOUND (v$active_job_queue_p^);
    v$preemptable_memory := 0;

  /build_active_job_queue/
    FOR ajl_index := LOWERBOUND (jmv$ajl_p^) TO jmv$max_ajl_ordinal_in_use DO
      IF (jmv$ajl_p^ [ajl_index].in_use <> 0) AND (ajl_index <> jmv$system_ajl_ordinal) THEN
        ijl_ord := jmv$ajl_p^ [ajl_index].ijl_ordinal;
        ijl_p := jmf$ijle_p (ijl_ord);
        IF ijl_p^.ajl_ordinal = ajl_index THEN
          IF ijl_p^.entry_status = jmc$ies_job_in_memory THEN
            class := ijl_p^.job_scheduler_data.service_class;
            IF ijl_p^.scheduling_dispatching_priority > highest_priority_swapin_node.dispatching_priority THEN
              CYCLE /build_active_job_queue/;
            ELSEIF ijl_p^.scheduling_dispatching_priority = highest_priority_swapin_node.
                  dispatching_priority THEN
              class_gsq := jmv$service_classes [class]^.attributes.guaranteed_service_quantum;
              IF (ijl_p^.job_scheduler_data.service_accumulator_since_swap < class_gsq) OR
                    (ijl_p^.job_scheduler_data.priority > highest_priority_swapin_node.priority) OR
                    (class_gsq = jmc$unlimited_service_accum) THEN
                CYCLE /build_active_job_queue/;
              IFEND;
            IFEND;
            temp_node.qtype := active;
            temp_node.ijl_ord := ijl_ord;
            temp_node.dispatching_priority := ijl_p^.scheduling_dispatching_priority;
            temp_node.priority := ijl_p^.job_scheduler_data.priority;
            temp_node.service_since_swap := ijl_p^.job_scheduler_data.service_accumulator_since_swap;
            jmp$compute_total_memory_used (ijl_p, job_memory);
            temp_node.ws := job_memory;
            insert_active_job_in_queue (temp_node, class);
            v$preemptable_memory := v$preemptable_memory + job_memory;
          IFEND;
        IFEND;
      IFEND;
    FOREND /build_active_job_queue/;

  PROCEND build_active_job_queues;
?? OLDTITLE ??
?? NEWTITLE := 'insert_active_job_in_queue', EJECT ??

{ PURPOSE:
{   This procedure is used to insert jobs into the active job queue.
{ DESIGN:
{   Determine where the new node belongs in the queue.  Lowest dispatching priority jobs are queued
{   first.  If jobs have equal dispatching priority, the one with the lower scheduling priority is
{   queued first. If jobs have equal scheduling priority as well as equal dispatching priority, the
{   one that has used the most service is queued first.

  PROCEDURE insert_active_job_in_queue
    (    new_node: jmt$node;
         class: jmt$service_class_index);

    VAR
      current_index: jmt$active_job_queue_range,
      next_index: jmt$active_job_queue_range,
      new_node_index: jmt$active_job_queue_range,
      status: ost$status;

    new_node_index := v$active_job_queue_free_index;
    v$active_job_queue_free_index := v$active_job_queue_free_index + 1;
    v$active_job_queue_p^ [new_node_index].node := new_node;

    current_index := jmc$null_active_job_queue_link;
    next_index := v$active_job_queue_header [class];

  /find_place_in_queue/
    WHILE next_index <> jmc$null_active_job_queue_link DO
      IF new_node.dispatching_priority > v$active_job_queue_p^ [next_index].node.dispatching_priority THEN
        current_index := next_index;
        next_index := v$active_job_queue_p^ [next_index].link;

      ELSEIF new_node.dispatching_priority = v$active_job_queue_p^ [next_index].node.dispatching_priority THEN
        IF new_node.priority > v$active_job_queue_p^ [next_index].node.priority THEN
          current_index := next_index;
          next_index := v$active_job_queue_p^ [next_index].link;

        ELSEIF new_node.priority < v$active_job_queue_p^ [next_index].node.priority THEN
          EXIT /find_place_in_queue/;

        ELSE { new_node.priority = active queue node.priority }
          IF new_node.service_since_swap < v$active_job_queue_p^ [next_index].node.service_since_swap THEN
            current_index := next_index;
            next_index := v$active_job_queue_p^ [next_index].link;
          ELSE
            EXIT /find_place_in_queue/;
          IFEND;
        IFEND;
      ELSE { new_node.dispatching_priority < active queue node.dispatching_priority }
        EXIT /find_place_in_queue/;
      IFEND;

    WHILEND /find_place_in_queue/;

    IF current_index = jmc$null_active_job_queue_link THEN

      { Insertion is at the head of the queue

      v$active_job_queue_p^ [new_node_index].link := next_index;
      v$active_job_queue_header [class] := new_node_index;
    ELSE

      { Insertion is in the middle or end of the queue

      v$active_job_queue_p^ [current_index].link := new_node_index;
      v$active_job_queue_p^ [new_node_index].link := next_index;
    IFEND;

  PROCEND insert_active_job_in_queue;
?? OLDTITLE ??
?? NEWTITLE := 'delete_active_job_from_q', EJECT ??

  PROCEDURE delete_active_job_from_q
    (    delete_node_index: jmt$active_job_queue_range;
         class: jmt$service_class_index);

    VAR
      current_index: jmt$active_job_queue_range;

    IF (delete_node_index = v$active_job_queue_header [class]) THEN

      { Delete from the head of the queue

      v$active_job_queue_header [class] := v$active_job_queue_p^ [delete_node_index].link;
    ELSE

      { Delete from the middle or end of queue

      current_index := v$active_job_queue_header [class];

    /find_delete_node/
      WHILE (current_index <> delete_node_index) AND (current_index <> jmc$null_active_job_queue_link) DO
        IF v$active_job_queue_p^ [current_index].link = delete_node_index THEN
          v$active_job_queue_p^ [current_index].link := v$active_job_queue_p^ [delete_node_index].link;
          EXIT /find_delete_node/;
        IFEND;
        current_index := v$active_job_queue_p^ [current_index].link;
      WHILEND /find_delete_node/;
    IFEND;

  PROCEND delete_active_job_from_q;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] jmp$idling_swap_all_jobs', EJECT ??

  PROCEDURE [XDCL, #GATE] jmp$idling_swap_all_jobs;

    VAR
      ajl_index: jmt$ajl_ordinal,
      class: jmt$service_class_index,
      ignore_status: ost$status,
      ijl_ord: jmt$ijl_ordinal,
      ijl_p: ^jmt$initiated_job_list_entry,
      jobs_still_active: boolean,
      log_time: ost$time,
      msg: string (80),
      msg_len: integer,
      next_ijlo: jmt$ijl_ordinal,
      node: jmt$node,
      reason: jmt$swapout_reasons,
      request_block: jmt$rb_scheduler_requests,
      status: ost$status;

    { Clean out the job candidate queue.

    jmp$refresh_job_candidates;

    { Flush jobs in the long wait queue to disk.

    jmp$idle_advance_lw_jobs;

    { Initiate swapping out all jobs.

    jobs_still_active := FALSE;

    { Scan the ajl to find and swap all active jobs.

  /swap_active_jobs_loop/
    FOR ajl_index := LOWERBOUND (jmv$ajl_p^) TO jmv$max_ajl_ordinal_in_use DO
      IF (jmv$ajl_p^ [ajl_index].in_use <> 0) AND (ajl_index <> jmv$system_ajl_ordinal) THEN
        ijl_ord := jmv$ajl_p^ [ajl_index].ijl_ordinal;
        ijl_p := jmf$ijle_p (ijl_ord);
        IF ijl_p^.ajl_ordinal = ajl_index THEN
          IF ((ijl_p^.entry_status = jmc$ies_job_in_memory) OR
                (ijl_p^.entry_status = jmc$ies_swapin_in_progress)) AND NOT (ijl_p^.hung_task_in_job) THEN
            node.qtype := active;
            node.ijl_ord := ijl_ord;
            node.priority := ijl_p^.job_scheduler_data.priority;
            class := ijl_p^.job_scheduler_data.service_class;
            reason := jmc$sr_idling_system_swapout;
            jmp$perform_physical_swapout (node, reason, class, 0, status);
            jobs_still_active := TRUE;
          IFEND;
        IFEND;
      IFEND;
    FOREND /swap_active_jobs_loop/;

    { Check the swapping queues to be sure all jobs have been written to disk.

    IF (jsv$ijl_swap_queue_list [jsc$isqi_swapped_io_not_init].forward_link <> jmv$null_ijl_ordinal) OR
          (jsv$ijl_swap_queue_list [jsc$isqi_swapped_io_completed].forward_link <> jmv$null_ijl_ordinal) THEN

      IF (jsv$ijl_swap_queue_list [jsc$isqi_swapped_io_completed].forward_link <> jmv$null_ijl_ordinal) THEN
        request_block.reqcode := syc$rc_job_scheduler_request;
        request_block.sub_reqcode := jmc$src_idling_advance_swaps;
        i#call_monitor (#LOC (request_block), #SIZE (request_block));
      IFEND;
      jobs_still_active := TRUE;
      jmp$select_scheduler_short_wait;
    IFEND;

    next_ijlo := jsv$ijl_swap_queue_list [jsc$isqi_swapping].forward_link;

  /swap_queue_loop/
    WHILE next_ijlo <> jmv$null_ijl_ordinal DO
      ijl_p := jmf$ijle_p (next_ijlo);
      IF (ijl_p^.swap_status = jmc$iss_job_allocate_swap_file) AND
            ((#FREE_RUNNING_CLOCK (0) - ijl_p^.swap_data.timestamp) > 30000000) THEN
        IF NOT ijl_p^.unable_to_swap_idle_flag THEN
          STRINGREP (msg, msg_len, 'Job recovery disabled; unable to swap job: ',
                ijl_p^.system_supplied_name);
          lgp$add_entry_to_system_log (pmc$msg_origin_system, msg, log_time, status);
          dmp$set_eoi (ijl_p^.swap_data.swap_file_sfid, 0, status);
          jmp$set_unable_to_swap_flag (ijl_ord);
          dpp$put_critical_message (msg (1, msg_len), status);
          syp$disable_job_recovery;
          next_ijlo := ijl_p^.swap_queue_link.forward_link;
        ELSE
          next_ijlo := ijl_p^.swap_queue_link.forward_link;
        IFEND;
      ELSEIF NOT (ijl_p^.hung_task_in_job) THEN
        jobs_still_active := TRUE;
        jmp$select_scheduler_short_wait;
        EXIT /swap_queue_loop/;
      ELSE
        next_ijlo := ijl_p^.swap_queue_link.forward_link;
      IFEND;
    WHILEND /swap_queue_loop/;

    IF NOT jobs_still_active THEN

      { Update swapfiles in the swapped out queue with lastest IJL information, monitor and system flags from
      { the PTL, and mainframe linked signals in case we need to do a job recovery deadstart after the idle.

      next_ijlo := jsv$ijl_swap_queue_list [jsc$isqi_swapped_out].forward_link;
      WHILE next_ijlo <> jmv$null_ijl_ordinal DO
        ijl_p := jmf$ijle_p (next_ijlo);
        jmp$idling_swapfile_update (next_ijlo, status);
        IF NOT status.normal THEN
          osp$generate_log_message ($pmt$ascii_logset [pmc$system_log], status, ignore_status);
          STRINGREP (msg, msg_len, 'Job recovery disabled; swapfile not updated: ',
                ijl_p^.system_supplied_name);
          lgp$add_entry_to_system_log (pmc$msg_origin_system, msg, log_time, ignore_status);
          dpp$put_critical_message (msg (1, msg_len), ignore_status);
          syp$disable_job_recovery;
        IFEND;
        next_ijlo := ijl_p^.swap_queue_link.forward_link;
      WHILEND;
      jmp$set_all_jobs_swapped_var;
      jmp$clear_scheduler_event (jmc$system_is_idling);
    IFEND;

  PROCEND jmp$idling_swap_all_jobs;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] jmp$initialize_sched_ring_2', EJECT ??

{ PURPOSE:
{   This procedure allocates space for the active job queue.

  PROCEDURE [XDCL, #GATE] jmp$initialize_sched_ring_2;

    ALLOCATE v$active_job_queue_p: [1 .. mtv$mx_ajl_entries] IN osv$job_pageable_heap^;

  PROCEND jmp$initialize_sched_ring_2;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] jmp$select_reset_disp_pr_r2', EJECT ??

*copy jmh$select_reset_disp_pr_r2

  PROCEDURE [XDCL, #GATE] jmp$select_reset_disp_pr_r2;

    VAR
      ignore_status: ost$status,
      null_dispatching_info: jmt$dispatching_control_info;

    IF jmv$jcb.system_name = jmv$system_job_ssn THEN
      RETURN;
    IFEND;
    IF jmv$jcb.ijle_p^.interactive_task_gtid <> tmv$null_global_task_id THEN
      jmp$change_dispatching_prior_r1 (tmc$cpo_interactive_command, jmv$jcb.ijl_ordinal, jmv$jcb.system_name,
        null_dispatching_info, ignore_status);
    ELSE
      jmp$select_reset_disp_pr;
    IFEND;

  PROCEND jmp$select_reset_disp_pr_r2;
?? OLDTITLE ??
MODEND jmm$job_scheduler_ring_2;
