?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Program Management : Program Services' ??
MODULE pmm$program_services;

{ PURPOSE:
{   This module contains the program service routines for:
{
{         170 os type,
{         mainframe attributes,
{         microsecond clock,
{         os build_level,
{         os version,
{         processor attributes,
{         readying tasks,
{         task cp time

?? NEWTITLE := 'Global Declarations Referenced by this Module', EJECT ??
*IF NOT $true(osv$unix)
?? PUSH (LISTEXT := ON) ??
*copyc osc$processor_defined_registers
*copyc oss$mainframe_pageable
*copyc oss$mainframe_paged_literal
*copyc ost$170_os_type
*copyc ost$hardware_subranges
*copyc ost$page_size
*copyc ost$processor_element_id
*IFEND
*copyc ost$status
*IF NOT $true(osv$unix)
*copyc pme$unknown_recipient_task
*copyc pme$program_services_exceptions
*copyc pmt$binary_cpu_attributes
*copyc pmt$binary_mainframe_id
*copyc pmt$cpu_attributes
*copyc pmt$mainframe_attributes
*copyc pmt$mainframe_id
*copyc pmt$os_name
*copyc pmt$processor_attributes
*copyc pmt$processor_model_number
*copyc pmt$processor_model_type
*copyc pmt$processor_serial_number
*copyc pmt$task_cp_time
*copyc pmt$task_jobmode_statistics
*copyc pmt$vector_capability
*copyc pmt$vector_degrade_state
*copyc pmt$vector_simulation
*copyc tmt$rb_fetch_task_statistics
*copyc tmt$rb_ready_task
?? POP ??
*copyc clp$convert_integer_to_rjstring
*copyc clp$trimmed_string_size
*copyc i#call_monitor
*copyc i#disable_traps
*copyc i#restore_traps
*copyc osp$get_cpu_model_definition
*copyc osp$get_global_cpu_model_def
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$find_executing_task_xcb
?? EJECT ??
*copyc mtv$cst0
*copyc mtv$scb
*copyc osv$170_os_type
*copyc osv$build_level
*IFEND
*copyc osv$os_defaults
*IF NOT $true(osv$unix)
*copyc pmv$cpu_data
*copyc pmv$mainframe_id
*IFEND
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    c$system_underscore = '$SYSTEM_',
    c$underscore = '_';

*IF NOT $true(osv$unix)
  TYPE
    t$mainframe_id_mask = RECORD
      CASE boolean OF
      = TRUE =
        mainframe_id: pmt$mainframe_id,
      = FALSE =
        dollar_system_underscore: string (8),
        model_number: string (pmc$processor_model_number_size),
        underscore: string (1),
        serial_number: string (pmc$processor_serial_num_size),
      CASEND,
    RECEND;
?? EJECT ??
  VAR
    v$digits: [STATIC, READ, oss$mainframe_paged_literal] SET OF char :=
          ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0'];

?? OLDTITLE ??
?? NEWTITLE := 'pmp$convert_binary_mainframe_id', EJECT ??
*copy pmh$convert_binary_mainframe_id

{ NOTE:
{   This procedure deals with the pseudo model number.

  PROCEDURE [XDCL, #GATE] pmp$convert_binary_mainframe_id
    (    binary_mainframe_id: pmt$binary_mainframe_id;
     VAR mainframe_id: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      definition_found: boolean,
      global_processor_model_def: ost$processor_model_definition,
      mainframe_id_converter: t$mainframe_id_mask,
      processor_model_definition: ost$processor_model_definition,
      search_data: ost$processor_search_data;

    status.normal := TRUE;

    mainframe_id_converter.dollar_system_underscore := c$system_underscore;
    mainframe_id_converter.underscore := c$underscore;
    clp$convert_integer_to_rjstring (binary_mainframe_id.serial_number, 16, FALSE, '0',
          mainframe_id_converter.serial_number, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    mainframe_id_converter.model_number := pmc$cyber_180_model_unknown;

    osp$get_global_cpu_model_def (global_processor_model_def);
    IF binary_mainframe_id.model_number = global_processor_model_def.pseudo_model_number THEN
      mainframe_id_converter.model_number (pmc$processor_model_number_size -
            clp$trimmed_string_size (global_processor_model_def.model_number_string) + 1, * ) :=
            global_processor_model_def.model_number_string;
    ELSE
      search_data.search_mode := osc$psm_by_pseudo_model_number;
      search_data.pseudo_model_number := binary_mainframe_id.model_number;
      osp$get_cpu_model_definition (search_data, definition_found, processor_model_definition);
      IF definition_found THEN
        mainframe_id_converter.model_number (pmc$processor_model_number_size -
              clp$trimmed_string_size (processor_model_definition.model_number_string) + 1, * ) :=
              processor_model_definition.model_number_string;
      IFEND;
    IFEND;
    mainframe_id := mainframe_id_converter.mainframe_id;

  PROCEND pmp$convert_binary_mainframe_id;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$convert_mainframe_to_binary', EJECT ??
*copy pmh$convert_mainframe_to_binary

{ NOTE:
{   This procedure deals with the pseudo model number.

  PROCEDURE [XDCL, #GATE] pmp$convert_mainframe_to_binary
    (    mainframe_id: pmt$mainframe_id;
     VAR binary_mainframe_id: pmt$binary_mainframe_id;
     VAR status: ost$status);

    TYPE
      t$serial_number_conversion = RECORD
        CASE boolean OF
        = TRUE =
          serial_number: ost$processor_serial_number,
        = FALSE =
          serial_number_array: PACKED ARRAY [1 .. pmc$processor_serial_num_size] OF 0 .. 0f(16),
        CASEND,
      RECEND;

    VAR
      converter: t$serial_number_conversion,
      definition_found: boolean,
      global_processor_model_def: ost$processor_model_definition,
      mainframe_id_converter: t$mainframe_id_mask,
      model_index: 1 .. pmc$processor_model_number_size - 1,
      model_number: string (pmc$processor_model_number_size),
      processor_model_definition: ost$processor_model_definition,
      search_data: ost$processor_search_data,
      serial_number_index: 1 .. pmc$processor_serial_num_size;

    status.normal := TRUE;

    mainframe_id_converter.mainframe_id := mainframe_id;
    IF (mainframe_id_converter.dollar_system_underscore <> c$system_underscore) OR
          (mainframe_id_converter.underscore <> c$underscore) THEN
      osp$set_status_abnormal ('PM', pme$invalid_mainframe_id, mainframe_id, status);
      RETURN;
    IFEND;

    FOR serial_number_index := 1 TO pmc$processor_serial_num_size DO
      IF mainframe_id_converter.serial_number (serial_number_index) IN v$digits THEN
        converter.serial_number_array [serial_number_index] :=
              $INTEGER (mainframe_id_converter.serial_number (serial_number_index)) - $INTEGER ('0');
      ELSE
        osp$set_status_abnormal ('PM', pme$invalid_mainframe_id, mainframe_id, status);
        RETURN;
      IFEND;
    FOREND;
    binary_mainframe_id.serial_number := converter.serial_number;

    model_number := pmc$cyber_180_model_unknown;

  /extract_model_number_from_id/
    FOR model_index := 1 TO pmc$processor_model_number_size - 1 DO
      IF mainframe_id_converter.model_number (model_index) <> '0' THEN
        model_number := mainframe_id_converter.model_number
              (model_index, pmc$processor_model_number_size - model_index + 1);
        EXIT /extract_model_number_from_id/;
      IFEND;
    FOREND /extract_model_number_from_id/;

    binary_mainframe_id.model_number := osc$cyber_180_model_unknown;

    osp$get_global_cpu_model_def (global_processor_model_def);
    IF model_number = global_processor_model_def.model_number_string THEN
      binary_mainframe_id.model_number := global_processor_model_def.pseudo_model_number;
    ELSE
      search_data.search_mode := osc$psm_by_model_number_string;
      search_data.model_number_string := model_number;
      osp$get_cpu_model_definition (search_data, definition_found, processor_model_definition);
      IF definition_found THEN
        binary_mainframe_id.model_number := processor_model_definition.pseudo_model_number;
      IFEND;
    IFEND;

  PROCEND pmp$convert_mainframe_to_binary;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_170_os_type', EJECT ??
*copy pmh$get_170_os_type

  PROCEDURE [XDCL, #GATE] pmp$get_170_os_type
    (VAR os_type: ost$170_os_type;
     VAR status: ost$status);

    status.normal := TRUE;
    os_type := osv$170_os_type;

  PROCEND pmp$get_170_os_type;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_binary_cpu_attributes', EJECT ??
*copy pmh$get_binary_cpu_attributes

  PROCEDURE [XDCL, #GATE] pmp$get_binary_cpu_attributes
    (VAR cpu_attributes: pmt$binary_cpu_attributes;
     VAR status: ost$status);

    VAR
      index: 0 .. osc$maximum_processor_number;

    status.normal := TRUE;
    cpu_attributes := pmv$cpu_data.binary_attributes;

    FOR index := 0 TO pmv$cpu_data.binary_attributes.highest_defined_cpu_number DO
      cpu_attributes.cpu [index].processor_state := mtv$cst0 [index].processor_state;
    FOREND;

  PROCEND pmp$get_binary_cpu_attributes;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_binary_mainframe_id', EJECT ??
*copy pmh$get_binary_mainframe_id

  PROCEDURE [XDCL, #GATE] pmp$get_binary_mainframe_id
    (VAR mainframe_id: pmt$binary_mainframe_id;
     VAR status: ost$status);

    status.normal := TRUE;

    mainframe_id.model_number := pmv$cpu_data.binary_attributes.cpu [0].processor_element_id.model_number;
    mainframe_id.serial_number := pmv$cpu_data.binary_attributes.cpu [0].processor_element_id.serial_number;

  PROCEND pmp$get_binary_mainframe_id;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_binary_processor_id', EJECT ??
*copy pmh$get_binary_processor_id

  PROCEDURE [XDCL, #GATE, INLINE] pmp$get_binary_processor_id
    (VAR processor_element_id: ost$processor_element_id;
     VAR status: ost$status);

    TYPE
      t$conversion_mask = RECORD
        CASE boolean OF
        = TRUE =
          integer_value: integer,
        = FALSE =
          element_id: ost$processor_element_id,
        CASEND,
      RECEND;

    VAR
      converter: t$conversion_mask;

    status.normal := TRUE;

    converter.integer_value := #READ_REGISTER (osc$pr_element_id);
    processor_element_id := converter.element_id;

    { The following is a kludge for the S0 model 50(16).  This model must be translated to model 52(16).

    IF processor_element_id.model_number = 50(16) THEN
      processor_element_id.model_number := osc$cyber_180_model_9303;
    IFEND;

  PROCEND pmp$get_binary_processor_id;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_cpu_attributes', EJECT ??
*copy pmh$get_cpu_attributes

  PROCEDURE [XDCL, #GATE] pmp$get_cpu_attributes
    (VAR cpu_attributes: pmt$cpu_attributes;
     VAR status: ost$status);

    VAR
      index: 0 .. osc$maximum_processor_number;

    status.normal := TRUE;
    cpu_attributes := pmv$cpu_data.attributes;

    FOR index := 0 TO pmv$cpu_data.attributes.highest_defined_cpu_number DO
      IF mtv$cst0 [index].processor_state = cmc$on THEN
        cpu_attributes.cpu [index].state := pmc$processor_state_on;
      ELSEIF mtv$cst0 [index].processor_state = cmc$off THEN
        cpu_attributes.cpu [index].state := pmc$processor_state_off;
      ELSE
        cpu_attributes.cpu [index].state := pmc$processor_state_down;
      IFEND;
    FOREND;

  PROCEND pmp$get_cpu_attributes;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_mainframe_attributes', EJECT ??
*copy pmh$get_mainframe_attributes

  PROCEDURE [XDCL, #GATE] pmp$get_mainframe_attributes
    (VAR mainframe_attributes: pmt$mainframe_attributes;
     VAR status: ost$status);

    VAR
      cpu_index: 0 .. osc$maximum_processor_number,
      global_processor_model_def: ost$processor_model_definition,
      index: integer,
      page_size: ost$page_size;

    status.normal := TRUE;
    osp$get_global_cpu_model_def (global_processor_model_def);

    FOR index := 1 TO UPPERBOUND (mainframe_attributes) DO
      CASE mainframe_attributes [index].key OF
      = pmc$mak_active_processors =
        mainframe_attributes [index].active_processors := 0;
        FOR cpu_index := 0 TO pmv$cpu_data.binary_attributes.highest_defined_cpu_number DO
          IF mtv$cst0 [cpu_index].processor_state = cmc$on THEN
            mainframe_attributes [index].active_processors :=
                  mainframe_attributes [index].active_processors + 1;
          IFEND;
        FOREND;

      = pmc$mak_microsecond_clock =
        mainframe_attributes [index].microsecond_clock := #FREE_RUNNING_CLOCK (0);

      = pmc$mak_mainframe_identifier =
        mainframe_attributes [index].mainframe_identifier := pmv$mainframe_id;

      = pmc$mak_page_size =
        pmp$get_page_size (page_size, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        mainframe_attributes [index].page_size := page_size;

      = pmc$mak_total_processors =
        mainframe_attributes [index].total_processors :=
              pmv$cpu_data.binary_attributes.highest_defined_cpu_number + 1;

      = pmc$mak_vector_capability =
        mainframe_attributes [index].vector_capability := global_processor_model_def.vector_capability;

      = pmc$mak_vectors_degraded =
        mainframe_attributes [index].vectors_degraded :=
              (mtv$scb.vector_simulation_control.vector_divide_degraded <> $ost$processor_id_set []) OR
              (global_processor_model_def.vector_capability = pmc$no_vectors);

      = pmc$mak_vector_simulation =
        mainframe_attributes [index].vector_simulation :=
              mtv$scb.vector_simulation_control.vector_simulation_attribute;

      = pmc$mak_null_attribute =

      ELSE
        osp$set_status_abnormal ('PM', pme$invalid_attribute_key, 'PMP$GET_MAINFRAME_ATTRIBUTES', status);
      CASEND;
    FOREND;

  PROCEND pmp$get_mainframe_attributes;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_mainframe_id', EJECT ??
*copy pmh$get_mainframe_id

  PROCEDURE [XDCL, #GATE] pmp$get_mainframe_id
    (VAR mainframe_id: pmt$mainframe_id;
     VAR status: ost$status);

    status.normal := TRUE;
    mainframe_id := pmv$mainframe_id;

  PROCEND pmp$get_mainframe_id;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_microsecond_clock', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$get_microsecond_clock
    (VAR microsecond: integer;
     VAR status: ost$status);

    status.normal := TRUE;
    microsecond := #FREE_RUNNING_CLOCK (0);

  PROCEND pmp$get_microsecond_clock;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_os_build_level', EJECT ??
*copy pmh$get_os_build_level

  PROCEDURE [XDCL, #GATE] pmp$get_os_build_level
    (VAR build_level: pmt$os_name;
     VAR status: ost$status);

    status.normal := TRUE;
    build_level := osv$build_level (1, pmc$os_name_size);

  PROCEND pmp$get_os_build_level;
?? OLDTITLE ??
*IFEND
?? NEWTITLE := 'pmp$get_os_version', EJECT ??
*copy pmh$get_os_version

  PROCEDURE [XDCL, #GATE] pmp$get_os_version
    (VAR version: pmt$os_name;
     VAR status: ost$status);

    status.normal := TRUE;
    version := osv$os_defaults_os_name;

  PROCEND pmp$get_os_version;
*IF NOT $true(osv$unix)
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_page_size', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$get_page_size
    (VAR page_size: ost$page_size;
     VAR status: ost$status);

    { page size := (2**9) * (2**(u)) : u = number of right most 0's in 7 bit PSM register

    status.normal := TRUE;
    page_size := osc$min_page_size * (80(16) - #READ_REGISTER (osc$pr_page_size_mask));

  PROCEND pmp$get_page_size;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_processor_attributes', EJECT ??
*copy pmh$get_processor_attributes

  PROCEDURE [XDCL, #GATE] pmp$get_processor_attributes
    (VAR attributes: pmt$processor_attributes;
     VAR status: ost$status);

    VAR
      converter: RECORD
        CASE 0 .. 2 OF
        = 0 =
          intger: integer,
        = 1 =
          element_identifier: ost$processor_element_id,
        = 2 =
          packed_decimal: PACKED ARRAY [0 .. 15] OF 0 .. 0f(16),
        CASEND,
      RECEND,
      element_identifier: ost$processor_element_id;

    status.normal := TRUE;
    converter.intger := #READ_REGISTER (osc$pr_element_id);
    element_identifier := converter.element_identifier;

    CASE (element_identifier.model_number DIV 10(16)) OF
    = 1 =
      attributes.model_number := pmc$cpu_model_p1;

    = 2 =
      attributes.model_number := pmc$cpu_model_p2;

    = 3 =
      attributes.model_number := pmc$cpu_model_p3;

    = 4 =
      attributes.model_number := pmc$cpu_model_p4;

    ELSE
      attributes.model_number := pmc$cpu_model_p2; {default}
    CASEND;

    attributes.serial_number := converter.packed_decimal [15] + (converter.packed_decimal [14] *
          10) + (converter.packed_decimal [13] * 100) + (converter.packed_decimal [12] * 1000);

    { page size := (2**9) * (2**(u)) : u = number of right most 0's in 7 bit PSM register

    attributes.page_size := osc$min_page_size * (128 - #READ_REGISTER (osc$pr_page_size_mask));

  PROCEND pmp$get_processor_attributes;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_processor_id', EJECT ??
*copy pmh$get_processor_id

  PROCEDURE [XDCL, #GATE] pmp$get_processor_id
    (VAR model_type: pmt$processor_model_type;
     VAR model_number: pmt$processor_model_number;
     VAR serial_number: pmt$processor_serial_number;
     VAR status: ost$status);

    VAR
      cpu_index: 0 .. osc$maximum_processor_number,
      element_id: ost$processor_element_id;

    status.normal := TRUE;

    pmp$get_binary_processor_id (element_id, status);
    FOR cpu_index := 0 TO osc$maximum_processor_number DO
      IF element_id = pmv$cpu_data.binary_attributes.cpu [cpu_index].processor_element_id THEN
        model_type := pmv$cpu_data.attributes.cpu [cpu_index].model_type;
        model_number := pmv$cpu_data.attributes.cpu [cpu_index].model_number;
        serial_number := pmv$cpu_data.attributes.cpu [cpu_index].serial_number;
      IFEND;
    FOREND;

  PROCEND pmp$get_processor_id;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_pseudo_mainframe_id', EJECT ??

{ PURPOSE:
{   This procedure retrieves the binary representation of the value that uniquely
{   identifies the mainframe.  The pseudo binary model number is used.

  PROCEDURE [XDCL, #GATE] pmp$get_pseudo_mainframe_id
    (VAR mainframe_id: pmt$binary_mainframe_id);

    mainframe_id.model_number := pmv$cpu_data.pseudo_model_number [0];
    mainframe_id.serial_number := pmv$cpu_data.binary_attributes.cpu [0].processor_element_id.serial_number;

  PROCEND pmp$get_pseudo_mainframe_id;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_task_cp_time', EJECT ??
*copy pmh$get_task_cp_time

  PROCEDURE [XDCL, #GATE] pmp$get_task_cp_time
    (VAR cp_time: pmt$task_cp_time;
     VAR status: ost$status);

    VAR
      reqblk: tmt$rb_fetch_task_statistics;

    status.normal := TRUE;

    reqblk.reqcode := syc$rc_fetch_task_statistics;
    i#call_monitor (#LOC (reqblk), #SIZE (reqblk));
    cp_time.monitor_time := reqblk.monitor_cptime;
    cp_time.task_time := reqblk.job_cptime;

  PROCEND pmp$get_task_cp_time;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$get_task_jobmode_statistics', EJECT ??
*copy pmh$get_task_jobmode_statistics

{ NOTE: Any change made to this procedure should also be made to the procedure
{ PMP$GET_APD_TASK_JOBMODE_STATS.

  PROCEDURE [XDCL, #GATE, INLINE] pmp$get_task_jobmode_statistics
    (VAR jobmode_statistics: pmt$task_jobmode_statistics;
     VAR status: ost$status);

    VAR
      jobmode_cptime: integer,
      old_te: 0 .. 3,
      paging_statistics: ost$paging_statistics,
      xcb: ^ost$execution_control_block;

    status.normal := TRUE;

    i#disable_traps (old_te);
    pmp$find_executing_task_xcb (xcb);
    jobmode_cptime := xcb^.pit_count - #READ_REGISTER (osc$pr_process_interval_timer);
    paging_statistics := xcb^.paging_statistics;
    i#restore_traps (old_te);
    jobmode_statistics.jobmode_cptime := jobmode_cptime;
    jobmode_statistics.paging_statistics := paging_statistics;

  PROCEND pmp$get_task_jobmode_statistics;
?? OLDTITLE ??
?? NEWTITLE := 'pmp$ready_task', EJECT ??
*copy pmh$ready_task

  PROCEDURE [XDCL, #GATE] pmp$ready_task
    (    task: ost$global_task_id;
     VAR status: ost$status);

    VAR
      ready_task: tmt$rb_ready_task;

    status.normal := TRUE;

    ready_task.reqcode := syc$rc_ready_task;
    ready_task.task_id := task;

    i#call_monitor (#LOC (ready_task), #SIZE (ready_task));

    IF NOT ready_task.status.normal THEN
      osp$set_status_condition (pme$unknown_recipient_task, status);
    IFEND;

  PROCEND pmp$ready_task;
*IFEND
?? OLDTITLE ??
MODEND pmm$program_services;
