?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE PROC Translator' ??
MODULE clm$translate_function;

{ PURPOSE:
{    The purpose of this module is to translate the input line
{    consisting of a SCL function name and associated argument list
{    into a line consistent with the new SCL types.

?? TITLE := '  Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_function_processing
*copyc cle$ecc_scl_formatter
*copyc clt$command_line
*copyc clt$command_line_size
*copyc clt$command_line_index
*copyc clt$format_token_type
*copyc oss$job_paged_literal
*copyc ost$name
*copyc ost$string
?? POP ??
*copyc clp$append_status_parse_state
*copyc clp$initialize_parse_state
*copyc clp$scan_lexical_unit
*copyc clp$trimmed_string_size
*copyc osp$append_status_integer
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
*copyc osv$upper_to_lower

?? TITLE := 'clp$scan_unnested_sep_lex_unit', EJECT ??

{ This version of the routine has been modified for the formatter.
{ CLP$SCAN_UNNESTED_SEP_LEXICAL_UNIT updates its PARSE parameter to designate
{ the next lexical unit that is a separator (space, comment, comma, semicolon
{ or, optionally, ellipsis) not nested within parentheses.
{ This procedure requires that the UNITS field of the PARSE parameter be
{ non-NIL.

  PROCEDURE [INLINE] clp$scan_unnested_sep_lex_unit
    (    ellipsis_treatment: (clc$ignore_ellipsis, clc$ellipsis_is_separator);
     VAR parse {input, output} : clt$parse_state);

    VAR
      nesting_level: clt$string_size;


    nesting_level := $INTEGER (parse.unit.kind = clc$lex_left_parenthesis);
    REPEAT
      clp$scan_lexical_unit (clc$slu_any, parse);
      CASE parse.unit.kind OF
      = clc$lex_end_of_line =
        RETURN;
      = clc$lex_space, clc$lex_comment, clc$lex_unterminated_comment, clc$lex_semicolon, clc$lex_comma =
        IF nesting_level <= 0 THEN
          RETURN;
        IFEND;
      = clc$lex_ellipsis =
        IF (ellipsis_treatment = clc$ellipsis_is_separator) AND (nesting_level <= 0) THEN
          RETURN;
        IFEND;
      = clc$lex_left_parenthesis =
        nesting_level := nesting_level + 1;
      = clc$lex_right_parenthesis =
        IF nesting_level <= 0 THEN
          RETURN;
        IFEND;
        nesting_level := nesting_level - 1;
      ELSE
        ;
      CASEND;
    UNTIL parse.unit_index >= parse.index_limit;

  PROCEND clp$scan_unnested_sep_lex_unit;
?? TITLE := '  [XDCL] clp$translate_function', EJECT ??

  PROCEDURE [XDCL] clp$translate_function
    (    input_line_ptr: ^clt$command_line;
         output_line_ptr: ^clt$command_line;
         function_begin_index: clt$token_array_index;
     VAR function_end_index: clt$token_array_index;
         array_ptr: ^clt$format_token_array;
         max_array_index: clt$token_array_index;
     VAR output_line_size: clt$command_line_size;
     VAR name_only_translated: boolean;
     VAR name_to_flag: ost$name;
     VAR status: ost$status);

    CONST
      translate_function_count = 8;

    VAR
      argument_count: 0 .. 10,
      argument_ptrs: array [1 .. 10] of ^string ( * ),
      current_token: clt$format_token,
      function_name: ost$name,
      function_name_size: ost$name_size,
      index: clt$token_array_index,
      j: integer,
      j2: integer,
      name_index: 1 .. translate_function_count,
      argument_name: ost$name,
      not_it: boolean,
      parse: clt$parse_state,
      parse_text_remaining: clt$command_line_size,
      temp_index: clt$token_array_index,
      temp_name: ost$name,
      translate: boolean;

    VAR
      functions_to_translate: [STATIC, READ, oss$job_paged_literal] array [1 .. translate_function_count] of
            record
        name: ost$name,
        translatable: boolean,
        translated_name: ost$name,
        min_argument_count: 0 .. 10,
        max_argument_count: 0 .. 10,
        translate_name_only: boolean,
      recend := [
            {} ['$CATALOG                       ', TRUE, '$working_catalog               ', 0, 0, FALSE],
            {} ['$CLOCK                         ', TRUE, '$processor                     ', 0, 0, FALSE],
            {} ['$CONDITION_CODE                ', TRUE, '$string                        ', 1, 2, FALSE],
            {} ['$SET_COUNT                     ', TRUE, '$size                          ', 1, 1, FALSE],
            {} ['$SEVERITY                      ', TRUE, '$string                        ', 1, 1, FALSE],
            {} ['$STRLEN                        ', TRUE, '$size                          ', 1, 1, TRUE],
            {} ['$SUBSTR                        ', TRUE, '$substring                     ', 3, 5, TRUE],
            {} ['$VARIABLE                      ', TRUE, 'TO BE SET                      ', 2, 2, FALSE]];

    status.normal := TRUE;
    output_line_size := 0;
    name_to_flag := '';
    clp$initialize_parse_state (input_line_ptr, NIL, parse);
    clp$scan_lexical_unit (clc$slu_non_space, parse);
    IF parse.unit.kind <> clc$lex_name THEN
      osp$set_status_abnormal ('CL', 99999, 'not name', status);
      RETURN;
    IFEND;
    #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), function_name);

    translate := FALSE;

  /search/
    FOR name_index := 1 TO translate_function_count DO
      IF functions_to_translate [name_index].name = function_name THEN
        translate := TRUE;
        EXIT /search/;
      IFEND;
    FOREND /search/;
    IF NOT translate THEN
      RETURN;
    IFEND;

    IF NOT functions_to_translate [name_index].translatable THEN
      osp$set_status_abnormal ('CL', cle$cannot_be_translated, function_name, status);
      RETURN;
    IFEND;

    function_name_size := clp$trimmed_string_size (functions_to_translate [name_index].translated_name);
    IF function_name_size > 0 THEN
      output_line_ptr^ (1, function_name_size) := functions_to_translate [name_index].translated_name;
      output_line_size := function_name_size;
    IFEND;

    name_only_translated := functions_to_translate [name_index].translate_name_only;
    IF name_only_translated THEN
      RETURN;
    IFEND;

    get_arguments (parse, argument_count, argument_ptrs, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF argument_count < functions_to_translate [name_index].min_argument_count THEN
      osp$set_status_abnormal ('CL', cle$required_argument_omitted, function_name, status);
      osp$append_status_integer (osc$status_parameter_delimiter,
            functions_to_translate [name_index].min_argument_count, 10, FALSE, status);
      RETURN;
    ELSEIF argument_count > functions_to_translate [name_index].max_argument_count THEN
      osp$set_status_abnormal ('CL', cle$too_many_arguments, function_name, status);
      RETURN;
    IFEND;

    IF function_name = '$CLOCK' THEN
      STRINGREP (output_line_ptr^, j, '$processor(clock)');
      output_line_size := j;

{   ELSEIF (function_name = '$CONDITION') OR (function_name = '$CONDITION_NAME') THEN
{     STRINGREP (output_line_ptr^, j, '$string($status_code_name(', argument_ptrs [1]^);
{     IF argument_count > 1 THEN
{       STRINGREP (output_line_ptr^ (j + 1, * ), j2, ',', argument_ptrs [2]^);
{       j := j + j2
{     IFEND;
{     STRINGREP (output_line_ptr^ (j + 1, *), j2, '))');
{     output_line_size := j + j2;
{     name_to_flag := function_name;
{

    ELSEIF function_name = '$CONDITION_CODE' THEN
      IF argument_count > 1 THEN
        #TRANSLATE (osv$lower_to_upper, argument_ptrs [2]^, temp_name);
        IF temp_name = 'SYMBOLIC' THEN
          STRINGREP (output_line_ptr^, j, '$status_code_string(', argument_ptrs [1]^, ')');
        ELSE { NUMERIC
          STRINGREP (output_line_ptr^, j, '$status_code(', argument_ptrs [1]^, ')');
        IFEND;
      ELSE {default is NUMERIC
        STRINGREP (output_line_ptr^, j, '$status_code(', argument_ptrs [1]^, ')');
      IFEND;
      output_line_size := j;
      name_to_flag := function_name;

{   ELSEIF (function_name = '$FILE') THEN
{     #translate (osv$lower_to_upper, argument_ptrs [2]^, temp_name);
{     IF (temp_name = 'DEVICE_CLASS') OR (temp_name = 'DC') OR (temp_name = 'FILE_CONTENTS') OR (temp_name =
{       'FC') OR (temp_name = 'FILE_ORGANIZATION') OR (temp_name = 'FO') OR (temp_name = 'FILE_PROCESSOR') OR
{         (temp_name = 'FP') OR (temp_name = 'FILE_STRUCTURE') OR (temp_name = 'FS') OR (temp_name =
{       'OPEN_POSITION') OR (temp_name = 'OP') THEN
{       STRINGREP (output_line_ptr^, j, '$string($file(', argument_ptrs [1]^, ', ', argument_ptrs [2]^, '))');
{       output_line_size := j;
{       name_to_flag := function_name;
{     ELSE
{       output_line_size := 0;
{     IFEND;
{
{   ELSEIF function_name = '$JOB' THEN
{     #translate (osv$upper_to_lower, argument_ptrs [1]^, argument_name);
{     IF (#SIZE (argument_ptrs [1]^) = 7) AND (argument_name (1, 6) = 'switch') THEN
{       {???|| string 'ON' 'OFF'
{       STRINGREP (output_line_ptr^, j, '$switch(', argument_name (7), ')');
{       output_line_size := j;
{     ELSEIF argument_name <> 'operator' THEN
{       IF argument_name = 'job_name' THEN
{         temp_name := 'name';
{       ELSEIF argument_name = 'system_job_name' THEN
{         temp_name := 'system_name';
{       ELSE
{         temp_name := argument_name;
{       IFEND;
{       STRINGREP (output_line_ptr^, j, '$string($job(', temp_name, '))');
{       output_line_size := j;
{       name_to_flag := function_name;
{     ELSE
{       output_line_size := 0;
{     IFEND;
{
{  $PARAMETER was removed from the translation table because of psr NV05926 which
{  complained that the translation didn't work if the parameter was a list or was
{  optional.
{
{   ELSEIF (function_name = '$PARAMETER') THEN
{     STRINGREP (output_line_ptr^, j, '$string($parameter_value(', argument_ptrs [1]^, '))');
{     output_line_size := j;
{
{   ELSEIF (function_name = '$PATH') THEN
{     #translate (osv$upper_to_lower, argument_ptrs [2]^, argument_name);
{     IF argument_name = 'catalog' THEN
{       STRINGREP (output_line_ptr^, j, '$string($up(', argument_ptrs [1]^, '))');
{       output_line_size := j;
{     ELSEIF argument_name = 'last' THEN
{       STRINGREP (output_line_ptr^, j, '$string($file(', argument_ptrs [1]^, ', last_path_name))');
{       output_line_size := j;
{     ELSEIF argument_name = 'count' THEN
{       osp$set_status_abnormal ('CL', cle$cannot_be_translated, '$PATH(path, COUNT)', status);
{     ELSE
{       output_line_size := 0;
{     IFEND;
{
{   ELSEIF function_name = '$PROGRAM' THEN
{     j := 0;
{     #translate (osv$upper_to_lower, argument_ptrs [1]^, argument_name);
{     IF argument_count = 1 THEN
{       IF (argument_name = 'preset_value') OR (argument_name = 'pv') OR (argument_name =
{         'termination_error_level') OR (argument_name = 'tel') THEN
{         STRINGREP (output_line_ptr^, j, '$string($program(', argument_name, '))');
{       IFEND;
{     ELSEIF argument_count > 1 THEN
{       IF (argument_name = 'load_map_option') OR (argument_name = 'lmo') THEN
{         output_line_ptr^ := '$subset($list(';
{         j := 14;
{         FOR j2 := 2 TO argument_count DO
{           #translate (osv$upper_to_lower, argument_ptrs [j2]^, temp_name);
{           output_line_ptr^ (j + 1, #SIZE (argument_ptrs [j2]^)) := temp_name;
{           j := j + #SIZE (argument_ptrs [j2]^);
{           IF j2 < argument_count THEN
{             output_line_ptr^ (j + 1, 2) := ', ';
{             j := j + 2;
{           IFEND;
{         FOREND;
{         output_line_ptr^ (j + 1, 29) := '), $program(load_map_option))';
{         j := j + 29;
{       IFEND;
{     IFEND;
{     name_to_flag := function_name;
{     output_line_size := j;

    ELSEIF function_name = '$SET_COUNT' THEN
      STRINGREP (output_line_ptr^, j, '$size($parameter_value(', argument_ptrs [1]^, '))');
      output_line_size := j;

    ELSEIF function_name = '$SEVERITY' THEN
      STRINGREP (output_line_ptr^, j, '$string($status_severity(', argument_ptrs [1]^, '))');
      output_line_size := j;
      name_to_flag := function_name;

{For compatibility reasons the following functions will not be translated at this time.

{   ELSEIF function_name = '$VALUE' THEN
{     j := 0;
{     output_line_ptr^ := '$value(';
{     j := 7;
{     IF argument_count = 4 THEN
{       #translate (osv$upper_to_lower, argument_ptrs [4]^, argument_name);
{       IF argument_name = 'low' THEN
{         output_line_ptr^ (8, 5) := '$low(';
{         j := 12;
{       ELSEIF argument_name = 'high' THEN
{         output_line_ptr^ (8, 6) := '$high(';
{         j := 13;
{       ELSE
{         osp$set_status_abnormal ('CL', cle$cannot_be_translated,
{           '$VALUE range_specification other than LOW or HIGH', status);
{         RETURN;
{       IFEND;
{     IFEND;
{     output_line_ptr^ (j + 1, #SIZE (argument_ptrs [1]^)) := argument_ptrs [1]^;
{     j := j + #SIZE (argument_ptrs [1]^);
{     IF argument_count > 1 THEN
{       STRINGREP (output_line_ptr^ (j + 1, * ), j2, '(', argument_ptrs [2]^, ')');
{       j := j + j2
{     IFEND;
{     IF argument_count > 2 THEN
{       STRINGREP (output_line_ptr^ (j + 1, * ), j2, '(', argument_ptrs [3]^, ')');
{       j := j + j2
{     IFEND;
{     IF argument_count = 4 THEN
{       output_line_ptr^ (j + 1, 1) := ')';
{       j := j + 1;
{     IFEND;
{     output_line_ptr^ (j + 1, 1) := ')';
{     output_line_size := j + 1;
{
{   ELSEIF function_name = '$VALUE_COUNT' THEN
{     j := 0;
{     IF (argument_count = 1) OR (argument_count = 2) THEN
{       STRINGREP (output_line_ptr^, j, '$size(', argument_ptrs [1]^);
{       IF argument_count = 2 THEN
{         STRINGREP (output_line_ptr^ (j + 1, * ), j2, '(', argument_ptrs [2]^, ')');
{         j := j + j2;
{       IFEND;
{       output_line_ptr^ (j + 1, 1) := ')';
{       j := j + 1;
{     IFEND;
{     output_line_size := j;
{
{   ELSEIF function_name = '$VALUE_KIND' THEN
{     j := 0;
{     output_line_ptr^ := '';
{     STRINGREP (output_line_ptr^, j, '$string($generic_type(');
{     IF argument_count = 4 THEN
{       IF argument_ptrs [4]^ = 'low' THEN
{         output_line_ptr^ (j + 1, 5) := '$low(';
{         j := j + 5;
{       ELSEIF argument_ptrs [4]^ = 'high' THEN
{         output_line_ptr^ (j + 1, 6) := '$high(';
{         j := j + 6;
{       ELSE
{         osp$set_status_abnormal ('CL', cle$cannot_be_translated,
{           '$VALUE_KIND range_specification other than LOW or HIGH', status);
{         RETURN;
{       IFEND;
{     IFEND;
{     output_line_ptr^ (j + 1, #SIZE (argument_ptrs [1]^)) := argument_ptrs [1]^;
{     j := j + #SIZE (argument_ptrs [1]^);
{     IF argument_count > 1 THEN
{       STRINGREP (output_line_ptr^ (j + 1, * ), j2, '(', argument_ptrs [2]^, ')');
{       j := j + j2
{     IFEND;
{     IF argument_count > 2 THEN
{       STRINGREP (output_line_ptr^ (j + 1, * ), j2, '(', argument_ptrs [3]^, ')');
{       j := j + j2
{     IFEND;
{     output_line_ptr^ (j + 1, 2) := '))';
{     j := j + 2;
{     IF argument_count = 4 THEN
{       output_line_ptr^ (j + 1, 1) := ')';
{       j := j + 1;
{     IFEND;
{     output_line_size := j;

    ELSEIF (function_name = '$VARIABLE') THEN
      #TRANSLATE (osv$upper_to_lower, argument_ptrs [2]^, argument_name);
      IF (argument_name = 'lower_bound') OR (argument_name = 'upper_bound') THEN
        STRINGREP (output_line_ptr^, j, '$', argument_name (1, clp$trimmed_string_size (argument_name)),
              '(', argument_ptrs [1]^, ')');
        output_line_size := j;
      ELSEIF argument_name = 'string_size' THEN
        STRINGREP (output_line_ptr^, j, '$size(', argument_ptrs [1]^, ')');
        output_line_size := j;
      ELSEIF (argument_name = 'declared') THEN
        name_to_flag := function_name;
        temp_index := function_end_index + 3;
        IF (array_ptr^ [temp_index].clt_kind = clc$lex_space) OR
              (array_ptr^ [temp_index].clt_kind = clc$lex_comment) THEN
          temp_index := temp_index + 1;
        IFEND;
        IF array_ptr^ [temp_index].clt_kind = clc$lex_equal THEN
          not_it := FALSE;
        ELSEIF array_ptr^ [temp_index].clt_kind = clc$lex_not_equal THEN
          not_it := TRUE;
        ELSE
          output_line_ptr^ := input_line_ptr^;
          output_line_size := clp$trimmed_string_size (input_line_ptr^);
          RETURN;
        IFEND;
        temp_index := temp_index + 1;
        IF (array_ptr^ [temp_index].clt_kind = clc$lex_space) OR
              (array_ptr^ [temp_index].clt_kind = clc$lex_comment) THEN
          temp_index := temp_index + 1;
        IFEND;
        IF array_ptr^ [temp_index].clt_kind <> clc$lex_string THEN
          output_line_ptr^ := input_line_ptr^;
          output_line_size := clp$trimmed_string_size (input_line_ptr^);
          RETURN;
        IFEND;
        IF array_ptr^ [temp_index].string_ptr^ = '''UNKNOWN''' THEN
          not_it := NOT not_it;
          temp_name := 'defined';
        ELSEIF array_ptr^ [temp_index].string_ptr^ = '''LOCAL''' THEN
          temp_name := 'local';
        ELSEIF array_ptr^ [temp_index].string_ptr^ = '''NONLOCAL''' THEN
          temp_name := 'nonlocal';
        ELSE
          output_line_ptr^ := input_line_ptr^;
          output_line_size := clp$trimmed_string_size (input_line_ptr^);
          RETURN;
        IFEND;
        function_end_index := temp_index;

        j2 := 0;
        IF not_it THEN
          function_name := '$variable';
          output_line_ptr^ := '$not(';
          j2 := 5;
        IFEND;
        STRINGREP (output_line_ptr^ (j2 + 1, * ), j, function_name
              (1, clp$trimmed_string_size (function_name)), '(', argument_ptrs [1]^,
              ', ', temp_name (1, clp$trimmed_string_size (temp_name)), ')');
        IF not_it THEN
          output_line_ptr^ (j2 + j + 1) := ')';
          j := j + j2 + 1;
        IFEND;
        output_line_size := j;
      ELSEIF argument_name = 'kind' THEN
        STRINGREP (output_line_ptr^, j, '$string($generic_type(', argument_ptrs [1]^, '))');
        output_line_size := j;
      ELSE
        output_line_ptr^ := input_line_ptr^;
        output_line_size := clp$trimmed_string_size (input_line_ptr^);
        RETURN;
      IFEND;
    IFEND;

  PROCEND clp$translate_function;

?? TITLE := '  get_arguments', EJECT ??

  PROCEDURE get_arguments
    (VAR {input, output} parse: clt$parse_state;
     VAR argument_count: 0 .. 10;
     VAR argument_ptrs: array [1 .. 10] of ^string ( * );
     VAR status: ost$status);

    VAR
      argument_begin_count: clt$command_line_size,
      argument_begin_index: clt$command_line_index;

    status.normal := TRUE;
    argument_count := 0;
    clp$scan_lexical_unit (clc$slu_any, parse);
    IF parse.unit.kind <> clc$lex_left_parenthesis THEN
      RETURN;
    IFEND;

    clp$scan_lexical_unit (clc$slu_non_space, parse);

    WHILE parse.unit.kind <> clc$lex_right_parenthesis DO
      argument_count := argument_count + 1;
      argument_begin_index := parse.unit_index;
      clp$scan_unnested_sep_lex_unit (clc$ignore_ellipsis, parse);
      argument_ptrs [argument_count] := ^parse.text^ (argument_begin_index,
            parse.unit_index - argument_begin_index);
      IF parse.unit_is_space THEN
        clp$scan_lexical_unit (clc$slu_non_space, parse);
      IFEND;
      IF parse.unit.kind = clc$lex_comma THEN
        clp$scan_lexical_unit (clc$slu_non_space, parse);
      IFEND;
      IF parse.unit.kind = clc$lex_end_of_line THEN
        osp$set_status_abnormal ('CL', 99999, 'no right paren', status);
        RETURN;
      IFEND;
    WHILEND;

  PROCEND get_arguments;

MODEND clm$translate_function;
