?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Numeric (Arithmetic) Operations' ??
MODULE clm$numeric_operations;

{
{ PURPOSE:
{   This module contains the procedures that perform various numeric
{   (arithmetic) operations.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$max_integer
*copyc clc$min_integer
*copyc cle$bad_data_value
*copyc cle$ecc_parsing
*copyc cle$unexpected_call_to
*copyc clt$data_value
*copyc clt$data_kinds
*copyc clt$parameter_list
*copyc clt$work_area
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*IF NOT $true(osv$unix)
*copyc clp$convert_integer_to_string
*copyc clp$convert_string_to_integer
*copyc clp$convert_real_to_string
*copyc clp$convert_string_to_real
*copyc clp$dtod
*copyc clp$dtoi
*copyc clp$evaluate_parameters
*copyc clp$itod
*copyc clp$itoi
*copyc clp$i_convert_string_to_integer
*copyc clp$longreal_classify
*copyc clp$longreal_compare
*copyc clp$longreal_compare_gt
*copyc clp$longreal_compare_le
*copyc clp$longreal_compare_ne
*copyc clp$make_boolean_value
*copyc clp$make_clt$integer_value
*copyc clp$make_clt$real_value
*copyc clp$make_integer_value
*copyc clp$make_real_value
*copyc clp$make_string_value
*copyc clv$max_integer_as_real
*copyc clv$max_real
*copyc clv$min_integer_as_real
*copyc clv$min_real
*copyc clv$negative_infinity
*copyc clv$positive_infinity
*copyc clv$real_one
*copyc clv$real_zero
*copyc mlp$convert_float_to_intege
*copyc mlp$convert_integer_to_float
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$append_status_real
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$continue_to_cause
?? TITLE := 'clp$$indefinite', EJECT ??

  PROCEDURE [XDCL] clp$$indefinite
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$indefinite) $indefinite (
{   real_number: real = $required
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$real_type_qualifier,
      recend,
    recend := [
    [1,
    [90, 4, 9, 14, 36, 49, 770],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$INDEFINITE'], [
    ['REAL_NUMBER                    ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 35, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$real_type],
    [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
    [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]]
    ]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$real_number = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      real_indefinite: boolean;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    real_indefinite := (clp$longreal_classify (pvt [p$real_number].value^.real_value.value) =
          clc$real_indefinite);
    clp$make_boolean_value (real_indefinite, clc$true_false_boolean, work_area, result);

  PROCEND clp$$indefinite;
?? TITLE := 'clp$$infinite', EJECT ??

  PROCEDURE [XDCL] clp$$infinite
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$infinite) $infinite (
{   real_number: real = $required
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$real_type_qualifier,
      recend,
    recend := [
    [1,
    [90, 4, 9, 14, 37, 2, 83],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$INFINITE'], [
    ['REAL_NUMBER                    ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 35, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$real_type],
    [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
    [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]]
    ]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$real_number = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      real_number_class: clt$real_number_class;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    real_number_class := clp$longreal_classify (pvt [p$real_number].value^.real_value.value);
    clp$make_boolean_value ((real_number_class = clc$real_positive_infinite) OR
          (real_number_class = clc$real_negative_infinite), clc$true_false_boolean, work_area, result);

  PROCEND clp$$infinite;
?? TITLE := 'clp$$infinity', EJECT ??

  PROCEDURE [XDCL] clp$$infinity
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$infinity) $infinity

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [90, 4, 9, 14, 37, 12, 251],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$INFINITY']];

?? FMT (FORMAT := ON) ??
?? POP ??

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_real_value (clv$positive_infinity^, clc$max_real_number_digits, work_area, result);

  PROCEND clp$$infinity;
?? TITLE := 'clp$$integer', EJECT ??

  PROCEDURE [XDCL] clp$$integer
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$integer) $integer (
{   source: any of
{       string
{       real
{       boolean
{       integer
{     anyend = $required
{   default_radix: integer 2..16 = 10
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$real_type_qualifier,
        recend,
        type_size_3: clt$type_specification_size,
        element_type_spec_3: record
          header: clt$type_specification_header,
        recend,
        type_size_4: clt$type_specification_size,
        element_type_spec_4: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
    recend := [
    [1,
    [90, 4, 9, 14, 37, 27, 61],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$INTEGER'], [
    ['DEFAULT_RADIX                  ',clc$nominal_entry, 2],
    ['SOURCE                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 94, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 2]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$boolean_type, clc$integer_type, clc$real_type,
    clc$string_type],
    TRUE, 4],
    8, [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
    35, [[1, 0, clc$real_type],
      [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
      [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]]
      ],
    3, [[1, 0, clc$boolean_type]],
    20, [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]]
    ],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [2, 16, 10],
    '10']];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$source = 1,
      p$default_radix = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      int_value: clt$integer,
      integer_value: integer,
      local_status: ost$status,
      real_value: clt$real;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE pvt [p$source].value^.kind OF
    = clc$boolean =
      IF pvt [p$source].value^.boolean_value.value THEN
        integer_value := 1;
      ELSE
        integer_value := 0;
      IFEND;
      clp$make_integer_value (integer_value, 10, FALSE, work_area, result);
    = clc$integer =
      result := pvt [p$source].value;
    = clc$real =
      clp$convert_real_to_integer (pvt [p$source].value^.real_value.value, integer_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$make_integer_value (integer_value, 10, FALSE, work_area, result);
    = clc$string =
      clp$i_convert_string_to_integer (pvt [p$source].value^.string_value^,
            pvt [p$default_radix].value^.integer_value.value, int_value, status);
      IF NOT status.normal THEN
        clp$convert_string_to_real (pvt [p$source].value^.string_value^, real_value, local_status);
        IF NOT local_status.normal THEN
          RETURN;
        IFEND;
        clp$convert_real_to_integer (real_value.value, int_value.value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      clp$make_clt$integer_value (int_value, work_area, result);
    ELSE
      ;
    CASEND;

  PROCEND clp$$integer;
?? TITLE := 'clp$$integer_string', EJECT ??

  PROCEDURE [XDCL] clp$$integer_string
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$integer_string) $integer_string (
{   integer: integer = $required
{   radix: integer 2..16 = 10
{   include_radix: boolean = no
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (2),
      recend,
    recend := [
    [1,
    [90, 4, 9, 14, 37, 50, 348],
    clc$function, 3, 3, 1, 0, 0, 0, 0, 'OSM$$INTEGER_STRING'], [
    ['INCLUDE_RADIX                  ',clc$nominal_entry, 3],
    ['INTEGER                        ',clc$nominal_entry, 1],
    ['RADIX                          ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 3
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 2]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [2, 16, 10],
    '10'],
{ PARAMETER 3
    [[1, 0, clc$boolean_type],
    'no']];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$integer = 1,
      p$radix = 2,
      p$include_radix = 3;

    VAR
      pvt: array [1 .. 3] of clt$parameter_value;

    VAR
      integer_string: ost$string;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$convert_integer_to_string (pvt [p$integer].value^.integer_value.value,
          pvt [p$radix].value^.integer_value.value, pvt [p$include_radix].value^.boolean_value.value,
          integer_string, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_string_value (integer_string.value (1, integer_string.size), work_area, result);

  PROCEND clp$$integer_string;
?? TITLE := 'clp$$max', EJECT ??

  PROCEDURE [XDCL] clp$$max
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$max) $max (
{   numbers: list rest of any of
{       integer
{       real
{     anyend = $required
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$real_type_qualifier,
          recend,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 10, 13, 54, 10, 886],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$MAX'], [
    ['NUMBERS                        ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 91, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [75, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$union_type], [[clc$integer_type, clc$real_type],
      TRUE, 2],
      20, [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
      35, [[1, 0, clc$real_type],
        [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
        [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]]
        ]
      ]
    ]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$numbers = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      node: ^clt$data_value;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    result := pvt [p$numbers].value^.element_value;
    node := pvt [p$numbers].value^.link;

    WHILE node <> NIL DO
      IF clp$number_compare (node^.element_value^, result^) = clc$left_is_greater THEN
        result := node^.element_value;
      IFEND;
      node := node^.link;
    WHILEND;

  PROCEND clp$$max;
?? TITLE := 'clp$$max_integer', EJECT ??

  PROCEDURE [XDCL] clp$$max_integer
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$max_integer) $max_integer

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [90, 4, 9, 14, 38, 2, 496],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$MAX_INTEGER']];

?? FMT (FORMAT := ON) ??
?? POP ??

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_integer_value (clc$max_integer, 10, FALSE, work_area, result);

  PROCEND clp$$max_integer;
?? TITLE := 'clp$$max_real', EJECT ??

  PROCEDURE [XDCL] clp$$max_real
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$max_real) $max_real

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [90, 4, 9, 14, 38, 19, 392],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$MAX_REAL']];

?? FMT (FORMAT := ON) ??
?? POP ??

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_real_value (clv$max_real^, clc$max_real_number_digits, work_area, result);

  PROCEND clp$$max_real;
?? TITLE := 'clp$$min', EJECT ??

  PROCEDURE [XDCL] clp$$min
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$min) $min (
{   numbers: list rest of any of
{       integer
{       real
{     anyend = $required
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$real_type_qualifier,
          recend,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 10, 13, 54, 34, 124],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$MIN'], [
    ['NUMBERS                        ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 91, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [75, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$union_type], [[clc$integer_type, clc$real_type],
      TRUE, 2],
      20, [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
      35, [[1, 0, clc$real_type],
        [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
        [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]]
        ]
      ]
    ]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$numbers = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      node: ^clt$data_value;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    result := pvt [p$numbers].value^.element_value;
    node := pvt [p$numbers].value^.link;

    WHILE node <> NIL DO
      IF clp$number_compare (node^.element_value^, result^) = clc$right_is_greater THEN
        result := node^.element_value;
      IFEND;
      node := node^.link;
    WHILEND;

  PROCEND clp$$min;
?? TITLE := 'clp$$min_integer', EJECT ??

  PROCEDURE [XDCL] clp$$min_integer
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$min_integer) $min_integer

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [90, 4, 9, 14, 40, 33, 457],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$MIN_INTEGER']];

?? FMT (FORMAT := ON) ??
?? POP ??

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_integer_value (clc$min_integer, 10, FALSE, work_area, result);

  PROCEND clp$$min_integer;
?? TITLE := 'clp$$min_real', EJECT ??

  PROCEDURE [XDCL] clp$$min_real
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$min_real) $min_real

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [90, 4, 9, 14, 40, 48, 471],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$MIN_REAL']];

?? FMT (FORMAT := ON) ??
?? POP ??

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_real_value (clv$min_real^, clc$max_real_number_digits, work_area, result);

  PROCEND clp$$min_real;
?? TITLE := 'clp$$mod', EJECT ??

  PROCEDURE [XDCL] clp$$mod
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$mod) $mod (
{   a: integer = $required
{   b: integer = $required
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
    recend := [
    [1,
    [90, 4, 9, 14, 40, 59, 716],
    clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$MOD'], [
    ['A                              ',clc$nominal_entry, 1],
    ['B                              ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$a = 1,
      p$b = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (pvt [p$b].value^.integer_value.value = 0) THEN
      osp$set_status_abnormal ('CL', cle$param_expr_not_union_type, pdt.
            names [p$b].name, status);
      osp$append_status_integer (osc$status_parameter_delimiter,
            pvt [p$b].value^.integer_value.value, 10, false, status);
      RETURN;
    IFEND;

    NEXT result IN work_area;

    clp$perform_numeric_operation ('$MOD', pvt [p$a].value^, pvt [p$b].value^, result^, status);

  PROCEND clp$$mod;
?? TITLE := 'clp$$real', EJECT ??

  PROCEDURE [XDCL] clp$$real
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$real) $real (
{   source: any of
{       string
{       integer
{       real
{     anyend = $required
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        type_size_3: clt$type_specification_size,
        element_type_spec_3: record
          header: clt$type_specification_header,
          qualifier: clt$real_type_qualifier,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 9, 14, 41, 54, 881],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$REAL'], [
    ['SOURCE                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 87, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$integer_type, clc$real_type, clc$string_type],
    TRUE, 3],
    8, [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
    20, [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
    35, [[1, 0, clc$real_type],
      [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
      [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]]
      ]
    ]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$source = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      int_value: clt$integer,
      local_status: ost$status,
      real_value: clt$real;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE pvt [p$source].value^.kind OF
    = clc$integer =
      clp$convert_integer_to_real (pvt [p$source].value^.integer_value.value, real_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$make_clt$real_value (real_value, work_area, result);
    = clc$real =
      result := pvt [p$source].value;
    = clc$string =
      clp$convert_string_to_real (pvt [p$source].value^.string_value^, real_value, status);
      IF NOT status.normal THEN
        clp$i_convert_string_to_integer (pvt [p$source].value^.string_value^, 10, int_value, local_status);
        IF NOT local_status.normal THEN
          RETURN;
        IFEND;
        clp$convert_integer_to_real (int_value.value, real_value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      clp$make_clt$real_value (real_value, work_area, result);
    ELSE
      ;
    CASEND;

  PROCEND clp$$real;
?? TITLE := 'clp$$real_string', EJECT ??

  PROCEDURE [XDCL] clp$$real_string
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$real_string) $real_string (
{   real_number: real = $required
{   max_digits: integer 1..28 = 28
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$real_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
    recend := [
    [1,
    [90, 4, 9, 14, 42, 4, 889],
    clc$function, 2, 2, 1, 0, 0, 0, 0, 'OSM$$REAL_STRING'], [
    ['MAX_DIGITS                     ',clc$nominal_entry, 2],
    ['REAL_NUMBER                    ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 35, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 2]],
{ PARAMETER 1
    [[1, 0, clc$real_type],
    [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
    [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]]
    ],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, 28, 10],
    '28']];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$real_number = 1,
      p$max_digits = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      real_string: ost$string;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$convert_real_to_string (pvt [p$real_number].value^.real_value.value,
          pvt [p$max_digits].value^.integer_value.value, real_string, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$make_string_value (real_string.value (1, real_string.size), work_area, result);

  PROCEND clp$$real_string;
?? TITLE := 'clp$$sum', EJECT ??

  PROCEDURE [XDCL] clp$$sum
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$sum) $sum (
{   numbers: list rest 0..clc$max_list_size of any of
{       integer
{       real
{     anyend = $required
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
            qualifier: clt$integer_type_qualifier,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$real_type_qualifier,
          recend,
        recend,
      recend,
    recend := [
    [1,
    [90, 4, 10, 13, 55, 14, 984],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$SUM'], [
    ['NUMBERS                        ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 91, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [75, 0, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$union_type], [[clc$integer_type, clc$real_type],
      TRUE, 2],
      20, [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
      35, [[1, 0, clc$real_type],
        [[{-$INFINITY} 3, [[0D000(16), 0(16)], [0D000(16), 0(16)]]],
        [{$INFINITY} 3, [[5000(16), 0(16)], [5000(16), 0(16)]]]]
        ]
      ]
    ]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$numbers = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      intermediate: clt$data_value,
      node: ^clt$data_value;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pvt [p$numbers].value^.element_value = NIL THEN
      clp$make_integer_value (0, 10, FALSE, work_area, result);
      RETURN;
    IFEND;

    NEXT result IN work_area;
    result^ := pvt [p$numbers].value^.element_value^;
    node := pvt [p$numbers].value^.link;

    WHILE node <> NIL DO
      intermediate := result^;
      clp$perform_numeric_operation ('+', intermediate, node^.element_value^, result^, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      node := node^.link;
    WHILEND;

  PROCEND clp$$sum;
?? TITLE := 'clp$convert_integer_to_real', EJECT ??

  PROCEDURE [XDCL] clp$convert_integer_to_real
    (    integer_number: integer;
     VAR real_number: clt$real;
     VAR status: ost$status);

    VAR
      ignore_conversion_status: mlt$error;

    VAR
      c: 0 .. clc$max_real_number_digits,
      d: -10 .. 10,
      n: integer;


    status.normal := TRUE;

    IF integer_number = clc$min_integer THEN
      real_number.value := clv$min_integer_as_real^;
    ELSE
      mlp$convert_integer_to_float (^integer_number, #SIZE (integer), mlc$signed_integer, ^real_number.value,
            mlc$double_precision, ignore_conversion_status);
    IFEND;

{ Count the number of decimal digits in the integer.

    n := integer_number;
    c := $INTEGER (n = 0);
    IF n < 0 THEN
      d := -10;
    ELSE
      d := 10;
    IFEND;
    WHILE n <> 0 DO
      n := n DIV d;
      c := c + 1;
    WHILEND;
    real_number.number_of_digits := c;

  PROCEND clp$convert_integer_to_real;
?? TITLE := 'clp$convert_real_to_integer', EJECT ??

  PROCEDURE [XDCL] clp$convert_real_to_integer
    (    real_number: longreal;
     VAR integer_number: integer;
     VAR status: ost$status);

    VAR
      ignore_conversion_status: mlt$error;


    status.normal := TRUE;

    CASE clp$longreal_compare (real_number, clv$min_integer_as_real^, clc$infinities_equal) OF

    = clc$equal =
      integer_number := clc$min_integer;

    = clc$right_is_greater, clc$unordered =
      osp$set_status_condition (cle$real_greater_than_integer, status);
      osp$append_status_real (osc$status_parameter_delimiter, real_number, clc$max_real_number_digits,
            status);
      RETURN;

    ELSE {clc$left_is_greater}

      IF clp$longreal_compare_gt (real_number, clv$max_integer_as_real^) THEN
        osp$set_status_condition (cle$real_greater_than_integer, status);
        osp$append_status_real (osc$status_parameter_delimiter, real_number, clc$max_real_number_digits,
              status);
        RETURN;
      IFEND;

      mlp$convert_float_to_integer (^real_number, mlc$double_precision, ^integer_number, #SIZE (integer),
            mlc$signed_integer, ignore_conversion_status);
    CASEND;

  PROCEND clp$convert_real_to_integer;
*ELSE
*copyc osp$set_status_abnormal
*copyc clt$comparison_result
*IFEND
?? TITLE := 'clp$number_compare', EJECT ??

  FUNCTION [XDCL] clp$number_compare
    (    left_operand: clt$data_value;
         right_operand: clt$data_value): clt$comparison_result;

    VAR
      left_real: clt$real,
      right_real: clt$real,
      status: ost$status;


    IF (left_operand.kind = clc$integer) AND (right_operand.kind = clc$integer) THEN
      IF left_operand.integer_value.value < right_operand.integer_value.value THEN
        clp$number_compare := clc$right_is_greater;
      ELSEIF left_operand.integer_value.value = right_operand.integer_value.value THEN
        clp$number_compare := clc$equal;
      ELSE
        clp$number_compare := clc$left_is_greater;
      IFEND;
      RETURN;
    IFEND;

*IF NOT $true(osv$unix)
    CASE left_operand.kind OF
    = clc$integer =
      clp$convert_integer_to_real (left_operand.integer_value.value, left_real, status);
      IF NOT status.normal THEN
        clp$number_compare := clc$unordered;
        RETURN;
      IFEND;
    = clc$real =
      left_real := left_operand.real_value;
    ELSE
*IFEND
      clp$number_compare := clc$unordered;
*IF NOT $true(osv$unix)
      RETURN;
    CASEND;

    CASE right_operand.kind OF
    = clc$integer =
      clp$convert_integer_to_real (right_operand.integer_value.value, right_real, status);
      IF NOT status.normal THEN
        clp$number_compare := clc$unordered;
        RETURN;
      IFEND;
    = clc$real =
      right_real := right_operand.real_value;
    ELSE
      clp$number_compare := clc$unordered;
      RETURN;
    CASEND;

    clp$number_compare := clp$longreal_compare (left_real.value, right_real.value, clc$infinities_unordered);
*IFEND

  FUNCEND clp$number_compare;
?? TITLE := 'clp$perform_numeric_operation', EJECT ??

  PROCEDURE [XDCL] clp$perform_numeric_operation
    (    operator: string ( * <= osc$max_name_size);
         left_operand: clt$data_value;
         right_operand: clt$data_value;
     VAR result: clt$data_value;
     VAR status: ost$status);

*IF NOT $true(osv$unix)
    TYPE
      clt$longreal_results_table = array [clt$real_number_class] of array [clt$real_number_class] of
            ^^longreal;

    VAR
      arithmetic_conditions: [STATIC, READ, oss$job_paged_literal] pmt$system_conditions :=
            [pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow, pmc$exponent_underflow,
            pmc$fp_significance_loss, pmc$fp_indefinite, pmc$arithmetic_significance],
      left_real: clt$real,
      operation_successful: boolean,
      result_table: ^clt$longreal_results_table,
      right_real: clt$real;

?? NEWTITLE := 'Tables of results for longreal operations that produce system conditions.', EJECT ??

{ The following variables are used to look up results for longreal arithmetic
{ operations when those operations produce system conditions.
{ A NIL table entry indicates the result is undefined (indefinite) and that an
{ error should be generated.
{ A non-NIL table entry should be used unless: 1) a divide fault occurred, in
{ which case the table entry should be treated as NIL, or 2) an underflow
{ condition occurred, in which case the result should be zero.

?? FMT (FORMAT := OFF) ??

    VAR
      longreal_add_error_results: [STATIC, READ, oss$job_paged_literal] clt$longreal_results_table := [

{    \ right    INDEFINITE              -INFINITY               -number    }
{left \         ZERO                    +number                 +INFINITY  }

{INDEFINITE}   [NIL,                    NIL,                    NIL,
                NIL,                    NIL,                    NIL],

{ -INFINITY}   [NIL,                    ^clv$negative_infinity, ^clv$negative_infinity,
                ^clv$negative_infinity, ^clv$negative_infinity, NIL],

{   -number}   [NIL,                    ^clv$negative_infinity, ^clv$negative_infinity,
                NIL,                    NIL,                    ^clv$positive_infinity],

{      ZERO}   [NIL,                    ^clv$negative_infinity, NIL,
                ^clv$real_zero,         NIL,                    ^clv$positive_infinity],

{   +number}   [NIL,                    ^clv$negative_infinity, NIL,
                NIL,                    ^clv$positive_infinity, ^clv$positive_infinity],

{ +INFINITY}   [NIL,                    NIL,                    ^clv$positive_infinity,
                ^clv$positive_infinity, ^clv$positive_infinity, ^clv$positive_infinity]];

?? EJECT ??

    VAR
      longreal_divide_error_results: [STATIC, READ, oss$job_paged_literal] clt$longreal_results_table := [

{    \ right    INDEFINITE              -INFINITY               -number    }
{left \         ZERO                    +number                 +INFINITY  }

{INDEFINITE}   [NIL,                    NIL,                    NIL,
                NIL,                    NIL,                    NIL],

{ -INFINITY}   [NIL,                    NIL,                    ^clv$positive_infinity,
                NIL,                    ^clv$negative_infinity, NIL],

{   -number}   [NIL,                    ^clv$real_zero,         ^clv$positive_infinity,
                NIL,                    ^clv$negative_infinity, ^clv$real_zero],

{      ZERO}   [NIL,                    ^clv$real_zero,         ^clv$real_zero,
                NIL,                    ^clv$real_zero,         ^clv$real_zero],

{   +number}   [NIL,                    ^clv$real_zero,         ^clv$negative_infinity,
                NIL,                    ^clv$positive_infinity, ^clv$real_zero],

{ +INFINITY}   [NIL,                    NIL,                    ^clv$negative_infinity,
                NIL,                    ^clv$positive_infinity, NIL]];

?? EJECT ??

    VAR
      longreal_exponent_error_results: [STATIC, READ, oss$job_paged_literal] clt$longreal_results_table := [

{    \ right    INDEFINITE              -INFINITY               -number    }
{left \         ZERO                    +number                 +INFINITY  }

{INDEFINITE}   [NIL,                    NIL,                    NIL,
                NIL,                    NIL,                    NIL],

{ -INFINITY}   [NIL,                    NIL,                    NIL,
                NIL,                    NIL,                    NIL],

{   -number}   [NIL,                    NIL,                    NIL,
                NIL,                    NIL,                    NIL],

{      ZERO}   [NIL,                    NIL,                    NIL,
                NIL,                    ^clv$real_zero,         NIL],

{   +number}   [NIL,                    ^clv$real_zero,         ^clv$real_zero,
                ^clv$real_one,          ^clv$positive_infinity, ^clv$positive_infinity],

{ +INFINITY}   [NIL,                    ^clv$real_zero,         ^clv$real_zero,
                NIL,                    ^clv$positive_infinity, ^clv$positive_infinity]];

?? EJECT ??

    VAR
      longreal_multiply_error_results: [STATIC, READ, oss$job_paged_literal] clt$longreal_results_table := [

{    \ right    INDEFINITE              -INFINITY               -number    }
{left \         ZERO                    +number                 +INFINITY  }

{INDEFINITE}   [NIL,                    NIL,                    NIL,
                NIL,                    NIL,                    NIL],

{ -INFINITY}   [NIL,                    ^clv$positive_infinity, ^clv$positive_infinity,
                NIL,                    ^clv$negative_infinity, ^clv$negative_infinity],

{   -number}   [NIL,                    ^clv$positive_infinity, ^clv$positive_infinity,
                ^clv$real_zero,         ^clv$negative_infinity, ^clv$negative_infinity],

{      ZERO}   [NIL,                    NIL,                    ^clv$real_zero,
                ^clv$real_zero,         ^clv$real_zero,         NIL],

{   +number}   [NIL,                    ^clv$negative_infinity, ^clv$negative_infinity,
                ^clv$real_zero,         ^clv$positive_infinity, ^clv$positive_infinity],

{ +INFINITY}   [NIL,                    ^clv$negative_infinity, ^clv$negative_infinity,
                NIL,                    ^clv$positive_infinity, ^clv$positive_infinity]];

?? EJECT ??

    VAR
      longreal_subtract_error_results: [STATIC, READ, oss$job_paged_literal] clt$longreal_results_table := [

{    \ right    INDEFINITE              -INFINITY               -number    }
{left \         ZERO                    +number                 +INFINITY  }

{INDEFINITE}   [NIL,                    NIL,                    NIL,
                NIL,                    NIL,                    NIL],

{ -INFINITY}   [NIL,                    NIL,                    ^clv$negative_infinity,
                ^clv$negative_infinity, ^clv$negative_infinity, ^clv$negative_infinity],

{   -number}   [NIL,                    ^clv$positive_infinity, NIL,
                NIL,                    ^clv$negative_infinity, ^clv$negative_infinity],

{      ZERO}   [NIL,                    ^clv$positive_infinity, NIL,
                ^clv$real_zero,         NIL,                    ^clv$negative_infinity],

{   +number}   [NIL,                    ^clv$positive_infinity, ^clv$positive_infinity,
                NIL,                    NIL,                    ^clv$negative_infinity],

{ +INFINITY}   [NIL,                    ^clv$positive_infinity, ^clv$positive_infinity,
                ^clv$positive_infinity, ^clv$positive_infinity, NIL]];

?? FMT (FORMAT := ON) ??
*IFEND
?? TITLE := 'bad_call', EJECT ??

    PROCEDURE [INLINE] bad_call;


      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$perform_numeric_operation', status);
      EXIT clp$perform_numeric_operation;

    PROCEND bad_call;
*IF NOT $true(osv$unix)
?? TITLE := 'convert_integer_value_to_real', EJECT ??

    PROCEDURE [INLINE] convert_integer_value_to_real
      (    integer_value: clt$data_value;
       VAR real_number: clt$real);


      clp$convert_integer_to_real (integer_value.integer_value.value, real_number, status);
      IF NOT status.normal THEN
        EXIT clp$perform_numeric_operation;
      IFEND;

    PROCEND convert_integer_value_to_real;
?? TITLE := 'perform_exponentiate', EJECT ??

    PROCEDURE perform_exponentiate;

      VAR
        comparison_result: clt$comparison_result,
        left_eq_zero: boolean,
        left_lt_zero: boolean,
        right_le_zero: boolean;

?? NEWTITLE := 'itoi', EJECT ??

      PROCEDURE itoi;

?? NEWTITLE := 'integer_arithmetic_cond_handler', EJECT ??

        PROCEDURE integer_arithmetic_cond_handler
          (    condition: pmt$condition;
               ignore_info: ^pmt$condition_information;
               save_area: ^ost$stack_frame_save_area;
           VAR handler_status: ost$status);


          IF (condition.selector = pmc$system_conditions) AND
                ((arithmetic_conditions * condition.system_conditions) <> $pmt$system_conditions []) THEN
            operation_successful := FALSE;
            EXIT itoi;
          IFEND;

          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

        PROCEND integer_arithmetic_cond_handler;
?? OLDTITLE, EJECT ??

        osp$establish_condition_handler (^integer_arithmetic_cond_handler, FALSE);

        result.kind := clc$integer;
        result.integer_value.value := clp$itoi (left_operand.integer_value.value,
              right_operand.integer_value.value);
        result.integer_value.radix := left_operand.integer_value.radix;
        result.integer_value.radix_specified := left_operand.integer_value.radix_specified;

        operation_successful := TRUE;

      PROCEND itoi;
?? TITLE := 'real_arithmetic_cond_handler', EJECT ??

      PROCEDURE real_arithmetic_cond_handler
        (    condition: pmt$condition;
             ignore_info: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR handler_status: ost$status);

        VAR
          error_result: ^longreal,
          left_class: clt$real_number_class,
          right_class: clt$real_number_class;

?? NEWTITLE := 'classify_integer_as_real', EJECT ??

        FUNCTION [INLINE] classify_integer_as_real
          (    integer_value: integer): clt$real_number_class;


          IF integer_value < 0 THEN
            classify_integer_as_real := clc$real_negative_standard;
          ELSEIF integer_value = 0 THEN
            classify_integer_as_real := clc$real_zero;
          ELSE {integer_value > 0}
            classify_integer_as_real := clc$real_positive_standard;
          IFEND;

        FUNCEND classify_integer_as_real;
?? OLDTITLE, EJECT ??

        IF (condition.selector = pmc$system_conditions) AND
              ((arithmetic_conditions * condition.system_conditions) <> $pmt$system_conditions []) THEN
          IF left_operand.kind = clc$integer THEN
            left_class := classify_integer_as_real (left_operand.integer_value.value);
          ELSE
            left_class := clp$longreal_classify (left_real.value);
          IFEND;
          IF right_operand.kind = clc$integer THEN
            right_class := classify_integer_as_real (right_operand.integer_value.value);
          ELSE
            right_class := clp$longreal_classify (right_real.value);
          IFEND;
          set_longreal_condition_result ($pmt$system_conditions [],
                longreal_exponent_error_results [left_class] [right_class], error_result);
          IF error_result = NIL THEN
            set_arithmetic_condition (operator, $pmt$system_conditions []);
            EXIT clp$perform_numeric_operation;
          IFEND;
          result.real_value.value := error_result^;
          EXIT perform_exponentiate;
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

      PROCEND real_arithmetic_cond_handler;
?? OLDTITLE, EJECT ??

      IF left_operand.kind = clc$real THEN
        left_real := left_operand.real_value;

      ELSEIF right_operand.kind = clc$integer THEN
        IF ((left_operand.integer_value.value = 0) AND (right_operand.integer_value.value <= 0)) OR
              (left_operand.integer_value.value < -1) THEN
          set_arithmetic_condition (operator, $pmt$system_conditions []);
          EXIT clp$perform_numeric_operation;
        IFEND;
        IF right_operand.integer_value.value >= 0 THEN
          itoi;
          IF operation_successful THEN
            RETURN;
          IFEND;
        IFEND;
        convert_integer_value_to_real (left_operand, left_real);

      ELSE
        right_le_zero := clp$longreal_compare_le (right_operand.real_value.value, clv$real_zero^);
        IF ((left_operand.integer_value.value = 0) AND right_le_zero) OR
              (left_operand.integer_value.value < 0) THEN
          set_arithmetic_condition (operator, $pmt$system_conditions []);
          EXIT clp$perform_numeric_operation;
        IFEND;
        right_real := right_operand.real_value;
        result.kind := clc$real;
        result.real_value.number_of_digits := clc$max_real_number_digits;
        osp$establish_condition_handler (^real_arithmetic_cond_handler, FALSE);
        result.real_value.value := clp$itod (left_operand.integer_value.value, right_real.value);
        RETURN;
      IFEND;

      result.kind := clc$real;
      result.real_value.number_of_digits := clc$max_real_number_digits;
      comparison_result := clp$longreal_compare (left_real.value, clv$real_zero^, clc$infinities_equal);
      left_eq_zero := comparison_result = clc$equal;
      left_lt_zero := comparison_result = clc$right_is_greater;

      IF right_operand.kind = clc$integer THEN
        IF (left_eq_zero AND (right_operand.integer_value.value <= 0)) OR left_lt_zero THEN
          set_arithmetic_condition (operator, $pmt$system_conditions []);
          EXIT clp$perform_numeric_operation;
        IFEND;
        osp$establish_condition_handler (^real_arithmetic_cond_handler, FALSE);
        result.real_value.value := clp$dtoi (left_real.value, right_operand.integer_value.value);

      ELSE
        right_le_zero := clp$longreal_compare_le (right_operand.real_value.value, clv$real_zero^);
        IF (left_eq_zero AND right_le_zero) OR left_lt_zero THEN
          set_arithmetic_condition (operator, $pmt$system_conditions []);
          EXIT clp$perform_numeric_operation;
        IFEND;
        right_real := right_operand.real_value;
        osp$establish_condition_handler (^real_arithmetic_cond_handler, FALSE);
        result.real_value.value := clp$dtod (left_real.value, right_real.value);
      IFEND;

    PROCEND perform_exponentiate;
*IFEND
?? TITLE := 'perform_integer_operation', EJECT ??

    PROCEDURE perform_integer_operation;

*IF NOT $true(osv$unix)
?? NEWTITLE := 'integer_arithmetic_cond_handler', EJECT ??

      PROCEDURE integer_arithmetic_cond_handler
        (    condition: pmt$condition;
             ignore_info: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR handler_status: ost$status);


        IF (condition.selector = pmc$system_conditions) AND
              ((arithmetic_conditions * condition.system_conditions) <> $pmt$system_conditions []) THEN
          operation_successful := FALSE;
          EXIT perform_integer_operation;
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

      PROCEND integer_arithmetic_cond_handler;
?? OLDTITLE, EJECT ??
*IFEND

      result.kind := clc$integer;

*IF NOT $true(osv$unix)
      osp$establish_condition_handler (^integer_arithmetic_cond_handler, FALSE);
*IFEND

      CASE operator (1) OF

      = '+' =
        IF left_operand.kind = clc$unspecified THEN
          result.integer_value.value := right_operand.integer_value.value;
        ELSE
          result.integer_value.value := left_operand.integer_value.value + right_operand.integer_value.value;
        IFEND;

      = '-' =
        IF left_operand.kind = clc$unspecified THEN
          result.integer_value.value := -right_operand.integer_value.value;
        ELSE
          result.integer_value.value := left_operand.integer_value.value - right_operand.integer_value.value;
        IFEND;

      = '*' =
        result.integer_value.value := left_operand.integer_value.value * right_operand.integer_value.value;

      = '/' =
        result.integer_value.value := left_operand.integer_value.value DIV right_operand.integer_value.value;

      ELSE {$MOD}
        result.integer_value.value := left_operand.integer_value.value MOD right_operand.integer_value.value;
      CASEND;

      result.integer_value.radix := left_operand.integer_value.radix;
      result.integer_value.radix_specified := left_operand.integer_value.radix_specified;

*IF NOT $true(osv$unix)
      operation_successful := TRUE;
*IFEND

    PROCEND perform_integer_operation;
*IF NOT $true(osv$unix)
?? TITLE := 'perform_real_operation', EJECT ??

    PROCEDURE perform_real_operation;

?? NEWTITLE := 'real_arithmetic_cond_handler', EJECT ??

      PROCEDURE real_arithmetic_cond_handler
        (    condition: pmt$condition;
             ignore_info: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR handler_status: ost$status);

        VAR
          error_result: ^longreal;


        IF (condition.selector = pmc$system_conditions) AND
              ((arithmetic_conditions * condition.system_conditions) <> $pmt$system_conditions []) THEN
          set_longreal_condition_result (condition.system_conditions,
                result_table^ [clp$longreal_classify (left_real.value)]
                [clp$longreal_classify (right_real.value)], error_result);
          IF error_result = NIL THEN
            set_arithmetic_condition (operator, condition.system_conditions);
            EXIT clp$perform_numeric_operation;
          IFEND;
          result.real_value.value := error_result^;
          EXIT perform_real_operation;
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

      PROCEND real_arithmetic_cond_handler;
?? OLDTITLE, EJECT ??

      result.kind := clc$real;
      result.real_value.number_of_digits := clc$max_real_number_digits;

      osp$establish_condition_handler (^real_arithmetic_cond_handler, FALSE);

      CASE operator (1) OF

      = '+' =
        IF left_operand.kind = clc$unspecified THEN
          result.real_value.value := right_real.value;
          result.real_value.number_of_digits := right_real.number_of_digits;
        ELSE
          result.real_value.value := left_real.value + right_real.value;
          IF (left_real.number_of_digits + right_real.number_of_digits) < clc$max_real_number_digits THEN
            result.real_value.number_of_digits := left_real.number_of_digits + right_real.number_of_digits;
          IFEND;
        IFEND;

      = '-' =
        IF left_operand.kind = clc$unspecified THEN
          result.real_value.value := -right_real.value;
          result.real_value.number_of_digits := right_real.number_of_digits;
        ELSE
          result.real_value.value := left_real.value - right_real.value;
          IF (left_real.number_of_digits + right_real.number_of_digits) < clc$max_real_number_digits THEN
            result.real_value.number_of_digits := left_real.number_of_digits + right_real.number_of_digits;
          IFEND;
        IFEND;

      = '*' =
        result.real_value.value := left_real.value * right_real.value;

      = '/' =
        result.real_value.value := left_real.value / right_real.value;

      ELSE {$MOD}
        bad_call;
      CASEND;

    PROCEND perform_real_operation;
?? TITLE := 'set_arithmetic_condition', EJECT ??

{
{ PURPOSE:
{   This routine is used to "translate" hardware arithmetic conditions into
{   the corresponding SCL status.
{ NOTE:
{   The status condition cle$exponentiate_fault has no hardware equivalent
{   and so is indicated to this routine by an empty user conditions set.
{

    PROCEDURE set_arithmetic_condition
      (    operator: string ( * <= osc$max_name_size);
           user_conditions: pmt$system_conditions);

      VAR
        status_condition: ost$status_condition;

?? NEWTITLE := 'append_number', EJECT ??

      PROCEDURE [INLINE] append_number
        (    delimiter: char;
             value: clt$data_value);


        IF value.kind = clc$integer THEN
          osp$append_status_integer (delimiter, value.integer_value.value, value.integer_value.radix,
                value.integer_value.radix_specified, status);
        ELSE
          osp$append_status_real (delimiter, value.real_value.value, value.real_value.number_of_digits,
                status);
        IFEND;

      PROCEND append_number;
?? OLDTITLE, EJECT ??

      IF pmc$divide_fault IN user_conditions THEN
        status_condition := cle$divide_fault;
      ELSEIF pmc$arithmetic_overflow IN user_conditions THEN
        status_condition := cle$arithmetic_overflow;
      ELSEIF pmc$exponent_overflow IN user_conditions THEN
        status_condition := cle$exponent_overflow;
      ELSEIF pmc$exponent_underflow IN user_conditions THEN
        status_condition := cle$exponent_underflow;
      ELSEIF pmc$fp_indefinite IN user_conditions THEN
        status_condition := cle$fp_indefinite;
      ELSEIF pmc$arithmetic_significance IN user_conditions THEN
        status_condition := cle$arithmetic_significance;
      ELSEIF pmc$fp_significance_loss IN user_conditions THEN
        status_condition := cle$fp_significance_loss;
      ELSE
        status_condition := cle$exponentiate_fault;
      IFEND;

      osp$set_status_condition (status_condition, status);

      IF operator (1) = '$' THEN {function}
        IF left_operand.kind = clc$unspecified THEN {unary}
          osp$append_status_parameter (osc$status_parameter_delimiter, operator, status);
          append_number ('(', right_operand);
          osp$append_status_parameter (')', '', status);
        ELSE {binary}
          osp$append_status_parameter (osc$status_parameter_delimiter, operator, status);
          append_number ('(', left_operand);
          append_number (',', right_operand);
          osp$append_status_parameter (')', '', status);
        IFEND;
      ELSE {operator}
        IF left_operand.kind = clc$unspecified THEN {unary}
          osp$append_status_parameter (osc$status_parameter_delimiter, operator, status);
          append_number (' ', right_operand);
        ELSE {binary}
          append_number (osc$status_parameter_delimiter, left_operand);
          osp$append_status_parameter (' ', operator, status);
          append_number (' ', right_operand);
        IFEND;
      IFEND;

    PROCEND set_arithmetic_condition;
?? TITLE := 'set_longreal_condition_result', EJECT ??

{
{ PURPOSE:
{   This procedure is used to establish the proper result of a longreal
{   arithmetic operation that produced a system condition.
{   The USER_CONDITIONS parameter represents the hardware detected conditions
{   resulting from the attempted operation.
{   The CANDIDATE_RESULT is looked up in the appropriate table given the
{   "class" of the left and right operands.
{   If the RESULT is returned as NIL, an error should be generated (using
{   set_arithmetic_condition).
{   A non-NIL RESULT should be used as the operation's result.
{

    PROCEDURE [INLINE] set_longreal_condition_result
      (    user_conditions: pmt$system_conditions;
           candidate_result: ^^longreal;
       VAR result: ^longreal);


      IF (candidate_result = NIL) OR (pmc$divide_fault IN user_conditions) THEN
        result := NIL;
      ELSEIF pmc$exponent_underflow IN user_conditions THEN
        result := clv$real_zero;
      ELSE
        result := candidate_result^;
      IFEND;

    PROCEND set_longreal_condition_result;
*IFEND
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    IF (NOT (left_operand.kind IN $clt$data_kinds [clc$integer, clc$real, clc$unspecified])) OR
          (NOT (right_operand.kind IN $clt$data_kinds [clc$integer, clc$real])) THEN
      bad_call;
    IFEND;

*IF NOT $true(osv$unix)
    result_table := NIL;
*IFEND

    IF operator = '**' THEN
*IF NOT $true(osv$unix)
      IF left_operand.kind = clc$unspecified THEN
*IFEND
        bad_call;
*IF NOT $true(osv$unix)
      IFEND;
      perform_exponentiate;
*IFEND
      RETURN;
    IFEND;

    IF operator = '+' THEN
*IF NOT $true(osv$unix)
      result_table := ^longreal_add_error_results;
*ELSE
      ;
*IFEND
    ELSEIF operator = '-' THEN
*IF NOT $true(osv$unix)
      result_table := ^longreal_subtract_error_results;
*ELSE
      ;
*IFEND
    ELSEIF operator = '*' THEN
      IF left_operand.kind = clc$unspecified THEN
        bad_call;
      IFEND;
*IF NOT $true(osv$unix)
      result_table := ^longreal_multiply_error_results;
*IFEND
    ELSEIF operator = '/' THEN
      IF left_operand.kind = clc$unspecified THEN
        bad_call;
      IFEND;
*IF NOT $true(osv$unix)
      result_table := ^longreal_divide_error_results;
*IFEND
    ELSEIF operator = '$MOD' THEN
      IF left_operand.kind = clc$unspecified THEN
        bad_call;
      IFEND;
    ELSE
      bad_call;
    IFEND;

*IF $true(osv$unix)
    IF (left_operand.kind = clc$integer) OR (right_operand.kind = clc$integer) THEN
*ELSE
    IF (left_operand.kind = clc$integer) AND (right_operand.kind = clc$integer) THEN
*IFEND
      perform_integer_operation;
*IF NOT $true(osv$unix)
      IF operation_successful THEN
        RETURN;
      IFEND;
*IFEND
    IFEND;

*IF NOT $true(osv$unix)
    CASE left_operand.kind OF
    = clc$real =
      left_real := left_operand.real_value;
    = clc$integer =
      convert_integer_value_to_real (left_operand, left_real);
    ELSE {clc$unspecified}
      ;
    CASEND;

    IF right_operand.kind = clc$real THEN
      right_real := right_operand.real_value;
    ELSE {clc$integer}
      convert_integer_value_to_real (right_operand, right_real);
    IFEND;

    perform_real_operation;
*IFEND

  PROCEND clp$perform_numeric_operation;

MODEND clm$numeric_operations;
