MODULE clm$integer_functions;
?? RIGHT := 110 ??

{ PURPOSE:
{   Provide some SCL integer Functions.

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
?? POP ??
*copyc clf#make_clt$integer_value

*copyc clp$evaluate_parameters
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Decalred By This Module', EJECT ??

  TYPE
    t$type_converter = record
      case boolean of
      = TRUE =
        i: integer,
      = FALSE =
        a: packed array [0 .. 63] of boolean,
      casend,
    recend;

?? NEWTITLE := '[inline] F$AND', EJECT ??

  FUNCTION [INLINE] f$and
    (    value_1: integer;
         value_2: integer): integer;

    VAR
      i: 0 .. 63,
      i_1: t$type_converter,
      i_2: t$type_converter,
      i_result: t$type_converter;

    i_1.i := value_1;
    i_2.i := value_2;
    FOR i := 0 TO 63 DO
      i_result.a [i] := i_1.a [i] AND i_2.a [i];
    FOREND;

    f$and := i_result.i;

  FUNCEND f$and;
?? OLDTITLE ??
?? NEWTITLE := '[inline] F$OR', EJECT ??

  FUNCTION [INLINE] f$or
    (    value_1: integer;
         value_2: integer): integer;

    VAR
      i: 0 .. 63,
      i_1: t$type_converter,
      i_2: t$type_converter,
      i_result: t$type_converter;

    i_1.i := value_1;
    i_2.i := value_2;
    FOR i := 0 TO 63 DO
      i_result.a [i] := i_1.a [i] OR i_2.a [i];
    FOREND;

    f$or := i_result.i;

  FUNCEND f$or;
?? OLDTITLE ??
?? NEWTITLE := '[inline] F$XOR', EJECT ??

  FUNCTION [INLINE] f$xor
    (    value_1: integer;
         value_2: integer): integer;

    VAR
      i: 0 .. 63,
      i_1: t$type_converter,
      i_2: t$type_converter,
      i_result: t$type_converter;

    i_1.i := value_1;
    i_2.i := value_2;
    FOR i := 0 TO 63 DO
      i_result.a [i] := i_1.a [i] XOR i_2.a [i];
    FOREND;

    f$xor := i_result.i;

  FUNCEND f$xor;
?? OLDTITLE ??
?? NEWTITLE := 'CLP$$ABSOLUTE_INTEGER', EJECT ??

  PROCEDURE [XDCL] clp$$absolute_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$$absolute_value) $absolute_value (
{   value: integer = $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$integer_type_qualifier,
      recend,
    recend := [
    [1,
    [103, 4, 10, 15, 16, 2, 318],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$ABSOLUTE_VALUE'], [
    ['VALUE                          ',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, 20, clc$required_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]]];

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

    CONST
      p$value = 1;

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

    VAR
      i: integer,
      int_p: ^clt$integer;

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

    int_p := ^pvt [p$value].value^.integer_value;
    IF int_p^.value >= 0 THEN
      i := int_p^.value;
    ELSE
      i := -int_p^.value;
    IFEND;

    result := clf#make_clt$integer_value (i, int_p^.radix, int_p^.radix_specified, work_area);

  PROCEND clp$$absolute_integer;
?? OLDTITLE ??
?? NEWTITLE := 'CLP$$AND_INTEGER', EJECT ??

  PROCEDURE [XDCL] clp$$and_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$$and_integer) $and_integer (
{   values: list rest of integer = $optional
{   )

?? 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$integer_type_qualifier,
        recend,
      recend,
    recend := [
    [1,
    [103, 4, 10, 15, 23, 8, 929],
    clc$function, 1, 1, 0, 0, 0, 0, 0, 'OSM$$AND_INTEGER'], [
    ['VALUES                         ',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, 36, clc$optional_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [20, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]]
    ]];

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

    CONST
      p$values = 1;

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

    VAR
      i: integer,
      first_value_p: ^clt$integer,
      node_p: ^clt$data_value,
      value_p: ^clt$data_value;

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

    node_p := pvt [p$values].value;
    first_value_p := NIL;

    i := -1;
    WHILE (node_p <> NIL) AND (node_p^.kind = clc$list) DO
      value_p := node_p^.element_value;
      IF (value_p <> NIL) AND (value_p^.kind = clc$integer) THEN
        i := f$and (i, value_p^.integer_value.value);
        IF first_value_p = NIL THEN
          first_value_p := ^value_p^.integer_value;
        IFEND;
      IFEND;

      node_p := node_p^.link;
    WHILEND;

    IF first_value_p = NIL THEN
      result := clf#make_clt$integer_value (i, 10, FALSE, work_area);
    ELSE
      result := clf#make_clt$integer_value (i, first_value_p^.radix, first_value_p^.radix_specified,
            work_area);
    IFEND;

  PROCEND clp$$and_integer;
?? OLDTITLE ??
?? NEWTITLE := 'CLP$$OR_INTEGER', EJECT ??

  PROCEDURE [XDCL] clp$$or_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$$or_integer) $or_integer (
{   values: list rest of integer = $optional
{   )

?? 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$integer_type_qualifier,
        recend,
      recend,
    recend := [
    [1,
    [103, 4, 10, 15, 23, 8, 929],
    clc$function, 1, 1, 0, 0, 0, 0, 0, 'OSM$$AND_INTEGER'], [
    ['VALUES                         ',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, 36, clc$optional_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [20, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]]
    ]];

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

    CONST
      p$values = 1;

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

    VAR
      i: integer,
      first_value_p: ^clt$integer,
      node_p: ^clt$data_value,
      value_p: ^clt$data_value;

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

    node_p := pvt [p$values].value;
    first_value_p := NIL;

    i := 0;
    WHILE (node_p <> NIL) AND (node_p^.kind = clc$list) DO
      value_p := node_p^.element_value;
      IF (value_p <> NIL) AND (value_p^.kind = clc$integer) THEN
        i := f$or (i, value_p^.integer_value.value);
        IF first_value_p = NIL THEN
          first_value_p := ^value_p^.integer_value;
        IFEND;
      IFEND;

      node_p := node_p^.link;
    WHILEND;

    IF first_value_p = NIL THEN
      result := clf#make_clt$integer_value (i, 10, FALSE, work_area);
    ELSE
      result := clf#make_clt$integer_value (i, first_value_p^.radix, first_value_p^.radix_specified,
            work_area);
    IFEND;

  PROCEND clp$$or_integer;
?? OLDTITLE ??
?? NEWTITLE := 'CLP$$SHIFT_INTEGER', EJECT ??

  PROCEDURE [XDCL] clp$$shift_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$$shift_integer) $shift_integer (
{   value: integer = $required
{   shift_count: integer -64..63 = $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,
    [103, 4, 10, 15, 15, 50, 155],
    clc$function, 2, 2, 2, 0, 0, 0, 0, 'OSM$$SHIFT_INTEGER'], [
    ['SHIFT_COUNT                    ',clc$nominal_entry, 2],
    ['VALUE                          ',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, 20, 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$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], [-64, 63, 10]]];

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

    CONST
      p$value = 1,
      p$shift_count = 2;

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

    VAR
      i: integer,
      int_p: ^clt$integer;

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

    int_p := ^pvt [p$value].value^.integer_value;
    i :=
    #SHIFT (int_p^.value, pvt [p$shift_count].value^.integer_value.value);
    result := clf#make_clt$integer_value (i, int_p^.radix, int_p^.radix_specified, work_area);

  PROCEND clp$$shift_integer;
?? OLDTITLE ??
?? NEWTITLE := 'CLP$$XOR_INTEGER', EJECT ??

  PROCEDURE [XDCL] clp$$xor_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$$xor_integer) $xor_integer (
{   values: list rest of integer = $optional
{   )

?? 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$integer_type_qualifier,
        recend,
      recend,
    recend := [
    [1,
    [103, 4, 10, 15, 24, 26, 787],
    clc$function, 1, 1, 0, 0, 0, 0, 0, 'OSM$$XOR_INTEGER'], [
    ['VALUES                         ',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, 36, clc$optional_parameter,
  0, 0]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [20, 1, clc$max_list_size, 0, FALSE, TRUE],
      [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]]
    ]];

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

    CONST
      p$values = 1;

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

    VAR
      i: integer,
      first_value_p: ^clt$integer,
      node_p: ^clt$data_value,
      value_p: ^clt$data_value;

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

    node_p := pvt [p$values].value;
    first_value_p := NIL;

    i := 0;
    WHILE (node_p <> NIL) AND (node_p^.kind = clc$list) DO
      value_p := node_p^.element_value;
      IF (value_p <> NIL) AND (value_p^.kind = clc$integer) THEN
        i := f$xor (i, value_p^.integer_value.value);
        IF first_value_p = NIL THEN
          first_value_p := ^value_p^.integer_value;
        IFEND;
      IFEND;

      node_p := node_p^.link;
    WHILEND;

    IF first_value_p = NIL THEN
      result := clf#make_clt$integer_value (i, 10, FALSE, work_area);
    ELSE
      result := clf#make_clt$integer_value (i, first_value_p^.radix, first_value_p^.radix_specified,
            work_area);
    IFEND;

  PROCEND clp$$xor_integer;
?? OLDTITLE ??
MODEND clm$integer_functions;

