{ *************************************************************************** }
MODULE mod_parse_detail ;
{  Created  28-APR-1989  MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE }
{ *************************************************************************** }
INCLUDE 
  mod_common_parse, 
  mod_def_hardware_tables,
  mod_def_physics_tables,
  mod_common_soft_conn,
  mod_handle_tracing ;
{ *************************************************************************** }
EXPORT
  unknown_msg,       {PROCEDURE handles answer to unknown keywords parsed     }
  bad_format,        {PROCEDURE handles answer to bad format message          }
  bad_param,         {PROCEDURE handles answer to bad param  message          }
  bad_failure,       {PROCEDURE handles answer wehn execution failed          }
  ok_nochange,       {PROCEDURE handles answer to no change condition         }
  inline_check_noaction, {PROCEDURE checks the action type field is empty     }
  inline_extract_list, {PROCEDURE build a full list from items in prenthesis  }
  find_and_check_ranges, {PROCEDURE interpret reanges before next object id   }
  inline_check_command_count,   {PROCEDURE verifies the command list length   }
  inline_check_object_has_no_item, {PROCEDURE checks object carries no item   }
  inline_check_object_has_item,    {PROCEDURE checks object carries item list }
  inline_check_object_asserted, {PROCEDURE checks object is asserted          }
  inline_check_object_keyword,  {PROCEDURE checks object is a keyword         }
  inline_check_object_in_range, {PROCEDURE checks object is within a range    }
  inline_check_max_one_item,    {PROCEDURE checks item list is 1 item long max}
  inline_check_item_keyword,    {PROCEDURE checks item is a keyword           }
  inline_check_item_in_range,   {PROCEDURE checks item is within given range  }
  inline_check_item_asserted ;  {PROCEDURE checks item is asserted            }
{ *************************************************************************** }
IMPORT 

  parsed_command,                     {from module MOD_COMMON_PARSE           }
  command_count,                      {from module MOD_COMMON_PARSE           }
  parse_status,                       {from module MOD_COMMON_PARSE           }
  status_array,                       {from module MOD_COMMON_PARSE           }
  parse_code,{Parse_success,}Parse_failure, Parse_asserted, {Parse_negated,}
    Parse_par_found_empty, Parse_no_par_found, parse_not_in_list,
    Parse_lower_boundary,{Parse_upper_boundary,}Parse_found_keyword, 
  Keyword_code, Parse_illegal_keyword, Parse_kword_sign_eta, Parse_kword_neg, 
    Parse_kword_pos, Parse_kword_magn_eta, Parse_kword_phi,                  
                                      {from module MOD_COMMON_PARSE           }
                                                               
  eta_polarity, pos_e, neg_e,         {from module MOD_DEF_HARDWARE_TABLES    }
  eta_magnitude,                      {from module MOD_DEF_HARDWARE_TABLES    }
  phi_value,                          {from module MOD_DEF_HARDWARE_TABLES    }

  firstetasign,                       {from module MOD_DEF_PHYSICS_TABLES     }
  lastetasign,                        {from module MOD_DEF_PHYSICS_TABLES     }
  firstetamagn,                       {from module MOD_DEF_PHYSICS_TABLES     }
  lastetamagn,                        {from module MOD_DEF_PHYSICS_TABLES     }
  firstphival,                        {from module MOD_DEF_PHYSICS_TABLES     }
  lastphival,                         {from module MOD_DEF_PHYSICS_TABLES     }

  reqstmsg, replymsg,                 {from module MOD_COMMON_SOFT_CONN       }
  con_served,                         {from module MOD_COMMON_SOFT_CONN       }

 {trace_info,}trace_warn, trace_error,{from module MOD_HANDLE_TRACING         }
  inline_tracing,                     {from module MOD_HANDLE_TRACING         }
 {handle_trc_inf}                     {from module MOD_HANDLE_TRACING         }
  handle_trc_wrn,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_err ;                    {from module MOD_HANDLE_TRACING         }
{ *************************************************************************** }
{ *************************************************************************** }
TYPE
  SET_OF_parse_code    = SET OF parse_code ;
  SET_OF_eta_polarity  = SET OF eta_polarity ;
  SET_OF_eta_magnitude = SET OF eta_magnitude ;
  SET_OF_phi_value     = SET OF phi_value ;
  byte =[BYTE] 0..255 ;

VAR 
  tag : STRING(8) := 'PRS/DET%' ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE unknown_msg ( tagext : VARYING_STRING(8) := '' ) ;

BEGIN

  replymsg[con_served]^.replystat := '     BAD' ;
  replymsg[con_served]^.replysupl := ' UNKNOWN' ;
  parse_status := parse_failure ;

  IF ( inline_tracing(trace_error) <> 0 ) 
  THEN handle_trc_err ( TAG := 'PRS/KEY%' + tagext,
                    MESSAGE := ' Unknown Request Type: '
                             + reqstmsg[con_served]^.objecttype
                             + ' ' + reqstmsg[con_served]^.actiontype ) ;
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE ok_nochange ( tagext : VARYING_STRING(8) := '' ;
                   VAR command :[OPTIONAL] INTEGER ) ;

BEGIN

  replymsg[con_served]^.replystat := '      OK' ;
  replymsg[con_served]^.replysupl := 'NOCHANGE' ;

  IF ( inline_tracing(trace_warn) <> 0 ) 
  THEN BEGIN
    IF PRESENT(command) 
    THEN handle_trc_wrn ( TAG := 'PRS/ITM%' + tagext,
                      MESSAGE := ' Configuration Unchanged at Command#' 
                               + CONVERT(STRING,command) ) 
    ELSE handle_trc_wrn ( TAG := 'PRS/ITM%' + tagext,
              MESSAGE := ' Detection of an Item Unchanged by this Command' ) ;
  END ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE bad_format ( tagext : VARYING_STRING(8) := '' ;
                  VAR command :[OPTIONAL] INTEGER ) ;
BEGIN

  replymsg[con_served]^.replystat := '     BAD' ;
  replymsg[con_served]^.replysupl := '  FORMAT' ;
  parse_status := parse_failure ;

  IF ( inline_tracing(trace_error) <> 0 ) 
  THEN BEGIN
    IF PRESENT(command) 
    THEN handle_trc_err ( TAG := 'PRS/OBJ%' + tagext,
                      MESSAGE := ' Inappropriate Syntax at or after command #' 
                               + CONVERT(STRING,command) ) 
    ELSE handle_trc_err ( TAG := 'PRS/OBJ%' + tagext,
                      MESSAGE := ' Bad Syntax parsed in message' ) ; 
  END ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE bad_param ( tagext : VARYING_STRING(8) := '' ; 
                     command : INTEGER ) ;
BEGIN

  replymsg[con_served]^.replystat := '     BAD' ;
  replymsg[con_served]^.replysupl := '   PARAM' ;
  parse_status := parse_failure ;

  IF ( inline_tracing(trace_error) <> 0 ) 
  THEN handle_trc_err ( TAG := 'PRS/ITM%' + tagext,
                    MESSAGE := ' Inappropriate Param at command #'
                             + CONVERT(STRING,command) ) ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE bad_failure ( tagext : VARYING_STRING(8) := '' ;
                   VAR command :[OPTIONAL] INTEGER ) ;
BEGIN

  replymsg[con_served]^.replystat := '     BAD' ;
  replymsg[con_served]^.replysupl := ' FAILURE' ;

  IF ( inline_tracing(trace_error) <> 0 ) 
  THEN BEGIN
    IF PRESENT(command) 
    THEN handle_trc_err ( TAG := 'PRS/EXE%' + tagext,
                      MESSAGE := ' Execution Failure at command #'
                               + CONVERT(STRING,command) ) 
    ELSE handle_trc_err ( TAG := 'PRS/EXE%' + tagext,
                      MESSAGE := ' Execution Failure Detected ' ) ;
  END ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
[INLINE] PROCEDURE inline_check_noaction ( tagext : VARYING_STRING(8) := '' ) ; 
BEGIN
  IF ( reqstmsg[con_served]^.actiontype <> '        ' ) 
  THEN unknown_msg ( TAGEXT:= tagext ) ;           
END;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE inline_extract_list ( tagext : VARYING_STRING(8) := '' ;
                           VAR command : INTEGER ;
                             minitemid : INTEGER ; maxitemid : INTEGER ;
                              accepted : SET_OF_parse_code ;
                                  list :^status_array(minitemid,maxitemid) ) ; 
VAR object, i : INTEGER ;
BEGIN

  object := parsed_command^[command].objid ;

  FOR i := minitemid TO maxitemid DO list^[i] := parse_not_in_list ;
  
  IF ( parsed_command^[command].itemcode <> parse_par_found_empty ) 
  THEN REPEAT 

    IF ( command > command_count ) THEN GOTO quit_extract_list ;

    inline_check_item_in_range ( TAGEXT := tagext,
                                COMMAND := command, 
                                    LOW := minitemid, 
                                   HIGH := maxitemid );
    IF NOT ( parsed_command^[command].itemcode IN accepted ) 
    THEN bad_format ( TAGEXT := tagext, COMMAND := command ) ;

    IF ( parse_status = parse_failure ) THEN GOTO quit_extract_list ;

    list^[parsed_command^[command].itemid]:=parsed_command^[command].itemcode ;
    command := command + 1 ;
  UNTIL ( parsed_command^[command].objid <> object ) 
  ELSE command := command + 1 ;

quit_extract_list:
END;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE find_and_check_ranges ( tagext : VARYING_STRING(8) := '' ;
                             VAR command : INTEGER ;
                      VAR eta_sign_range :[OPTIONAL] SET_OF_eta_polarity ;
                      VAR eta_magn_range :[OPTIONAL] SET_OF_eta_magnitude ;
                           VAR phi_range :[OPTIONAL] SET_OF_phi_value ) ;
BEGIN

  { *** parse tower coordinate keywords and ranges                          }

  WHILE ( ( parsed_command^[command].objcode = Parse_found_keyword )
      AND ( command <= command_count ) )
  DO BEGIN

    CASE CONVERT(keyword_code,parsed_command^[command].objid) OF 

      Parse_kword_sign_eta : 
        IF PRESENT( eta_sign_range ) 
        THEN BEGIN
          eta_sign_range := [] ; 
          find_members_sign_eta ( TAGEXT := tagext, COMMAND := command, 
                          ETA_SIGN_RANGE := eta_sign_range )
        END
        ELSE bad_format ( TAGEXT := tagext, COMMAND := command ) ;

      Parse_kword_magn_eta :         
        IF PRESENT( eta_magn_range ) 
        THEN BEGIN
          eta_magn_range := [] ; 
          find_members_magn_eta ( TAGEXT := tagext, COMMAND := command,
                          ETA_MAGN_RANGE := eta_magn_range )
        END 
        ELSE bad_format ( TAGEXT := tagext, COMMAND := command ) ;

      Parse_kword_phi : 
        IF PRESENT( phi_range ) 
        THEN BEGIN
          phi_range := [] ; 
          find_members_phi_val ( TAGEXT := tagext, COMMAND := command, 
                              PHI_RANGE := phi_range )
        END
        ELSE bad_format ( TAGEXT := tagext, COMMAND := command ) ;

      OTHERWISE 
        GOTO quit_parse_range ;

    END ;

    IF ( parse_status = parse_failure ) THEN GOTO quit_parse_range ;

  END ;
  
quit_parse_range: 
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE find_members_sign_eta ( tagext : VARYING_STRING(8) := '' ;
                             VAR command : INTEGER ;
                      VAR eta_sign_range : SET_OF_eta_polarity ) ;
BEGIN

  WHILE ( ( parsed_command^[command].objcode = Parse_found_keyword ) 
      AND ( CONVERT(keyword_code,parsed_command^[command].objid)  
                                                       = Parse_kword_sign_eta )
      AND ( command <= command_count ) )
  DO BEGIN

    IF ( parsed_command^[command].itemcode = Parse_found_keyword ) 
    THEN CASE CONVERT(keyword_code,parsed_command^[command].itemid) OF 

      Parse_kword_pos : 
        IF ( firstetasign <> pos_e ) 
        THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 
        ELSE eta_sign_range := eta_sign_range + [pos_e] ;

      Parse_kword_neg : 
        IF ( lastetasign <> neg_e ) 
        THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 
        ELSE eta_sign_range := eta_sign_range + [neg_e] ;

      OTHERWISE 
        bad_format ( TAGEXT := tagext, COMMAND := command ) ;

    END 
    ELSE bad_format ( TAGEXT := tagext, COMMAND := command ) ;

    IF ( parse_status = parse_failure ) THEN GOTO quit_parse_sign_eta ;
    command := command + 1 ;

  END ;

quit_parse_sign_eta: 
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE find_members_magn_eta ( tagext : VARYING_STRING(8) := '' ;
                             VAR command : INTEGER ;
                      VAR eta_magn_range : SET_OF_eta_magnitude ) ;

BEGIN

  WHILE ( ( parsed_command^[command].objcode = Parse_found_keyword ) 
      AND ( CONVERT(keyword_code,parsed_command^[command].objid)  
                                                       = Parse_kword_magn_eta )
      AND ( command <= command_count ) )
  DO BEGIN

    CASE parsed_command^[command].itemcode OF 

      Parse_asserted : 
        BEGIN
  
          IF ( parsed_command^[command].itemid < firstetamagn::BYTE )
          THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 

          ELSE IF ( parsed_command^[command].itemid > lastetamagn::BYTE )
          THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 

          ELSE eta_magn_range := eta_magn_range + 
            [parsed_command^[command].itemid::eta_magnitude] ;

          command := command + 1 ;

        END ;

      Parse_lower_boundary : 
        BEGIN

          if ( parsed_command^[command].itemid < firstetamagn::BYTE )
          THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 

          ELSE IF ( parsed_command^[command+1].itemid > lastetamagn::BYTE )
          THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 

          ELSE eta_magn_range := eta_magn_range + 
                            [parsed_command^[command].itemid::eta_magnitude..
                             parsed_command^[command+1].itemid::eta_magnitude] ;

          command := command + 2 ;

        END ;

      OTHERWISE 
        bad_format ( TAGEXT := tagext, COMMAND := command ) ;

    END ;

    IF ( parse_status = parse_failure ) THEN GOTO quit_parse_magn_eta ;

  END ;
  
quit_parse_magn_eta: 
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE find_members_phi_val ( tagext : VARYING_STRING(8) := '' ;
                            VAR command : INTEGER ;
                          VAR phi_range : SET_OF_phi_value ) ;

BEGIN

  WHILE ( ( parsed_command^[command].objcode = Parse_found_keyword ) 
      AND ( CONVERT(keyword_code,parsed_command^[command].objid) 
                                                       = Parse_kword_phi )
      AND ( command <= command_count ) )
  DO BEGIN

    CASE parsed_command^[command].itemcode OF 

      Parse_asserted : 
        BEGIN
  
          IF ( parsed_command^[command].itemid < firstphival::BYTE )
          THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 

          ELSE IF ( parsed_command^[command].itemid > lastphival::BYTE )
          THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 

          ELSE phi_range := phi_range + 
            [parsed_command^[command].itemid::phi_value] ;

          command := command + 1 ;

        END ;

      Parse_lower_boundary : 
        BEGIN

          IF ( parsed_command^[command].itemid < firstphival::BYTE )
          THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 

          ELSE IF ( parsed_command^[command+1].itemid > lastphival::BYTE )
          THEN bad_param ( TAGEXT := tagext, COMMAND := command ) 

          ELSE phi_range := phi_range + 
                            [parsed_command^[command].itemid::phi_value..
                             parsed_command^[command+1].itemid::phi_value] ;

          command := command + 2 ;

        END ;

      OTHERWISE 
        bad_format ( TAGEXT := tagext, COMMAND := command ) ;

    END ;

    IF ( parse_status = parse_failure ) THEN GOTO quit_parse_phi_val ;

  END ;
  

quit_parse_phi_val:
END ;
{ *************************************************************************** }
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_command_count ( tagext : VARYING_STRING(8) := '' ;
                                        total : INTEGER := -1 ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := total ;
  IF ( total >= 0 )
  THEN BEGIN
    IF ( command_count <> total ) 
    THEN bad_format ( TAGEXT:= tagext, COMMAND := temp ) ;           
  END 
  ELSE BEGIN
    IF ( command_count = 0 ) 
    THEN bad_format ( TAGEXT:= tagext, COMMAND := temp ) ;           
  END ;
END ;
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_object_has_no_item ( tagext : VARYING_STRING(8) := '' ;
                                           command : INTEGER ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := command ;
  IF ( parsed_command^[command].itemcode <> parse_no_par_found ) 
  THEN bad_format ( TAGEXT := tagext, COMMAND := temp ) ; 
END ;
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_object_has_item ( tagext : VARYING_STRING(8) := '' ;
                                        command : INTEGER ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := command ;
  IF ( parsed_command^[command].itemcode = parse_no_par_found ) 
  THEN bad_format ( TAGEXT := tagext, COMMAND := temp ) ; 
END ;
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_object_asserted ( tagext : VARYING_STRING(8) := '' ;
                                        command : INTEGER ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := command ;
  IF ( parsed_command^[command].objcode <> parse_asserted ) 
  THEN bad_format ( TAGEXT := tagext, COMMAND := temp ) ; 
END ;
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_object_keyword ( tagext : VARYING_STRING(8) := '' ;
                                       command : INTEGER ;
                        keyword : keyword_code := Parse_illegal_keyword ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := command ;
  IF ( parsed_command^[command].objcode <> parse_found_keyword ) 
  THEN bad_format ( TAGEXT := tagext, COMMAND := temp ) 
  ELSE IF ( keyword <> Parse_illegal_keyword ) 
       THEN IF ( parsed_command^[command].objid <> ORD(keyword) ) 
            THEN bad_format ( TAGEXT := tagext, COMMAND := temp ) ; 
END ;
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_object_in_range ( tagext : VARYING_STRING(8) := '' ;
                                        command : INTEGER ;
                                            low : INTEGER := 0 ;
                                           high : INTEGER ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := command ;
  IF ( ( parsed_command^[command].objid > high ) 
    OR ( parsed_command^[command].objid < low  ) )
  THEN bad_param ( TAGEXT := tagext, COMMAND := temp ) ; 
END ;
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_item_keyword ( tagext : VARYING_STRING(8) := '' ;
                                     command : INTEGER ;
                        keyword : keyword_code := Parse_illegal_keyword ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := command ;
  IF ( parsed_command^[command].itemcode <> parse_found_keyword ) 
  THEN bad_format ( TAGEXT := tagext, COMMAND := temp ) 
  ELSE IF ( keyword <> Parse_illegal_keyword ) 
       THEN IF ( parsed_command^[command].itemid <> ORD(keyword) ) 
            THEN bad_format ( TAGEXT := tagext, COMMAND := temp ) ; 
END ;
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_item_in_range ( tagext : VARYING_STRING(8) := '' ;
                                      command : INTEGER ;
                                          low : INTEGER := 0 ;
                                         high : INTEGER ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := command ;
  IF ( ( parsed_command^[command].itemid > high )  
    OR ( parsed_command^[command].itemid < low  ) )
  THEN bad_param ( TAGEXT := tagext, COMMAND := temp ) ; 
END ;
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_max_one_item ( tagext : VARYING_STRING(8) := '' ;
                                     command : INTEGER ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := command ;
  IF ( command < command_count )  
  THEN IF ( ( parsed_command^[command].objid   = parsed_command^[command+1].objid )
        AND ( parsed_command^[command].objcode = parsed_command^[command+1].objcode ) )
  THEN bad_format ( TAGEXT := tagext, COMMAND := temp ) ; 
END ;
{ *************************************************************************** }
[INLINE] 
PROCEDURE inline_check_item_asserted ( tagext : VARYING_STRING(8) := '' ;
                                      command : INTEGER ) ;
VAR temp : INTEGER ;
BEGIN 
  temp := command ;
  IF ( parsed_command^[command].itemcode <> parse_asserted )  
  THEN bad_format ( TAGEXT := tagext, COMMAND := temp ) ; 
END ;
{ *************************************************************************** }
{ *************************************************************************** }
END .