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

{ Purpose:  This module contains the procedures to generate and manipulate
{           Unique SCL compatible names.

{ Design:   For generation of names, first generate a binary unique name and
{           then convert it to an SCL compatible form.


?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$mainframe_paged_literal
*copyc ost$binary_unique_name
*copyc ost$name
*copyc ost$status
*copyc ost$string
*copyc pmc$program_management_id
*copyc pme$program_services_exceptions
*copyc pmt$processor_serial_number
?? POP ??
*copyc osp$generate_unique_binary_name
*copyc osp$set_status_abnormal
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  TYPE
    pmt_unique_name = record
      case boolean of
      = TRUE =
        value: ost$name,
      = FALSE =
        dollar_sign: string (1),
        sequence_number: string (7),
        processor_model_number: string (2),
        s: string (1),
        processor_serial_number: string (pmc$processor_serial_num_size),
        d: string (1),
        year: string (4),
        month: string (2),
        day: string (2),
        t: string (1),
        hour: string (2),
        minute: string (2),
        second: string (2),
      casend,
    recend,

    pmt_conversion_mask = record
      case boolean of
      = TRUE =
        integer_value: ost$processor_serial_number,
      = FALSE =
        bcd_value: packed array [1 .. pmc$processor_serial_num_size] of 0 .. 0f(16),
      casend,
    recend;

  VAR
    digits: [STATIC, READ, oss$mainframe_paged_literal] array [0 .. 15] of char := ['0', '1', '2', '3', '4',
          '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'];

  { Unique names are translated using the following string in order to simplify
  { validation and conversion.  The plus character is used for all non-printable
  { characters to make specification of the string easier. Any character that
  { does not appear in valid unique names could be used.  Decimal digits and
  { both upper and lower case hex digits are mapped to their integer value.  All
  { other lower case alphabetic characters are mapped to their upper case
  { equivalent.
  {
  { Validation is performed by comparing each character of the translated
  { version of the unique name string with the corresponding character of the
  { following pattern string.  For pattern characters with integer values of
  { 128 - 255, the unique name character must be less than or equal to the
  { pattern character - 128.  For all other pattern character values, the
  { unique name character must equal the pattern character.

  CONST
    dec = $CHAR (9 + 128),
    hex = $CHAR (15 + 128);

?? FMT (FORMAT := OFF) ??
  VAR
    name_translator: [STATIC, READ, oss$mainframe_paged_literal] string (256) :=
          '++++++++++++++++++++++++++++++++' CAT
          ' !"#$%&''()*+,-./' CAT
          $CHAR (00) CAT $CHAR (01) CAT $CHAR (02) CAT $CHAR (03) CAT $CHAR (04) CAT
          $CHAR (05) CAT $CHAR (06) CAT $CHAR (07) CAT $CHAR (08) CAT $CHAR (09) CAT
          ':;<=>?@' CAT
          $CHAR (10) CAT $CHAR (11) CAT $CHAR (12) CAT $CHAR (13) CAT $CHAR (14) CAT
          $CHAR (15) CAT 'GHIJKLMNOPQRSTUVWXYZ' CAT
          '[\]^_`' CAT
          $CHAR (10) CAT $CHAR (11) CAT $CHAR (12) CAT $CHAR (13) CAT $CHAR (14) CAT
          $CHAR (15) CAT 'GHIJKLMNOPQRSTUVWXYZ' CAT
          '{|}~+' CAT
          '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++' CAT
          '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++',

    name_pattern: [STATIC, READ, oss$mainframe_paged_literal] ost$name :=
      { $               }  '$' CAT
      { sequence number }  dec CAT dec CAT dec CAT dec CAT dec CAT dec CAT dec CAT
      { model number    }  hex CAT hex CAT
      { S               }  'S' CAT
      { serial number   }  dec CAT dec CAT dec CAT dec CAT
      { D (hex digit)   }  $CHAR (0d(16)) CAT
      { date            }  dec CAT dec CAT dec CAT dec CAT dec CAT dec CAT dec CAT dec CAT
      { T               }  'T' CAT
      { time            }  dec CAT dec CAT dec CAT dec CAT dec CAT dec;
?? FMT (FORMAT := ON) ??
?? OLDTITLE ??
?? NEWTITLE := '[INLINE, XDCL, #GATE] pmp$convert_binary_unique_name', EJECT ??
*copyc pmh$convert_binary_unique_name

  PROCEDURE [INLINE, XDCL, #GATE] pmp$convert_binary_unique_name
    (    binary_name: ost$binary_unique_name;
     VAR name: ost$name;
     VAR status: ost$status);


    VAR
      number: integer,
      index: ost$string_index,
      converter: pmt_conversion_mask,
      generated_name: pmt_unique_name;

    status.normal := TRUE;

    generated_name.dollar_sign := '$';

    number := binary_name.sequence_number;
    FOR index := STRLENGTH (generated_name.sequence_number) DOWNTO 1 DO
      generated_name.sequence_number (index) := digits [number MOD 10];
      number := number DIV 10;
    FOREND;

    generated_name.processor_model_number (1) := digits [binary_name.model_number DIV 16];
    generated_name.processor_model_number (2) := digits [binary_name.model_number MOD 16];

    generated_name.s := 'S';

    converter.integer_value := binary_name.serial_number;
    FOR index := 1 TO pmc$processor_serial_num_size DO
      generated_name.processor_serial_number (index) := digits [converter.bcd_value [index]];
    FOREND;

    generated_name.d := 'D';

    number := binary_name.year;
    FOR index := STRLENGTH (generated_name.year) DOWNTO 1 DO
      generated_name.year (index) := digits [number MOD 10];
      number := number DIV 10;
    FOREND;

    generated_name.month (1) := digits [binary_name.month DIV 10];
    generated_name.month (2) := digits [binary_name.month MOD 10];

    generated_name.day (1) := digits [binary_name.day DIV 10];
    generated_name.day (2) := digits [binary_name.day MOD 10];

    generated_name.t := 'T';

    generated_name.hour (1) := digits [binary_name.hour DIV 10];
    generated_name.hour (2) := digits [binary_name.hour MOD 10];

    generated_name.minute (1) := digits [binary_name.minute DIV 10];
    generated_name.minute (2) := digits [binary_name.minute MOD 10];

    generated_name.second (1) := digits [binary_name.second DIV 10];
    generated_name.second (2) := digits [binary_name.second MOD 10];

    name := generated_name.value;

  PROCEND pmp$convert_binary_unique_name;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$convert_unique_to_binary', EJECT ??
*copyc pmh$convert_unique_to_binary

  PROCEDURE [XDCL, #GATE] pmp$convert_unique_to_binary
    (    name: ost$name;
     VAR binary_unique_name: ost$binary_unique_name;
     VAR status: ost$status);

    VAR
      converter: pmt_conversion_mask,
      index: ost$string_index,
      number: integer,
      pattern: char,
      unique: char,
      unique_name: pmt_unique_name;

    status.normal := TRUE;

    #TRANSLATE (name_translator, name, unique_name.value);

    FOR index := 1 TO STRLENGTH (unique_name.value) DO
      unique := unique_name.value (index);
      pattern := name_pattern (index);
      IF (unique <> pattern) AND ((pattern < $CHAR (128)) OR (unique > $CHAR ($INTEGER (pattern) - 128))) THEN
        osp$set_status_abnormal (pmc$program_management_id, pme$invalid_unique_name, name, status);
        RETURN;
      IFEND;
    FOREND;

    binary_unique_name.sequence_number := 0;
    FOR index := 1 TO STRLENGTH (unique_name.sequence_number) DO
      binary_unique_name.sequence_number := 10 * binary_unique_name.sequence_number +
            $INTEGER (unique_name.sequence_number (index));
    FOREND;

    binary_unique_name.model_number := 16 * $INTEGER (unique_name.processor_model_number (1)) +
          $INTEGER (unique_name.processor_model_number (2));

    FOR index := 1 TO pmc$processor_serial_num_size DO
      converter.bcd_value [index] := $INTEGER (unique_name.processor_serial_number (index));
    FOREND;
    binary_unique_name.serial_number := converter.integer_value;

    number := 0;
    FOR index := 1 TO STRLENGTH (unique_name.year) DO
      number := 10 * number + $INTEGER (unique_name.year (index));
    FOREND;

    binary_unique_name.year := number;
    binary_unique_name.month := 10 * $INTEGER (unique_name.month (1)) + $INTEGER (unique_name.month (2));
    binary_unique_name.day := 10 * $INTEGER (unique_name.day (1)) + $INTEGER (unique_name.day (2));
    binary_unique_name.hour := 10 * $INTEGER (unique_name.hour (1)) + $INTEGER (unique_name.hour (2));
    binary_unique_name.minute := 10 * $INTEGER (unique_name.minute (1)) + $INTEGER (unique_name.minute (2));
    binary_unique_name.second := 10 * $INTEGER (unique_name.second (1)) + $INTEGER (unique_name.second (2));
    binary_unique_name.fill := 0;

  PROCEND pmp$convert_unique_to_binary;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$generate_unique_name', EJECT ??
*copyc pmh$generate_unique_name

  PROCEDURE [XDCL, #GATE] pmp$generate_unique_name
    (VAR name: ost$unique_name;
     VAR status: ost$status);

    VAR
      binary_name: ost$binary_unique_name,
      local_status: ost$status;

    status.normal := TRUE;

{ pmp$get_unique_name is inline so a call is not performed

    pmp$get_unique_name (name.value, status);

  PROCEND pmp$generate_unique_name;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE, XDCL, #GATE] pmp$get_unique_name', EJECT ??
*copyc pmh$get_unique_name

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

    VAR
      binary_name: ost$binary_unique_name;

    osp$generate_unique_binary_name (binary_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$convert_binary_unique_name (binary_name, name, status);

  PROCEND pmp$get_unique_name;
?? OLDTITLE ??
MODEND pmm$get_unique_name;
