?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Expression Scanner' ??
MODULE clm$scan_expression;

{
{ PURPOSE:
{   This module contains the original SCL command expression evaluation
{   procedure.  This interface has been supplanted by clp$evaluate_expression
{   but still exists for compatibility with system levels prior to NOS/VE
{   release 1.3.1.
{
{ DESIGN:
{   The (old style) value kind specifier is translated to a (new) type
{   description.  The internal version of the (new) expression evaluator is
{   called.  If appropriate, an "old style" application value scanner is called
{   to produce the "old style" result or the data value is simply converted to
{   the "old style" result.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$value
*copyc cle$ecc_parsing
*copyc cle$unable_to_call_av_scanner
*copyc clk$scan_expression
*copyc clt$value_kind_specifier
*IF NOT $true(osv$unix)
*copyc oss$job_paged_literal
*IFEND
*copyc ost$status
?? POP ??
*copyc clp$append_status_parse_state
*copyc clp$convert_value_to_clt$value
*copyc clp$get_work_area
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*copyc clp$internal_evaluate_expr
*copyc clp$scan_non_space_lexical_unit
*copyc clp$translate_vks
*copyc osp$append_status_parameter
*IF NOT $true(osv$unix)
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*IFEND
*copyc osp$set_status_abnormal
*IF NOT $true(osv$unix)
*copyc pmp$continue_to_cause
*copyc pmp$load
*IFEND

?? TITLE := 'clv$value_descriptors', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$value_descriptors: [XDCL, READ, oss$job_paged_literal] array
*ELSE
    clv$value_descriptors: [XDCL, READ] array
*IFEND
          [clc$variable_reference .. clc$status_value] of string (8) := ['VARIABLE', 'FILE', 'NAME', 'STRING',
          'REAL', 'INTEGER', 'BOOLEAN', 'STATUS'];

*IF NOT $true(osv$unix)
?? TITLE := 'clp$scan_expression', EJECT ??
*copyc clh$scan_expression

  PROCEDURE [XDCL, #GATE] clp$scan_expression
    (    expression: string ( * );
         value_kind_specifier: clt$value_kind_specifier;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      application_type_present: boolean,
      ignore_result_type_description: ^clt$type_description,
      lexical_units: ^clt$lexical_units,
      local_status: ost$status,
      original_work_area: ^clt$work_area,
      parse: clt$parse_state,
      result: ^clt$data_value,
      type_description: clt$type_description,
      work_area_ptr: ^^clt$work_area;

?? NEWTITLE := 'handle_application_value', EJECT ??

    PROCEDURE handle_application_value;

      VAR
        application_value_scanner: ^clt$application_value_scanner,
        callers_save_area: ^ost$stack_frame_save_area,
        loaded_address: pmt$loaded_address;

?? NEWTITLE := 'bad_av_scanner_pointer_handler', EJECT ??

      PROCEDURE bad_av_scanner_pointer_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
              ((($pmt$system_conditions [pmc$instruction_specification, pmc$address_specification,
              pmc$access_violation, pmc$environment_specification, pmc$invalid_segment_ring_0,
              pmc$out_call_in_return]) * condition.system_conditions) <> $pmt$system_conditions [])) AND
              (save_area^.minimum_save_area.a2_previous_save_area = callers_save_area) THEN
          osp$set_status_abnormal ('CL', cle$unable_to_call_av_scanner, value_kind_specifier.value_name,
                status);
          EXIT handle_application_value;
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

      PROCEND bad_av_scanner_pointer_handler;
?? OLDTITLE, EJECT ??

      CASE value_kind_specifier.scanner.kind OF
      = clc$linked_av_scanner =
        application_value_scanner := value_kind_specifier.scanner.proc;
      = clc$unlinked_av_scanner =
        pmp$load (value_kind_specifier.scanner.name, pmc$procedure_address, loaded_address, local_status);
        IF NOT local_status.normal THEN
          osp$set_status_abnormal ('CL', cle$unable_to_call_av_scanner, value_kind_specifier.value_name,
                local_status);
          RETURN;
        IFEND;
        #CONVERT_POINTER_TO_PROCEDURE (loaded_address.pointer_to_procedure, application_value_scanner);
      ELSE
        application_value_scanner := ^clp$unspecified_av_scanner;
      CASEND;

*IF NOT $true(osv$unix)
      callers_save_area := #PREVIOUS_SAVE_AREA ();
*ELSE
      callers_save_area := NIL;
*IFEND
      #SPOIL (callers_save_area);
      osp$establish_condition_handler (^bad_av_scanner_pointer_handler, FALSE);

      value.descriptor := value_kind_specifier.value_name;
      value.kind := clc$application_value;

      application_value_scanner^ (value_kind_specifier.value_name, value_kind_specifier.keyword_values,
            result^.application_value^, value, local_status);

      osp$disestablish_cond_handler;

    PROCEND handle_application_value;
?? OLDTITLE, EJECT ??

    #KEYPOINT (osk$entry, 0, clk$scan_expression);

    status.normal := TRUE;
    local_status.normal := TRUE;
    original_work_area := NIL;

  /evaluate/
    BEGIN
*IF NOT $true(osv$unix)
      clp$get_work_area (#RING (^work_area_ptr), work_area_ptr, local_status);
*ELSE
      clp$get_work_area (osc$user_ring, work_area_ptr, local_status);
*IFEND
      IF NOT local_status.normal THEN
        EXIT /evaluate/;
      IFEND;
      original_work_area := work_area_ptr^;

      clp$translate_vks (value_kind_specifier, FALSE, work_area_ptr^, application_type_present,
            type_description, local_status);
      IF NOT local_status.normal THEN
        EXIT /evaluate/;
      IFEND;

      clp$identify_lexical_units (^expression, work_area_ptr^, lexical_units, local_status);
      IF NOT local_status.normal THEN
        EXIT /evaluate/;
      IFEND;

      clp$initialize_parse_state (^expression, lexical_units, parse);
      clp$scan_non_space_lexical_unit (parse);

      clp$internal_evaluate_expr (parse, ^type_description, work_area_ptr^, ignore_result_type_description,
            result, local_status);
      IF NOT local_status.normal THEN
        EXIT /evaluate/;
      IFEND;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;
      IF parse.unit.kind <> clc$lex_end_of_line THEN
        osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', local_status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, local_status);
        EXIT /evaluate/;
      IFEND;

      IF result^.kind = clc$unspecified THEN
        osp$set_status_abnormal ('CL', cle$unspecified_value_for_req, 'clp$scan_expression', local_status);
        osp$append_status_parameter (osc$status_parameter_delimiter, expression, local_status);
      IFEND;

      IF application_type_present AND (result^.kind = clc$application) THEN
        handle_application_value;
      ELSE
        clp$convert_value_to_clt$value (result, 1, 1, clc$low, value, local_status);
      IFEND;
    END /evaluate/;

    IF original_work_area <> NIL THEN
      work_area_ptr^ := original_work_area;
    IFEND;

    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

    #KEYPOINT (osk$exit, 0, clk$scan_expression);

  PROCEND clp$scan_expression;
?? TITLE := 'clp$unspecified_av_scanner', EJECT ??

  PROCEDURE [XDCL] clp$unspecified_av_scanner
    (    value_name: clt$application_value_name;
         keyword_values: ^array [1 .. * ] of ost$name;
         text: string ( * );
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      application_area: ^clt$application_value,
      application_string: ^ost$string;


    application_area := ^value.application;
    RESET application_area;
    NEXT application_string IN application_area;
    IF STRLENGTH (text) <= osc$max_string_size THEN
      application_string^.size := STRLENGTH (text);
    ELSE
      application_string^.size := osc$max_string_size;
    IFEND;
    application_string^.value := text;

  PROCEND clp$unspecified_av_scanner;
*IFEND

MODEND clm$scan_expression;
