# University of Illinois/NCSA
# Open Source License
#
# Copyright (c) 2013-2015, Advanced Micro Devices, Inc.
# All rights reserved.
#
# Developed by:
#
#     HSA Team
#
#     Advanced Micro Devices, Inc
#
#     www.amd.com
#
# Permission is hereby granted, free of charge, to any person obtaining a copy of
# this software and associated documentation files (the "Software"), to deal with
# the Software without restriction, including without limitation the rights to
# use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
# of the Software, and to permit persons to whom the Software is furnished to do
# so, subject to the following conditions:
#
#     * Redistributions of source code must retain the above copyright notice,
#       this list of conditions and the following disclaimers.
#
#     * Redistributions in binary form must reproduce the above copyright notice,
#       this list of conditions and the following disclaimers in the
#       documentation and/or other materials provided with the distribution.
#
#     * Neither the names of the LLVM Team, University of Illinois at
#       Urbana-Champaign, nor the names of its contributors may be used to
#       endorse or promote products derived from this Software without specific
#       prior written permission.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
# FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
# CONTRIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS WITH THE
# SOFTWARE.
use v5.10;
use Carp;
use warnings;
use strict;

###############################################################################
###############################################################################
###############################################################################
####
#### 1. HDL: A LANGUAGE FOR HSAIL INSTRUCTIONS DESCRIPTION
####
#### 1.1 PURPOSE
####
#### HDL has been developed for compact and powerful description of properties of
#### HSAIL instructions. This description is an input for HDLProcessor which is
#### used to generate various HSAIL Assembler components.
####
#### 1.2 IDENTIFIERS
####
#### HDL identifiers may include alphanumeric characters, '.' and "_".
#### '.' is useful only for better readability; it is internally replaced with "_".
####
#### 1.3 PROPERTIES AND VALUES
####
#### Property is an abstract entity which describes some feature of HSAIL instruction.
#### Examples of properties are 'type' and 'operand 0'. Each property has a list of
#### possible values described by HDL identifiers.
####
#### There several kinds of properties:
####     - brig properties
####     - brig bit properties
####     - extended properties
####     - meta properties
####
#### 1.3.1 BRIG PROPERTIES
####
#### Brig properties correspond to Brig fields; their values may only include
#### identifiers defined by HSAIL standard. These values are specified without 'Brig'
#### prefix, for example:
####
####     BrigProp geom = geom_1d, geom_1db, geom_2d, geom_1da, geom_3d, geom_2da;
####
#### Values of brig properties may be added using '+=' operator, for example:
####
####     BrigProp geom  = geom_1d;
####     BrigProp geom += geom_1db, geom_2d;
####     BrigProp geom += geom_1da, geom_3d, geom_2da;
####
#### This may be useful for HSAIL Extensions which define non-standard BRIG properties.
####
#### 1.3.2 BRIG BIT PROPERTIES
####
#### One special case is Brig Bit properties. They do correspond to Brig fields but can
#### only have two values: 0 and 1. These values are predefined and must not be
#### described. These properties also have autogenerated aliases: 'none' for 0 and
#### 'any' for (0, 1). For example:
####
####     BrigBitProp ftz;
####
#### 1.3.3 EXTENDED PROPERTIES
####
#### Extended properties do not necessary have direct mapping to Brig fields (but they might).
#### They are useful to describe more complex requirements which may involve several
#### independent Brig fields. Semantics of these properties are user-defined; their values
#### may include any user-defined identifiers. For example:
####
####     ExtProp rounding = none, float, int;
####     ExtProp modifier = none, hi, ftz, fbar;
####     ExtProp operand  = null, reg, imm, ws, addr, lab, func;
####
#### Note 1. Values may only be used in context which assumes specific property, so there
#### is no ambiguity with identical values such as 'none' in the previous example.
####
#### Note 2. Name of an _extended_ property value may have a suffix (separated with ".")
#### which describes additional property attribute. See description of attributes below.
####
#### 1.3.4 META PROPERTIES
####
#### Meta properties are used to describe dependencies between properties which are inconvenient
#### or impossible to express in HDL. For example:
####
####     MetaProp typesize =
####         atomic, // type size must be 32 for small model and 32/64 for large model
####         model,  // type size must be 32 or 64 depending on machine model
####         seg;    // type must be b32/b64 depending on _instruction_ segment
####
#### 1.4 ABBREVIATIONS
####
#### Some properties may include a long list of similar values; round brackets may
#### help by describing generic part only once. For example, previously defined
#### 'geom' property may be redefined as follows:
####
####     BrigProp geom = geom_(1d, 1db, 2d, 1da, 3d, 2da);
####
#### or in more cryptic manner:
####
####     BrigProp geom = geom_((1, 2, 3)d, (1, 2)da, 1db);
####
#### 1.5 ALIASES
####
#### Aliases is yet another feature for those who like brevity and expression.
#### An alias simply provides a synonym for one value or a list of values.
#### For example:
####
####     BrigProp geom = geom_(1d, 1db, 2d, 1da, 3d, 2da);
####
####     Alias 1d = geom_1d;
####     Alias 2d = geom_2d;
####     Alias 3d = geom_3d;
####     Alias regular = (1, 2, 3)d;
####
#### Inline aliases provide an alternative:
####
####     BrigProp geom =
####         1d = geom_1d,
####         2d = geom_2d,
####         3d = geom_3d,
####         geom_(1db, 1da, 2da);
####
####     Alias regular = (1, 2, 3)d;
####
#### Note 1: Alias definition apply to the last defined property.
#### Note 2: Aliases are similar to values in that they may only be used in context
#### which assumes specific property, so there is no ambiguity with identical values
#### defined for different properties. However, names of properties and aliases
#### must be different.
#### Note 3: Expansion of bracketed lists is performed before alias expansion.
####
#### 1.6 CLONES
####
#### Some properties may describe different entities but have the same list of values.
#### For example, an instruction may have both instruction type and source type
#### which are basically the same:
####
####     BrigProp type  = b1, b8, b16, ...;
####     BrigProp stype = b1, b8, b16, ...;
####
#### This duplication may be avoided by cloning:
####
####     BrigProp type  = b1, b8, b16, ...;
####     Clone stype;
####
#### Note. This directive define new clone(s) for the last defined property.
####
#### 1.7 ATTRIBUTES
####
#### Property is described by a set of values. If a subset of values
#### has something in common, it may be expressed by an attribute
#### written as the last suffix separated by '.' or '_'.
#### Examples of property values with attributes are:
####
####    reg.generic  # register type = instruction type
####    imm.generic  # immediate type = instruction type
####    reg.stype    # register type = source type
####    imm.stype    # immediate type = source type
####
#### Attributes are useful in the following cases:
####    - There is a set of values that differ only in attribute,
####      for example, reg.generic and reg.stype.
####    - Property values must have identical attributes
####      or no attributes.
####
#### For these cases HDL has a special construct called
#### attribute:
####
####     Attr generic, stype;
####
#### This declaration has the following consequences:
####
####     1. HDL will check that all property values specified
####        in a requirement (see next section) have either the same
####        attribute or no attribute at all.
####
####        For example, the following declarations are valid:
####            s2 = (reg, imm).stype;  # attr = stype
####            s3 = func, lab;         # attr = none
####        The following declarations are invalid:
####            s2 = reg.stype, imm.generic;  # different attributes
####            s3 = reg.stype, lab;          # different attributes
####
####      2. HDL will extract attribute from property
####         and generate 2 different checks: one for the
####         set of provided values and the second for the attribute.
####
#### Note 1. Attr definitions apply to the last defined property.
#### Note 2. Attributes may be defined for non-brig properties only.
####
#### 1.8 REQUIREMENTS
####
#### A simple requirement is a list of ASSERTIONS:
####
####     Req Name { <assertion 1>; <assertion 2>; ... }
####
#### Each assertion describes a property and values it can take. For example:
####
####     Req d0.s1.s2.s3      // Description of standard 4-operand instruction
####     {
####         d0 = reg;        // Destination operand must be a register
####         s1 = reg, imm;   // First, second and third source operands
####         s2 = reg, imm;   //     must be registers or immediate values
####         s3 = reg, imm;
####         s4 = null;       // Last operand must be null
####     }
####
#### Some properties may depend on values of other properties. This may be
#### expressed using VARIANTS:
####
####     <variant 1>
####     <variant 2>
####     ...
####     <variant N>;
####
#### The trailing semicolon is required to label the last alternative.
####
#### Each variant is expressed using CONDITIONS and ASSERTIONS:
####
####     { <condition 1>; <condition 2>; ... ? <assertion 1>; <assertion 2>; ... }
####
#### For example:
####
####     { type = (s, u)(32, 64) ? rounding = none;  modifier = none      }
####     { type = f              ? rounding = float; modifier = none, ftz }
####     ;
####
#### Requirements may also include references to other (previously defined) requirements,
#### for example:
####
####     Req div
####     {
####         type    = (s, u)(32, 64), f;
####         packing = none;
####
####         { type = (s, u)(32, 64) ? rounding = none;  modifier = none      }
####         { type = f              ? rounding = float; modifier = none, ftz }
####         ;
####
####         d0.s1.s2; // Refer another requirement
####     }
####
#### 1.9 INSTRUCTIONS
####
#### Having defined a requirement that describes limitations on instruction properties,
#### the instruction may be specified as follows:
####
####     Inst Div(Mod, div) // Instruction 'Div' has 'InstMod' format and must comply with requirement 'div'
####
#### 1.10 COMMENTS
####
#### HDL supports C++ style comments:
####
####     // This is a comment
####
#### 1.11 MISC
####
#### BrigPrefix is a optional directive which may be used to specify Brig suffix
#### for the last defined property. This property must be a Brig property.
#### For example:
####
####     BrigProp geom = 1d,  2d,  3d, 1db, 1da, 2da;
####     BrigPrefix GEOMETRY; // Generated values will look like this: BRIG_GEOMETRY_1D
####
#### 1.12 TESTGEN-SPECIFIC DIRECTIVES
####
#### Directives described in this section are optional. They are only necessary for HDL
#### intended for TestGen generation. These directives describe implicit dependencies
#### between properties which cannot be gathered by analysis of requirements:
####
####    Affects   <list of properties>;
####    DependsOn <list of properties>;
####
#### Both directives describe dependencies between the last defined property (and its aliases)
#### and the specified properties. These directives are subject to the following limitations:
####
####     - Meta properties cannot depend on other properties;
####     - Brig properties can only depend on meta-properties.
####
#### These limitations are intended to avoid circular dependencies between
#### properties and make implementation easier.
####
#### 1.13 GRAMMAR
####
####     Definitions ::= { PropDef | BitPropDef | AliasDef | AttrDef | CloneDef | ReqDef | InstDef | PrefDef | AffectsDef | DependsDef}
####
####     PropDef     ::= ("BrigProp" | "ExtProp" | "MetaProp") PropName "=" ValDef { "," ValDef } ";"
####
####     BitPropDef  ::= "BrigBitProp" PropName ";"
####
####     ValDef      ::= NameList | ( AliasName "=" NameGroup )
####
####     AliasDef    ::= "Alias" AliasName "=" NameList ";"
####     AttrDef     ::= "Attr"  AttrName  "=" NameList ";"
####     CloneDef    ::= "Clone" NameList ";"
####
####     AffectsDef  ::= "Affects"   NameList ";"
####     DependsDef  ::= "DependsOn" NameList ";"
####
####     ReqDef      ::= "Req" ReqName "{" { Assert } "}"
####     Assert      ::= PropChk | Variants | ReqRef
####
####     PropChk     ::= PropName "=" NameList ";"
####     Variants    ::= Variant { Variant } ";"
####     Variant     ::= "{" PropChk { PropChk } "?" { Assert } "}"
####     ReqRef      ::= ReqName ";"
####
####     InstDef     ::= "Inst" InstName "(" FormatName "," ReqName ")"
####
####     NameGroup   ::= Id | "(" NameList ")" | NameGroup "(" NameList ")" | "(" NameList ")" NameGroup
####     NameList    ::= NameGroup { "," NameGroup }
####
####     PrefDef     ::= "BrigPrefix" Id ";"
####
####     PropName    ::= Id
####     ValName     ::= Id
####     AliasName   ::= Id
####     AttrName    ::= Id
####     CloneName   ::= Id
####     ReqName     ::= Id
####     InstName    ::= Id
####     FormatName  ::= Id
####
###############################################################################
###############################################################################
###############################################################################
my $textLicense = "// University of Illinois/NCSA
// Open Source License
//
// Copyright (c) 2013-2015, Advanced Micro Devices, Inc.
// All rights reserved.
//
// Developed by:
//
//     HSA Team
//
//     Advanced Micro Devices, Inc
//
//     www.amd.com
//
// Permission is hereby granted, free of charge, to any person obtaining a copy of
// this software and associated documentation files (the \"Software\"), to deal with
// the Software without restriction, including without limitation the rights to
// use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
// of the Software, and to permit persons to whom the Software is furnished to do
// so, subject to the following conditions:
//
//     * Redistributions of source code must retain the above copyright notice,
//       this list of conditions and the following disclaimers.
//
//     * Redistributions in binary form must reproduce the above copyright notice,
//       this list of conditions and the following disclaimers in the
//       documentation and/or other materials provided with the distribution.
//
//     * Neither the names of the LLVM Team, University of Illinois at
//       Urbana-Champaign, nor the names of its contributors may be used to
//       endorse or promote products derived from this Software without specific
//       prior written permission.
//
// THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
// FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
// CONTRIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS WITH THE
// SOFTWARE.\n";

my $dump;

my $validateTestGen = 1; # generate validator for self-check

###############################################################################
###############################################################################
###############################################################################
# Command Line Arguments

die "Usage: target=(testgen|validator) CommonDefinitions.hdl instDesc.hdl" unless (@ARGV == 3);

die "Invalid 'target' value, expected 'validator' or 'testgen'" unless ($ARGV[0] eq "-target=testgen" || $ARGV[0] eq "-target=validator");
my $genValidator = $ARGV[0] eq "-target=validator";
my $className = $genValidator? "InstValidator" : "InstSetImpl";

my $lib = $ARGV[1];
die "File '$lib' not found" unless -e($lib);

my $idefs = $ARGV[2];
die "File '$idefs' not found" unless -e($idefs);


###############################################################################
###############################################################################
###############################################################################

sub make_lexer {
    my $lexer = shift;
    while (@_) {
        my $args = shift;
        $lexer = _tokens( $lexer, @$args );
    }
    return $lexer;
}

sub _tokens {
    my ($input, $label, $name, $pattern, $maketoken) = @_;
    $maketoken ||= sub { [ $_[0] => $_[1] ] };
    my @tokens;
    my $buf = "";    # set to undef when input is exhausted
    my $split = sub { split /($pattern)/ => $_[0] };

    return sub {
        while ( 0 == @tokens && defined $buf ) {
            my $i = $input->();
            if ( ref $i ) {    # input is a token
                my ($sep, $tok) = $split->($buf);
                $tok = $maketoken->( $label, $tok ) if defined $tok;
                push @tokens => grep defined && $_ ne "" => $sep, $tok, $i;
                $buf = "";
                last;
            }
            $buf .= $i if defined $i;    # append new input to buffer
            my @newtoks = $split->($buf);
            while ( @newtoks > 2 || @newtoks && !defined $i ) {

                # buffer contains complete separator plus combined token
                # OR we've reached the end of input
                push @tokens => shift @newtoks;
                push @tokens => $maketoken->( $label, shift @newtoks )
                  if @newtoks;
            }

            # reassemble remaining contents of buffer
            $buf = join "" => @newtoks;
            undef $buf unless defined $i;
            @tokens = grep $_ ne "" => @tokens;
        }
        $_[0] = '' unless defined $_[0];
        return 'peek' eq $_[0] ? $tokens[0] : shift @tokens;
    };
}

###############################################################################
###############################################################################
###############################################################################
# Tokens

my @input_tokens =
(
    [ 'COMMENT', '',           qr/\/\/.*\Z/, sub { () } ],
    [ 'NAME',    'identifier', qr/\b\w+\b/              ],
    [ 'EQ',      '=',          qr/=/                    ],
    [ 'COMMA',   ',',          qr/,/                    ],
    [ 'TERM',    ';',          qr/;/                    ],
    [ 'CHK',     '?',          qr/\?/                   ],
    [ 'STAR',    '*',          qr/\*/                   ],
    [ 'PLUS',    '+',          qr/\+/                   ],
    [ 'SLASH',   '/',          qr/\//                   ],
    [ 'LBR',     '{',          qr/{/                    ],
    [ 'RBR',     '}',          qr/}/                    ],
    [ 'LBRR',    '(',          qr/\(/                   ],
    [ 'RBRR',    ')',          qr/\)/                   ],
    [ 'SPACE',   '',           qr/\s*/, sub { () }      ],
    [ 'UNKNOWN', '',           qr/./                    ],
);

my $it;
my $lexer;

sub make_charstream {
    my $fh = shift;
    return sub {
        #return getc($fh);

        my $ch = getc($fh);
        return ($ch && $ch eq '.')? '_' : $ch;
    };
}

sub getTokenName
{
    my $id = shift;

    for my $rec (@input_tokens)
    {
        my ($tokenId, $tokenName) = @$rec;
        return $tokenName if $tokenId eq $id;
    }
    return '';
}

###############################################################################
# Parser Tables

my %hdlProp;               # $hdlProp{$PropName}{$PropVal} = 1;

                           # Special properties are labelled as follows:
my %hdlPropType;           # $hdlPropType{$PropName} = 'brig...';      # brig property
                           # $hdlPropType{$PropName} = 'brigBit...';   # brigBit property
                           # $hdlPropType{$PropName} = 'operand...';   # operand property
                           # $hdlPropType{$PropName} = '...custom';    # needs custom check

                           # Property prefix - used to translate HDL names to BRIG names
my %hdlPropPref;           # $hdlPropPref{$PropName} = "...";

                           # Property name in Brig - used to translate HDL names to external names
my %hdlExtPropName;        # $hdlExtPropName{$PropName} = "BrigName";

                           # Property accessor name - used to overwrite standard accessors
my %hdlPropAccessor;       # $hdlPropAccessor{$PropName} = "AccessorName";

my %hdlClone;              # $hdlClone{$name} = $BasePropName;

my %hdlAlias;              # For user-defined alias $AliasName of property $BasePropName
                           # with values $V1, $V2, etc:
                           #   $hdlAlias{$BasePropName . '@' . $AliasName} = [$V1, $V2, ...]
                           # For generated alias (array alias) of property $BasePropName
                           # with values $V1, $V2, etc and ordered expanded values $E1, $E2, etc:
                           #   $hdlAlias{$BasePropName . '@' . $E1 . '#' . $E2 ... . '#'] = [$V1, $V2, ...]

my %hdlAttr;               # $hdlAttr{$BasePropName . '*' . $AttrName} = 1;

my %hdlInst;               # $hdlInst{InstName} = [$InstFmt, $InstCategory, $ReqName];

my @hdlInstList;           # FIXME: this is to simplify TestGen validation - to be deleted

my %hdlReq;                # Each requirement is a list of checks:
                           #     $hdlReq{$Req} = [<Check>*];
                           # There are 4 kinds of checks two of which are used together:
                           #     Check  = <Call> | <Prop> | {<Cond>}+ <End>
                           # Each check is represented as an anonimous hash with named keys:
                           #     Call = {'kind' => '!', 'name'  => $name}
                           #     Prop = {'kind' => '=', 'name'  => $name,  'attr' => $attr, 'values' => [@values]};
                           #     Cond = {'kind' => '?', 'tests' => $tests, 'asserts' => $asserts};
                           #     End  = {'kind' => ';'};

my %hdlReqOrig;            # Copy of original requirement (%hdlReq is a subject for optimizations).
                           # This copy is created only after optimization of %hdlReq

                           # Arrays are used to store lists of property values.
                           # These data are used for validation  and error reporring.
                           # Because array names are autogenerated, implementation uses
                           # the following two hashes to ensure that each name is unique.
                           # Arrays are identified by id which is an array alias name (see above).
my %hdlArray;              #     $hdlArray{$ArrayId} = $ArrayName;

my %hdlGeneratedName;      # All autogenerated names are placed into this hash:
                           #     $hdlGeneratedName{$Name} = 1
                           # It is used to make sure there are no duplicate names.

my $context = '';          # description of current context (used for errors reporting)
my $prevContext = '';      # description of previous context (used for errors reporting)

my $currentBaseProp;       # Last defined base property (cannot be a clone)
my $currentProp;           # Last defined property (either the base property or a clone)

my $MAX_ARR_NAME_LEN = 64; # Max length of human-readable array names (generated using array values)
                           # Longer names are generated using simpler algorithm

my $ATTR_NONE    = 'NONE';      # Default name of 'none' attribute (used for checks w/o attributes)
my $ATTR_INVALID = 'INVALID';   # Default name of 'invalid' attribute (used for errors handling)

###############################################################################
# Lexer

sub setContext
{
    $_[0] //= '';
    $prevContext = $context;
    $context = $_[0];
}

sub lexError
{
    if ($context)
    {
        print STDERR "Error when $context:\n";
    }
    elsif ($prevContext)
    {
        print STDERR "Error after $prevContext:\n";
    }

    print STDERR shift(), "\n";
    exit;
}

sub dumpToken
{
    my ($label, $value) = @_;
    print "Next token: $label \t $value \n";
}

sub getToken
{
    my ($expected, $optional) = @_;

    if (my $token = $lexer->())
    {
        my ($label, $value) = @$token;
        if ($expected)
        {
            $label eq $expected or lexError "Invalid token '$value', expected: '$expected'";
            return $value;
        }
        else
        {
            return ($label, $value);
        }
    }
    else
    {
        $optional or lexError 'Unexpected EOF';
        return;
    }
}

sub peekToken
{
    if (my $token = $lexer->('peek'))
    {
        my ($label, $value) = @$token;
        return $label;
    }
    return "EOF";
}

sub trySkipToken
{
    my $token;
    if (($token = $lexer->('peek')) && (@$token[0] eq shift)) {
        getToken;
        return 1;
    }
    return 0;
}

sub peekTokens
{
    my $token = peekToken;
    for my $val (@_) {
        return 1 if $token eq $val;
    }
    return 0;
}

sub peekTerminator
{
    return peekTokens('TERM', 'CHK', 'LBR', 'RBR', 'LBRR', 'RBRR')
}

sub skipToken
{
    my ($label, $value) = getToken;

    for my $i (@_) {
        return $i if $i eq $label;
    }

    my @expected = map { "'" . getTokenName($_) . "'" } @_;
    lexError "Invalid token '$value', expected: " . join(", ", @expected);
}

sub expected
{
    if (peekTokens @_) { return }
    skipToken @_;             # Report error
}

###############################################################################
# Properties

sub isBaseProp
{
    my $name = shift;
    return $hdlProp{$name};
}

sub isClone
{
    my $name = shift;
    return $hdlClone{$name};
}

sub isProp
{
    my $name = shift;
    return isBaseProp($name) || isClone($name);
}

sub isPropVal
{
    my ($prop, $val) = @_;
    return isProp($prop) && $hdlProp{getBaseProp($prop)}{$val};
}

sub isBrigProp
{
    my $prop = shift;
    return isProp($prop) &&
           $hdlPropType{getBaseProp($prop)} &&
           $hdlPropType{getBaseProp($prop)} =~ /^brig/;
}

sub isBrigBitProp
{
    my $prop = shift;
    return isProp($prop) && $hdlPropType{getBaseProp($prop)} && $hdlPropType{getBaseProp($prop)} =~ /^brigBit/;
}

sub getOperandIdx { my $prop = shift; $prop =~ /(\d)$/; return $1; }

sub isOperandProp
{
    my ($prop, $idx) = @_;
    return isProp($prop) && $hdlPropType{getBaseProp($prop)} && $hdlPropType{getBaseProp($prop)} =~ /^operand/ && getOperandIdx($prop) == $idx;
}

sub needCustomCheck
{
    my $prop = shift;
    return isProp($prop) && $hdlPropType{getBaseProp($prop)} && $hdlPropType{getBaseProp($prop)} =~ /custom$/;
}

sub getBaseProp     # Given a property or clone name, return corresponding true property name
{
    my $prop = shift;

    return $prop            if isBaseProp($prop);
    return $hdlClone{$prop} if isClone($prop);

    lexError "getBaseProp: unknown property or clone '$prop'";
}

sub getPropValues
{
    my ($prop) = @_;
    return $hdlProp{getBaseProp($prop)};
}

sub addPropVal
{
    my ($prop, $val) = @_;
    $hdlProp{$prop}{$val} = 1;
}

sub markBrigProp
{
    my $prop = shift;
    if (!isBrigProp($prop))  ## NB: '+=' should keep properties unchanged 
    {
        $hdlPropType{getBaseProp($prop)} = 'brig';
    }
}

sub markBrigBitProp
{
    my $prop = shift;
    $hdlPropType{getBaseProp($prop)} = 'brigBit';
}

sub markOperandProp
{
    my $prop = shift;
    $hdlPropType{getBaseProp($prop)} = 'operand';
}

sub markCustomCheck
{
    my $prop = shift;
    $hdlPropType{getBaseProp($prop)} or die "Internal error";
    $hdlPropType{getBaseProp($prop)} .= '.custom';
}

sub addClone
{
    my ($name, $prop) = @_;
    $hdlClone{$name} = $prop;
}

sub getClones
{
    my ($name) = @_;
    return grep { $hdlClone{$_} eq $name } sort keys %hdlClone;
}

###############################################################################
# Property Kinds and Values

                # Property kinds
                # Numbers are selected to allow easy reassignments with higher priority kinds
my $NONE = 0;   # dummy - used for unknown props
my $MTA = 1;    # meta              - implicitly affects other properties
my $LDG = 2;    # leading primary   - implicitly affects other properties (used in affects/depends) and must be assigned first
my $PRM = 3;    # primary           - explicitly affects other properties (used in conditionals) and must be assigned first
my $CND = 4;    # conditional       - depends on other properties (used in conditionals)
my $DEP = 5;    # dependent         - depends on other properties (used in affects/depends)
my $PLN = 6;    # plain             - has no affects/depends relationships

                            # Statically defined kind of property (for meta properties
                            # and those described by affects/dependsOn directives)
                            # This simplified approach currently works very well,
                            # though it increases number of leading/primary properties
                            # without necessity.
my %staticPropKind;         # $staticPropKind{$prop} = $kind;       // possible values are: $MTA, $LDG, $PRM, $DEP

                            # Kind of each property per instruction.
                            # This table is generated automatically by analyzing requirements for each instruction.
                            # Statically-defined kinds are taken into account as well.
my %instPropKind;           # $instPropKind{$inst}{$prop} = $kind;  // possible values are: $MTA, $LDG, $PRM, $DEP, $CND, $PLN

                            # List of valid values for each property (per instruction)
                            # This table is generated automatically by analyzing requirements for each instruction.
my %instPropVals;           # $instPropVals{$inst}{$prop}{$val} = 1;

sub dclStaticProp
{
    my ($prop, $kind) = @_;

    if (($kind == $MTA && getStaticPropKind($prop)) || isStaticProp($prop, $MTA)) { die "Internal error: redefinition of meta-property $prop"; }
    if ($kind == $LDG && !isBrigProp($prop)) { die "Internal error: $prop is not a Brig property and cannot be leading"; }

    if (!$staticPropKind{$prop} || $staticPropKind{$prop} > $kind)
    {
        $staticPropKind{$prop} = $kind
    }
}

sub dclStaticPropFamily
{
    my ($prop, $kind) = @_;
    for my $p ($prop, getClones($prop)) { dclStaticProp($p, $kind); }
}


sub getStaticPropKind
{
    my ($prop) = @_;
    return $staticPropKind{$prop}? $staticPropKind{$prop} : $NONE;
}

sub isStaticProp
{
    my ($prop, $kind) = @_;
    return $staticPropKind{$prop} && $staticPropKind{$prop} == $kind;
}

sub addInstPropDesc
{
    my ($inst, $chk, $kind) = @_;
    my $prop = getChkPropName($chk);

    for my $val (expandAliases($prop, getChkPropValues($chk))) {
        $instPropVals{$inst}{$prop}{$val} = 1;
    }

    if (getStaticPropKind($prop) && $kind > getStaticPropKind($prop))
    {
        $kind = getStaticPropKind($prop);
    }
    if (!$instPropKind{$inst}{$prop} || $instPropKind{$inst}{$prop} > $kind)
    {
        $instPropKind{$inst}{$prop} = $kind;
    }
}

sub getPropKindName
{
    my ($inst, $prop) = @_;
    my $kind = $instPropKind{$inst}{$prop};

    return 'Leading Primary' if $kind == $LDG;
    return 'Primary'         if $kind == $PRM;
    return 'Conditional'     if $kind == $CND;
    return 'Dependent'       if $kind == $DEP;
    return 'Plain'           if $kind == $PLN;
    return 'Meta'            if $kind == $MTA; # Actually unnecessary as TestGen does not work with these properties
}

sub getInstPropsUs # unsorted
{
    my ($inst, $kind) = @_;
    return grep { $instPropKind{$inst}{$_} == $kind } sort keys %{$instPropKind{$inst}};
}

sub getInstProps     { my ($inst, $kind) = @_; return sort(getInstPropsUs($inst, $kind)); }
sub getInstPropsNum  { my ($inst, $kind) = @_; return scalar(getInstPropsUs($inst, $kind)); }

sub getOrderedPropList
{
    my $inst = shift;
    return (getInstProps($inst, $LDG),  # NB: order is important!
            getInstProps($inst, $PRM),
            getInstProps($inst, $CND),
            getInstProps($inst, $DEP),
            getInstProps($inst, $PLN));
}

sub getInstPropVals
{
    my ($inst, $prop) = @_;
    return sort keys %{$instPropVals{$inst}{$prop}};
}

###############################################################################
# Attributes

sub isAttr
{
    my ($prop, $attr) = @_;
    return $hdlAttr{getAttrId($prop, $attr)};
}

sub getAttrId
{
    my ($prop, $attr) = @_;
    return getBaseProp($prop) . '*' . $attr; # "prop*attr"
}

sub addAttr
{
    my ($prop, $attr) = @_;
    $hdlAttr{getAttrId($prop, $attr)} = 1;
}

###############################################################################
# Aliases

sub isAlias
{
    my ($prop, $alias) = @_;
    return $hdlAlias{getAliasId($prop, $alias)};
}

sub getAliasId
{
    my ($prop, $alias) = @_;
    return getBaseProp($prop) . '@' . $alias; # "prop@alias"
}

sub getAliasComponents
{
    my $aliasId = shift;
    return split('@', $aliasId);
}

sub getAliasValues
{
    my ($prop, $alias) = @_;
    return @{$hdlAlias{getAliasId($prop, $alias)}};
}

sub getAliasNames
{
    return sort keys %hdlAlias;
}

sub expandAliasVal      # Given a value or an alias, return a list of actual values
{
    my ($prop, $val) = @_;

    if (isPropVal($prop, $val)) {
        return ($val);
    } elsif (isAlias($prop, $val)) {
        return getAliasValues($prop, $val);
    } else {
        lexError "Unknown value (or alias) '$val' of property '$prop'";
    }
}

sub addAlias
{
    my ($prop, $alias, @values) = @_;
    $hdlAlias{getAliasId($prop, $alias)} = [@values];
}

###############################################################################
# Arrays (aka generated aliases)

sub isArray
{
    my ($prop, $val) = @_;
    return $hdlArray{getAliasId($prop, $val)};
}

sub isArrayName
{
    my $name = shift();
    return $name =~ m/#\Z/
}

sub makeArrayName
{
    return join('#', @_) . '#';
}

# FIXME: put all other generated names into 'hdlGeneratedName'

sub genTargetArrayName       # Generate a unique array name
{
    my ($prop, $val) = @_;

            # First, generate human-readable array name by concatenating
            # names of values and aliases in the list, separated with "_"
            # e.g. TYPE_VALUES_B_S_U

    my $name = join('.', getAliasValues($prop, $val));
    $name =~ s/_//g;
    $name =~ s/\./_/g;

    my $res = getTargetValListName($prop, $name);

            # Check that the name is unique and does not violate length limitation.
            # If the check fails, generate a simple numeric name like this: TYPE_VALS_01

    if (defined($hdlGeneratedName{$res}) || length($res) > $MAX_ARR_NAME_LEN)
    {
        my $cnt = 0;
        while (1)
        {
            $res = getTargetValListName($prop, $cnt++);
            last unless defined($hdlGeneratedName{$res});
        }
        $hdlGeneratedName{$res} = 1;
    }

    return $res;
}

sub createTargetArrayName
{
    my ($prop, $alias, @values) = @_;

    if (!isArray($prop, $alias)) {
        $hdlArray{getAliasId($prop, $alias)} = [genTargetArrayName($prop, $alias), @values];
    }
    return getTargetArrayName($prop, $alias);
}

sub getTargetArrayName
{
    my ($prop, $val) = @_;

    isArray($prop, $val) or lexError "Internal error: undefined array '$val' of property '$prop'";

    my ($name, @values) = @{$hdlArray{getAliasId($prop, $val)}};
    return $name;
}

sub getTargetArrayValues
{
    my ($prop, $val) = @_;

    isArray($prop, $val) or lexError "Internal error: undefined array '$val' of property '$prop'";

    my ($name, @values) = @{$hdlArray{getAliasId($prop, $val)}};
    return @values;
}

###############################################################################
# Checks

sub isChkProp
{
    return shift()->{'kind'} eq '=';
}

sub isChkCall
{
    return shift()->{'kind'} eq '!';
}

sub isChkCond
{
    return shift()->{'kind'} eq '?';
}

sub isChkEnd
{
    return shift()->{'kind'} eq ';';
}

sub getChkCallName
{
    return shift()->{'name'};
}

sub getChkPropName
{
    return shift()->{'name'};
}

sub getChkPropAttr
{
    return shift()->{'attr'};
}

sub getChkPropValues
{
    return @{shift()->{'values'}};
}

sub getChkCondTests
{
    return @{shift()->{'tests'}};
}

sub getChkCondAsserts
{
    return @{shift()->{'asserts'}};
}

sub makeChkProp
{
    my ($name, $attr, @values) = @_;
    return {
        'kind'   => '=',
        'attr'   => $attr,
        'name'   => $name,
        'values' => [@values]
    };
}

sub makeChkCall
{
    my ($name) = @_;
    return {
        'kind'   => '!',
        'name'   => $name
    };
}

sub makeChkCond
{
    my ($tests, $asserts) = @_;
    return {
        'kind'    => '?',
        'tests'   => $tests,
        'asserts' => $asserts
    };
}

sub makeChkEnd
{
    return {
        'kind'    => ';',
    };
}

###############################################################################
# instructions

sub addInst
{
    my ($name, $fmt, $category, $req) = @_;
    $hdlInst{$name} = [$fmt, $category, $req];
    push @hdlInstList, $name;
}

sub getInstFormat
{
    my $inst = shift;
    return $hdlInst{$inst}[0];
}

sub getInstCategory
{
    my $inst = shift;
    return $hdlInst{$inst}[1];
}

sub getInstReq
{
    my $inst = shift;
    return $hdlInst{$inst}[2];
}

###############################################################################
# HDL to Target Name Translation

# FIXME: each name should start with a unique prefix, revise all names accordingly

#
# Auto-generated private names
#
sub getTargetPropValListName      { my $name = shift;      return 'PROP_VALUES_' . uc($name); }
sub getTargetReqPropsName         { my $name = shift;      return 'REQ_PROPS_' . uc(getInstReq($name)); }
sub getTargetReqPropValListName   { my ($prop, $val) = @_; return uc('REQ_PROP_VALUES_' . getInstReq($prop) . '__' . $val); }
sub getTargetExValName            { my ($prop, $val) = @_; return uc(getBaseProp($prop) . '_VAL_' . $val); }
sub getTargetAttrName             { my ($prop, $val) = @_; return uc(getBaseProp($prop) . '_ATTR_' . $val); }
sub getTargetValListName          { my ($prop, $val) = @_; return uc(getBaseProp($prop) . '_VALUES_' . $val); }
sub getTargetReqName              { my $name = shift;      return 'req_' . $name; }
sub getTargetBrigChkName          { my $name = shift;      return 'check_' . lc($name); }
sub getTargetExChkName            { my $name = shift;      return 'validate' . ucfirst($name); }
sub getTargetChkReqPropName       { my $name = shift;      return 'chkReqProp' . ucfirst(getInstReq($name)); }
sub getTargetReqValidatorName     { my $name = shift;      return 'validateReq' . ucfirst(getInstReq($name)); }
sub getTargetProp2Attr            { my ($prop, $req) = @_; return lc($prop) . '_to_attr_' . $req; }

sub getTargetPropName
{
    my $name = shift;
    if ($hdlExtPropName{$name}) { $name = $hdlExtPropName{$name}; }
    return 'PROP_' . uc($name);
}

#
# Externally-defined names
#
sub getTargetInstName         { my $name = shift;                   return "BRIG_OPCODE_" . uc($name); }
sub getTargetFormatClass      { my $name = shift; $name =~ s/_//g;  return 'Inst' . $name ; }
sub getTargetFormatName       { my $name = shift;                   return 'BRIG_KIND_INST_' . uc($name); }
sub getTargetCategoryName     { my $name = shift; $name =~ s/\./_/g; return "C_" . uc($name); }
sub genTargetGetAttr          { my $prop = ucfirst(shift());         return "get${prop}Attr"; }

sub getTargetPropAccessorName
{
    my $name = shift;

    if    ($hdlPropAccessor{$name}) { $name = $hdlPropAccessor{$name}; }
    elsif ($hdlExtPropName{$name})  { $name = $hdlExtPropName{$name}; }

    return 'get' . ucfirst($name);
}

sub getTargetBrigValName
{
    my ($prop, $val) = @_;

    isBrigProp(getBaseProp($prop)) or die "Internal error: getTargetBrigValName should only be called for BRIG properties";

    if (!isBrigBitProp(getBaseProp($prop))) # BrigBit property values need no prefix; they are simple '0' or '1'
    {
        my $pref = uc(getBaseProp($prop)); # default value
        if ($hdlPropPref{getBaseProp($prop)}) { $pref = $hdlPropPref{getBaseProp($prop)} };
        return 'BRIG_' . $pref . '_' . uc($val);
    }

    return $val;
}

sub getTargetValName
{
    my ($prop, $val) = @_;
    return isBrigProp($prop)? getTargetBrigValName($prop, $val) : getTargetExValName($prop, $val);
}

###############################################################################
# Dumping

sub dumpCheckProp
{
    my $chk = shift;
    return getChkPropName($chk) . ' = ' . join(', ', getChkPropValues($chk)) . ';';
}

sub dumpCall
{
    my $chk = shift;
    return getChkCallName($chk) . ';';
}

sub dumpCheckCond
{
    my $chk = shift;
    my $res;
    $res .= '{';
    $res .= join(' ', map { dumpCheckProp($_) } getChkCondTests($chk));
    $res .= ' ? ';
    $res .= join(' ', map { isChkProp($_)? dumpCheckProp($_) : dumpCall($_) } getChkCondAsserts($chk));
    $res .= '}';
    return $res;
}

sub dumpReq
{
    my ($name) = @_;
    dumpReqBase(@_, @{$hdlReq{$name}});
}

sub dumpOrigReq
{
    my ($name) = @_;
    dumpReqBase(@_, @{$hdlReqOrig{$name}});
}

sub dumpReqBase
{
    my ($name, $pref, @reqlist) = @_;

    print $pref, "Req $name = {\n";
    for my $chk (@reqlist)
    {
        print $pref, '    ';
        if (isChkProp($chk)) {
            print dumpCheckProp($chk);
        } elsif (isChkCall($chk)) {
            print dumpCall($chk);
        } elsif (isChkCond($chk)) {
            print dumpCheckCond($chk);
        } elsif (isChkEnd($chk)) {
            print ';';
        } else {
            die "internal dump error";
        }
        print "\n";
    }
    print $pref, "}\n";
}

###############################################################################
# Helpers

sub unique          # Return unique array elements
{
    my %hash = map { $_, 1 } @_;
    return sort keys %hash;
}

sub eqArrayElements
{
    my @a1 = @{ shift() };
    my @a2 = @{ shift() };

    my %hash = map { $_, 1 } @a1;
    return 0 == grep { !$hash{$_} } @a2;
}

###############################################################################
# Parser

sub parsePropElement;

sub multiply    # Multiply 2 lists, so that (a, b)(x, y) result in (ax, ay, bx, by)
{
    return map { my $second = $_; map { $_ . $second } @_ } parsePropElement;
}

sub parsePropList           # PropList ::= PropElement ("," PropElement)*
{
    my @list = ();
    while (1)
    {
        push @list, parsePropElement;
        last unless trySkipToken('COMMA');
    }
    @list or lexError "Empty list is invalid";

    return @list;
}

sub parsePropElement        # PropElement ::= Name | "(" PropList ")" | Name "(" PropList ")" | "(" PropList ")" PropElement
{
    my @list;
    my $reqTerm = 1;

    if (@_)
    {
        @list = @_;
    }
    elsif (peekToken eq 'NAME')
    {
        @list = (getToken('NAME'));
    }
    elsif (trySkipToken('LBRR'))
    {
        @list = parsePropList;
        skipToken 'RBRR';
        $reqTerm = 0;
    }
    else
    {
        expected('NAME', 'LBRR');
    }

    return @list if peekTokens('TERM', 'COMMA', 'RBR', 'RBRR', 'CHK');
    !$reqTerm or expected('COMMA', 'TERM', 'LBRR'); # best we can afford here (for diagnostic purposes)

    return multiply @list;
}

sub parsePropDef            # PropDef ::= { AliasName "=" } PropElement
{
    my $name = shift;
    my $alias;
    my @list;

    if (peekToken eq 'NAME')
    {
        my $val = getToken('NAME');
        if (trySkipToken('EQ')) {
            $alias = $val;
            @list = parsePropElement;
        } else {
            @list = parsePropElement($val);
        }
    }
    else
    {
        @list = parsePropElement;
    }

    for my $val (@list)
    {
        !isPropVal($name, $val) or lexError "Redefinition of value '$val'";
        addPropVal($name, $val);
    }

    if ($alias) {
        my $aliasName = $alias;
        !isAlias($name, $alias) or lexError "Redefinition of alias '$aliasName'";
        addAlias($name, $alias, @list);
    }
}

                        # Prop ::= PropName "="  PropDef { "," PropDef } ";"
sub parseProp           # Prop ::= PropName "+=" PropDef { "," PropDef } ";"
{
    my $name = getToken('NAME');

    if (trySkipToken('PLUS')) {
        setContext "parsing extension of property '$name'";
        isBaseProp($name) or lexError "Undefined property '$name'";
        isBrigProp($name) or lexError "Cannot extend non-Brig property '$name'";
        !isBrigBitProp($name) or lexError "Cannot extend BrigBit property '$name'";
    } else {
        setContext "parsing property '$name'";
        !isBaseProp($name) or lexError "Redefinition of property '$name'";
        !isClone($name) or lexError "Redefinition of property clone '$name'";
    }

    $currentBaseProp = $name;
    $currentProp     = $name;

    skipToken('EQ');

    while (1) {
        parsePropDef($name);
        last if skipToken('COMMA', 'TERM') ne 'COMMA'
    }
}

sub parseClone          # Clone ::= PropList ";"
{
    defined $currentBaseProp or lexError "No property context to define clone";
    setContext "parsing clone of property '$currentBaseProp'";

    my @list = parsePropList;
    skipToken('TERM');

    for my $name (@list)
    {
        $name !~ m/[\._]/ or !isBrigProp($currentBaseProp)
                              or lexError "Attributes (delimited with '.' and '_') cannot be used with clones of brig properties";
        !isBaseProp($name)    or lexError "Redefinition of property '$name'";
        !isClone($name)       or lexError "Redefinition of property clone '$name'";

        addClone($name, $currentBaseProp);
        $currentProp = $name;
    }
}

sub parseDeps          # [DependsOn | Affects] ::= PropList ";"
{
    my $option = shift;
    defined $currentBaseProp or lexError "No property context for $option";
    setContext "parsing $option of property '$currentBaseProp'";

    my @list = parsePropList;
    skipToken('TERM');

    for my $name (@list)
    {
        isProp($name) or lexError "Unknown property '$name'";
    }

    return @list;
}

sub parseAttr          # Attr ::= PropList ";"
{
    defined $currentBaseProp or lexError "No property context to define attribute";
    setContext "parsing attribute of property '$currentBaseProp'";

    my @list = parsePropList;
    skipToken('TERM');

    for my $name (@list)
    {
        $name !~ m/[\._]/ or lexError "Attributes cannot include '.' and '_'";

        !isAttr($currentBaseProp, $name) or lexError "Redefinition of attribute '$name'";
        addAttr($currentBaseProp, $name);
    }
}

sub parseCustomCheck
{
    defined $currentProp or lexError "No property context to set custom check";
    setContext "parsing CustomCheck of property '$currentProp'";

    skipToken('TERM');

    isBaseProp($currentProp)  or lexError "Custom check is not supported yet for clones";
    isBrigProp($currentProp) or lexError "Custom check is only possible for brig properties";
    !needCustomCheck($currentProp) or lexError "Custom check is already specified for this property";

    markCustomCheck($currentProp);
}

sub parseBrigProp
{
    parseProp;
    markBrigProp($currentBaseProp);
}

sub parseBrigBitProp
{
    my $name = getToken('NAME');

    setContext "parsing property '$name'";
    !isBaseProp($name)  or lexError "Redefinition of property '$name'";
    !isClone($name) or lexError "Redefinition of property clone '$name'";

    $currentBaseProp = $name;
    $currentProp     = $name;

    skipToken('TERM');

    addPropVal($name, '0');
    addPropVal($name, '1');

    addAlias($name, 'any', ('0', '1'));
    addAlias($name, 'none', ('0'));

    markBrigBitProp($currentBaseProp);
}

sub parseOperandProp
{
    parseProp;
    markOperandProp($currentBaseProp);
}

sub parseExtProp
{
    parseProp;
}

sub parseMetaProp
{
    parseProp;
    dclStaticProp($currentBaseProp, $MTA);
}

#### Affects and DependsOn may be used to describe dependencies between properties.
#### There are two separate cases: for meta-properties and for non-meta properties.
#### 1) [Regular property B] dependOn [Meta-property A]
####    [Meta-property A]    affects  [Regular property B]
####    Meta-property does not correspond to any instruction/operand field; it is
####    a special check performed on one or more regular properties.
####    Meta-properties cannot have dependencies, but may affect other properties.
####    All meta-properties are checked together with last primary property (it is by design).
####    Consequently, properties affected by a meta-property must be set before this check and so must be primary.
#### 2) [Extended property A] dependsOn [Brig property B]
####    [Brig property B]     affects   [Extended property A]
####    These statements mean that validation of 'A' includes an implicit check of 'B'.
####    This dependence has two consequences:
####    - all combinations of 'B' values should be searched for.
####      Consequently, 'B' must be a primary/leading property.
####    - 'A' must be checked AFTER 'B'. To ensure that, 'B' must be a leading property
####      while 'A' must be any property except leading (i.e. 'A' can have no dependencies).
####      This requirenemt is satisfied automatically. This is because 'A' may only be
####      an extended property and so cannot affect other properties

sub parseDependsOn
{
    !isStaticProp($currentBaseProp, $MTA) or lexError "Meta properties cannot have dependencies";

    my @props = parseDeps 'DependsOn';
    for my $prop (@props)
    {
        if (isStaticProp($prop, $MTA))          #### [Regular property] dependOn [Meta-property]
        {
            dclStaticPropFamily($currentBaseProp, $PRM);
        }
        else                                    #### [Extended property] dependsOn [Brig property]
        {
            !isBrigProp($currentBaseProp) or lexError "Brig properties can only depend on meta-properties";
            dclStaticPropFamily($currentBaseProp, $DEP);

            isBrigProp($prop) or lexError "Extended properties cannot affect other properties";
            dclStaticProp($prop, $LDG);
        }
    }
}

sub parseAffects
{
    my @props = parseDeps 'Affects';

    if (isStaticProp($currentBaseProp, $MTA))       #### [Meta-property]  affects  [Regular property]
    {
        for my $prop (@props)
        {
            !isStaticProp($prop, $MTA) or lexError "Meta properties cannot have dependencies";
            dclStaticProp($prop, $PRM);
        }
    }
    elsif (isBrigProp($currentBaseProp))            #### [Brig property]  affects  [Extended property]
    {
        dclStaticPropFamily($currentBaseProp, $LDG);

        for my $prop (@props)
        {
            !isStaticProp($prop, $MTA) or lexError "Meta properties cannot have dependencies";
            !isBrigProp($prop)         or lexError "Brig properties can only depend on meta-properties";
            dclStaticProp($prop, $DEP);
        }
    }
    else                                        #### [Extended property]
    {
         lexError "Extended properties cannot affect other properties";
    }
}

sub parsePrefix
{
    my $pref = getToken('NAME');
    skipToken('TERM');

    defined $currentBaseProp or lexError "No property context for BrigPrefix";
    isBrigProp($currentBaseProp) or lexError "BrigPrefix is only applicable to Brig properties";
    setContext "parsing BrigPrefix of property '$currentBaseProp'";

    !defined $hdlPropPref{$currentBaseProp} or lexError "Redefinition of BrigPrefix for '$currentBaseProp'";
    $hdlPropPref{$currentBaseProp} = $pref;
}

sub parseExtPropName
{
    my $name = getToken('NAME');
    skipToken('TERM');

    defined $currentProp or lexError "No property context for ExtPropName";
    setContext "parsing ExtPropName of property '$currentProp'";

    !defined $hdlExtPropName{$currentProp} or lexError "Redefinition of ExtPropName for '$currentProp'";
    $hdlExtPropName{$currentProp} = $name;
}

sub parsePropAccessor
{
    my $name = getToken('NAME');
    skipToken('TERM');

    defined $currentProp or lexError "No property context for PropAccessor";
    isBrigProp($currentProp) or lexError "PropAccessor is only applicable to Brig properties";
    setContext "parsing PropAccessor of property '$currentProp'";

    !defined $hdlPropAccessor{$currentProp} or lexError "Redefinition of PropAccessor for '$currentProp'";
    $hdlPropAccessor{$currentProp} = $name;
}

sub parseStarExpr           # StarExpr = ("*" { "/" PropList }) | ("*." attr)
{                           # Make list including all properties
    my $prop = shift;
    my %values = %{getPropValues($prop)};

    if (trySkipToken('SLASH')) # Exclude properties specifies after "/"
    {
        my @excluded = map { expandAliasVal($prop, $_) } parsePropList;
        delete @values{@excluded}; # duplicate values are not a problem
    }
    elsif (peekToken eq 'NAME') # "*.attr"
    {
        my $name = getToken('NAME');
        die "Invalid expression, expected '*.' pattern" unless $name =~ /^\_/;
        return sort grep { $_ =~ /$name$/ } keys %{getPropValues($prop)};
    }

    return sort keys %values; # 'sort' is necessary to ensure stable array name
}

sub parseAlias          # Alias ::= AliasName "=" ( StarExpr | PropList ) ";"
{
    my $name = getToken('NAME');

    defined $currentBaseProp or lexError "No property context to define alias '$name'";
    setContext "parsing alias of property '$currentBaseProp'";

    !isAlias($currentBaseProp, $name) or lexError "Redefinition of alias '$name'";
    !isPropVal($currentBaseProp, $name) or lexError "Invalid alias name '$name', must differ from property values";

    skipToken('EQ');

    if (trySkipToken('STAR')) { # FIXME there is similar code below

        my @res = parseStarExpr($currentBaseProp);
        skipToken('TERM');

        @res or lexError "Alias '$name' has an empty list of values";

        addAlias($currentBaseProp, $name, @res);
        return;
    }

    my @list = parsePropList;
    skipToken('TERM');

    my @res = map { expandAliasVal($currentBaseProp, $_) } @list;

    for my $val (@res) {
        isPropVal($currentBaseProp, $val) or lexError "Undefined value '$val' of property '$currentBaseProp'";
    }

    addAlias($currentBaseProp, $name, @res);
}

sub parseCheck          # Check ::= "=" ( StarExpr | PropList ) {";"}
{
    my $name = shift;
    my $prop = getBaseProp $name;
    $prop or lexError "Undefined property '$name'";

    skipToken('EQ');

    if (trySkipToken('STAR')) # FIXME: There is similar code in parseAlias
    {
        my @values = parseStarExpr($prop);

        @values or lexError "Property '$name' has an empty list of values";

        expected('TERM', 'CHK', 'RBR');
        trySkipToken('TERM');

        return makeChkProp($name, $ATTR_NONE, @values);
    }

    my @values = parsePropList;

    expected('TERM', 'CHK', 'RBR');
    trySkipToken('TERM');

    for my $val (@values)
    {
        isPropVal($prop, $val) or isAlias($prop, $val)
                               or lexError "Undefined value (or alias) '$val' of property '$name'";
    }

    return makeChkProp($name, $ATTR_NONE, @values);
}

sub parseCheckList          # CheckList ::= { PropName Check }+
{
    my @res;
    while (peekToken eq 'NAME') {
        push @res, parseCheck(getToken('NAME'));
    }
    @res or lexError "List of conditions must include at least one element";
    return @res;
}

sub parseReqList            # ReqList ::= { ( PropName Check ) | ReqName }+
{
    my @res;
    while (peekToken eq 'NAME') {
        push @res, parseCheckOrReq(getToken('NAME'));
    }
    return @res;
}

sub parseCond               # Cond ::= "{" CheckList "?" ReqList "}"
{
    skipToken('LBR');
    my $checks = [parseCheckList];
    skipToken('CHK');
    my $reqs = [parseReqList];
    skipToken('RBR');
    return makeChkCond($checks, $reqs);
}

sub parseCall               # Call ::= ReqName { ';' }
{
    my $req = shift;
    $hdlReq{$req} or lexError "Undefined requirement '$req'";

    expected('TERM', 'RBR');
    trySkipToken('TERM');

    return makeChkCall($req);
}

sub parseCheckOrReq         # CheckOrReq ::= PropName Check | ReqName
{
    my $name = shift;
    return peekTerminator()? parseCall($name) : parseCheck($name);
}

sub parseReq                # Req ::= ReqName "{" ( CheckOrReq | ( Cond+ ";" ) )* "}"
{
    my $name = getToken('NAME');
    setContext "parsing requirement '$name'";

    !$hdlReq{$name} or lexError "Redefinition of requirement '$name'";

    skipToken('LBR');

    my @reqlist;
    while ((my $tok = peekToken) ne 'RBR')
    {
        if ($tok eq 'NAME')
        {
            push @reqlist, parseCheckOrReq(getToken('NAME'));
        }
        else
        {
            while (1) {
                push @reqlist, parseCond;
                last if trySkipToken('TERM')
            }
            push @reqlist, makeChkEnd;
        }
    }
    skipToken('RBR');

    $hdlReq{$name} = [@reqlist];
}

sub parseInst               # Inst ::= InstName "(" FormatName "," ReqName ")"
{
    my $name = getToken('NAME');
    setContext "parsing instruction '$name'";

    skipToken('LBRR');
    my $fmt = getToken('NAME');
    skipToken('COMMA');
    my $ctg = getToken('NAME');
    skipToken('COMMA');
    my $req = getToken('NAME');
    skipToken('RBRR');

    !$hdlInst{$name} or lexError "Redefinition of instruction '$name'";
    $hdlReq{$req} or lexError "Undefined requirement '$req'";

    addInst($name, $fmt, $ctg, $req);
}

###############################################################################
# Property List Optimizer
#
# Purpose:
#    - expand each list of property values by replacing aliases in the list with their values
#    - remove duplicate values from lists of property values
#    - find identical lists of values
#    - replace long list of values (longer than MAX_VALS_PER_CALL) with reference to arrays
#      (on this step, identical lists of values are replaced with one array reference)
#
# NB: Array reference is a special form of property alias.

sub getAttr
{
    my ($prop, $val) = @_;

    my $name;
    my $attr;

    if ((($name, $attr) = $val =~ /^(.+)_([^_]+)$/) && isAttr($prop, $attr))
    {
        return ($name, $attr);
    }
    else
    {
        return ($val, $ATTR_NONE);
    }
}

sub extractAttr
{
    my ($prop, $firstVal, @values) = @_;

    my @res;
    my ($name, $attr) = getAttr($prop, $firstVal);
    push @res, $name;

    for my $val (@values)
    {
        my ($name, $xattr) = getAttr($prop, $val);
        ($xattr eq $attr) or lexError "Incompatible attributes '$attr' and '$xattr' of property '$prop'";
        push @res, $name;
    }

    return $attr, @res;
}

sub expandAliases
{
    my ($prop, @values) = @_;
    return map { expandAliasVal($prop, $_) } @values;
}

sub optimizeCheck
{
    my $chk = shift;
    return $chk unless isChkProp($chk);

    my $attr;
    my $prop = getChkPropName($chk);
    my @values = getChkPropValues($chk);
    my @expValues = sort(unique(expandAliases($prop, @values)));

                                                           # Property values may include attribute, e.g. "reg.stype".
    ($attr, @expValues) = extractAttr($prop, @expValues);  # Validate that all values are either labelled with
                                                           # the same attribute or none are. This attribute (if any)
                                                           # is removed from values and saved as a part of property check.

    my $alias = makeArrayName(@expValues);                 # create an array for each unique sequence of brig values
    if (!isAlias($prop, $alias)) {
        addAlias($prop, $alias, @values);
    }

    createTargetArrayName($prop, $alias, @expValues);      # generate a name for this array (for use in C++ code)

    return makeChkProp($prop, $attr, $alias);
}

sub optimizeCond
{
    my $chk = shift;
    return makeChkCond([map { optimizeCheck($_) } getChkCondTests($chk)],
                       [map { optimizeCheck($_) } getChkCondAsserts($chk)]);
}

sub optimizeReq
{
    my $name = shift;
    $hdlReqOrig{$name} = $hdlReq{$name};
    $hdlReq{$name} = [ map { isChkCond($_)? optimizeCond($_) : optimizeCheck($_) } @{$hdlReq{$name}} ];
}

###############################################################################
# TestGen Requirement Analyzer

# Requirement Analyzer scans requirements of each instruction and collects the
# following information:
# - list of properties this requirement includes;
# - kind of each property
# - list of valid property values for this requirement
#
# Property kinds are:
#
#    LDG (leading primary) - affects possible values of other properties (CND, DEP)
#    PRM (primary)         - affects possible values of other properties (CND)
#    MTA (meta)            - affects possible values of other properties (LDG, PRM); has no TestGen values
#    CND (conditional)     - depends on PRM properties (as specified by conditionals)
#    DEP (dependent)       - depends or PRM properties (as specified by affects/depends) but is not used in conditionals
#    PLN (plain)           - has no depends/affects relationships
#

sub analyzeInstChk
{
    my ($inst, $chk) = @_;
    addInstPropDesc($inst, $chk, $PLN);
}

sub analyzeInstReq;

sub analyzeInstCond
{
    my ($inst, $cond) = @_;

    for my $chk (getChkCondTests($cond)) {
        addInstPropDesc($inst, $chk, $PRM);
    }

    for my $chk (getChkCondAsserts($cond)) {
        if (isChkCall($chk)) {
            analyzeInstReq($inst, getChkCallName($chk), 1); # NB: nested reqs must not include conditions
        } else {
            addInstPropDesc($inst, $chk, $CND);
        }
    }
}

sub analyzeInstReq
{
    my ($inst, $req, $isNested) = @_;
    my @reqlist = @{$hdlReq{$req}};

    for my $chk (@reqlist)
    {
        if (isChkProp($chk)) {                              # prop = a, b, c;
            analyzeInstChk($inst, $chk);
        } elsif (isChkCall($chk)) {                         # call;                         // recursive
            analyzeInstReq($inst, getChkCallName($chk), $isNested);
        } elsif (isChkCond($chk)) {                         # { prop = a, b, c ? ... } ...
            !$isNested or lexError "Nested conditionals ($req) are not currently supported";
            analyzeInstCond($inst, $chk);
        } elsif (isChkEnd($chk)) {                          # ;
            # nothing to do
        } else {
            die "internal error";
        }
    }
}

###############################################################################
# Generator

# FIXME: define all error messages in class or move to the support lib

sub cpp
{
    my $txt = shift;
    $txt =~ s/^\s+\|//gm;
    return $txt;
}

sub genSwitchHeader
{
    my ($type, $name, $args) = @_;

    print cpp(<<"EOT");
        |$type ${className}::$name($args) const
        |{
        |    switch (inst.opcode())
        |    {
EOT
}

sub genSwitchFooter
{
    my ($name, $errHdlr) = @_;

    print cpp(<<"EOT");
        |        default:
        |            @{[ $errHdlr->() ]}
        |            break;
        |    }
        |} // ${className}::$name
EOT
}

sub genValidatorCase
{
    my $name = shift;
    my $chkHdlr = sub { my ($fmt, $inst) = @_; return getTargetReqName(getInstReq($name)) . '<' . $fmt . '>(' . $inst . ');' };
    my $errHdlr = sub { my ($inst, $msg) = @_; return 'invalidFormat(' . $inst . ', "' . $msg . '");' };

    genCase($name, $chkHdlr, $errHdlr);
}

sub genCase
{
    my ($name, $chkHdlr, $errHdlr) = @_;

    genCaseHeader($name);
    genCaseBody($name, $chkHdlr, $errHdlr);
}

sub genCaseHeader
{
    $_[1] //= '';

    my ($name, $suff) = @_;
    my $brigName = getTargetInstName($name);
    print "        case ($brigName):$suff\n";
}

sub genCaseBody
{
    my ($name, $chkHdlr, $errHdlr) = @_;

    my $fmtClass = getTargetFormatClass(getInstFormat($name));

    if ($fmtClass eq 'InstMod') {

        print cpp(<<"EOT");
            |        {
            |            if (InstMod i = inst)
            |            {
            |                @{[ $chkHdlr->('InstMod', 'i') ]}
            |            }
            |            else if (InstBasic i = inst)
            |            {
            |                @{[ $chkHdlr->('InstBasic', 'i') ]}
            |            }
            |            else
            |            {
            |                @{[ $errHdlr->('inst', 'InstBasic or InstMod') ]}
            |            }
            |            break;
            |        }
EOT

    } else {

        print cpp(<<"EOT");
            |        {
            |            $fmtClass i = inst;
            |            if (!i) { @{[ $errHdlr->('inst', $fmtClass) ]} }
            |            @{[ $chkHdlr->($fmtClass, 'i') ]}
            |            break;
            |        }
EOT

    }
}

sub translateVal
{
    my ($name, $val) = @_;
    my $prop = getBaseProp $name;

    if (isArrayName($val))                                   # Array (generated alias)
    {
        isAlias($prop, $val) or lexError "Internal error: unknown array '$val' of property '$name'";

        my $array = getTargetArrayName($prop, $val);          # optimized list - replaced
        return ($array, "sizeof($array) / sizeof(unsigned)"); # with array ref
    }

    return getTargetValName($prop, $val);
}

sub translateValues         # Translate property values into format suitable for passing to validation library
{
    my ($prop, @values) = @_;
    return map { translateVal($prop, $_) } @values;
}

sub getCheckArgs
{
    my $chk = shift;

    my $prop = getChkPropName($chk);
    my $val  = isBrigProp($prop)? getTargetPropAccessorName($prop) . '<T>(inst)' : getTargetAttrName($prop, getChkPropAttr($chk));

    return 'inst, ' . getTargetPropName($prop) . ", $val, " . join(', ', translateValues($prop, getChkPropValues($chk)));
}

sub genDirectCheck
{
    my ($prop, $name) = @_;
    my $targetName = getTargetArrayName($prop, $name);
    my $val = getTargetPropAccessorName($prop) . '<T>(inst)';
    return getTargetBrigChkName($targetName) . "($val)";
}

sub genCheck
{
    my ($chk, $indent) = @_;
    my $prop = getChkPropName($chk);

    if (isBrigProp($prop) && !needCustomCheck($prop))
    {
        my @values = getChkPropValues($chk);
        return $indent . genDirectCheck($prop, shift @values);
    }
    else
    {
        return $indent . getTargetExChkName(getBaseProp($prop)) . '(' . getCheckArgs($chk) . ', false)';
    }
}

sub genCall
{
    my ($chk) = @_;
    my $name = getChkCallName($chk);
    return '    ' . getTargetReqName($name) . "(inst);\n";
}

sub genAssert
{
    my ($chk, $indent) = @_;
    my $prop = getChkPropName($chk);
    my $res;

    if (isBrigProp($prop) && !needCustomCheck($prop))
    {
        my ($val0) = getChkPropValues($chk);
        $res = '    if (!' . genDirectCheck($prop, $val0) . ") ";
        if ($genValidator) {
            $res .= "{\n$indent        brigPropError(" . getCheckArgs($chk) . ");\n$indent    }\n";
        } else {
            $res .= "return false;\n";
        }
    }
    else
    {
        $prop = getBaseProp($prop);

        my $vldFlag = $genValidator? '' : ', false';
        $res = getTargetExChkName($prop) . '(' . getCheckArgs($chk) . $vldFlag . ")";
        if (!$genValidator) { $res = 'if (!' . $res . ') return false'; }
        $res = '    ' . $res . ";\n";
    }

    return $res;
}

sub genReqDecl
{
    my $name = shift;

    print "    template<class T> bool " . getTargetReqName($name) . "(T inst) const;\n";
}

sub genReq
{
    my $name = shift;
    my @reqlist = @{$hdlReq{$name}};

    print '//', '=' x 80, "\n";
    dumpOrigReq($name, '//  ');

    print "template<class T> bool InstValidator::", getTargetReqName($name), "(T inst) const\n";
    print "{\n";

    my %propVariants = ();        # list of properties used for variant selection

    for my $chk (@reqlist)
    {
        if (isChkCall($chk))
        {
            print genCall($chk, "");
        }
        elsif (isChkProp($chk))
        {
            print genAssert($chk, "");
        }
        elsif (isChkEnd($chk)) # terminator: list of variants has finished
        {
            print "    else\n";
            print "    {\n";
            print "        invalidVariant(inst, ", join(', ', map { getTargetPropName($_) } sort keys %propVariants), ");\n";
            print "    }\n";
            %propVariants = ();
        }
        elsif (isChkCond($chk)) # one of variants
        {
            if (keys(%propVariants) == 0) { # First format variant
                print "\n";
                print "    if (\n";
            } else {
                print "    else if (\n";
            }

            print join(" &&\n", map { $propVariants{getChkPropName($_)} = 1; genCheck($_, '            ') } getChkCondTests($chk)), "\n";
            print "       )\n";
            print "    {\n    ";

            print join("    ", map { isChkCall($_)? genCall($_, "    ") : genAssert($_, "    "); } getChkCondAsserts($chk));
            print "    }\n";
        }
        else
        {
            die "internal error";
        }
    }
    print "    return true;\n";
    print "}\n\n";
}

sub genArrayDecl
{
    my ($prop, $name) = getAliasComponents(shift);
    my $targetName = getTargetArrayName($prop, $name);

    print '    static unsigned ', $targetName, "[];\n";
}

sub genArrayDef
{
    my ($prop, $name) = getAliasComponents(shift);
    my $targetName = getTargetArrayName($prop, $name);

    print "unsigned ${className}::${targetName}[] = {\n    ";
    print join(",\n    ", translateValues($prop, getTargetArrayValues($prop, $name)));
    print "\n};\n\n";
}

sub genCheckDecl
{
    my ($prop, $name) = getAliasComponents(shift);
    return if !isBrigProp($prop);

    my $targetName = getTargetArrayName($prop, $name);
    print '    static bool ', getTargetBrigChkName($targetName), "(unsigned val);\n";
}

sub genCheckDef
{
    my ($prop, $name) = getAliasComponents(shift);
    return if !isBrigProp($prop);

    my $targetChkName = getTargetBrigChkName(getTargetArrayName($prop, $name));

    print cpp(<<"EOT");
        |bool ${className}::$targetChkName(unsigned val)
        |{
        |    switch(val)
        |    {
EOT

    print "    case ";
    print join(":\n    case ", translateValues($prop, getTargetArrayValues($prop, $name)));

    print cpp(<<"EOT");
        |:
        |        return true;
        |    default:
        |        return false;
        |    }
        |}
        |
EOT
}

sub genCommonDeclarations       # Generate declarations used by both Validator and TestGen
{
    print "\nprivate:\n";
    for my $alias (getAliasNames()) {
        setContext "generating array declaration for '$alias'";
        genArrayDecl($alias) if isArrayName($alias)
    }
    setContext;

    print "\nprivate:\n";
    for my $alias (getAliasNames()) {
        setContext "generating check declaration for '$alias'";
        genCheckDecl($alias) if isArrayName($alias)
    }
    setContext;
}

sub genCommonDefinitions        # Generate definitions used by both Validator and TestGen
{
    for my $alias (getAliasNames())
    {
        setContext "generating array definition for '$alias'";
        genArrayDef($alias) if isArrayName($alias)
    }

    for my $alias (getAliasNames())
    {
        setContext "generating check definition for '$alias'";
        genCheckDef($alias) if isArrayName($alias)
    }
}

###############################################################################
# Generation of Helper Function getOperandAttr

                 #
my %propAttrs;   # $propAttrs{$pclass}{$req}{'code'}  - generated code
                 # $propAttrs{$pclass}{$req}{'prop'}  - specific property found in this requirement (e.g. may be d0 or s0 for $pclass='operand0')
                 # $propAttrs{$pclass}{$req}{'cattr'} - conditional attribute if it is the same for each condition, '*' if not the same, '' if none
                 # $propAttrs{$pclass}{$req}{'uattr'} - unconditional attribute, '' if none

my %propClass;   # $propClass{$pclass}                - base property

sub fetchAttr
{
    my ($chk, $indent) = @_;
    my $prop = getChkPropName($chk);

    return $indent . 'return ' . getTargetAttrName($prop, getChkPropAttr($chk)) . ";\n";
}

sub genUnCondAttrCode
{
    my ($prop, $attr) = @_;

    return ' return ' . getTargetAttrName($prop, $attr) . ";";
}

sub genCondAttrCode
{
    my ($chk, $assert) = @_;

    my $res = "    if (\n";

    $res .= join(" &&\n", map { genCheck($_, '        ') } getChkCondTests($chk)) . "\n";
    $res .= "       )\n";
    $res .= "    {\n    ";

    $res .= "    " . fetchAttr($assert, '    ');
    $res .= "    }\n";

    return $res;
}

sub propClass2base
{
    my ($pclass) = @_;
    return $propClass{$pclass};
}

sub createPropClass
{
    my ($pclass, $prop) = @_;

    die "Internal error" if ($propClass{$pclass} || !isBaseProp($prop));

    $propClass{$pclass} = $prop;
}

sub getPropAttrs
{
    my ($pclass, $req) = @_;

    if (!$propAttrs{$pclass})       { $propAttrs{$pclass}       = {}; }
    if (!$propAttrs{$pclass}{$req}) { $propAttrs{$pclass}{$req} = {}; }
    return $propAttrs{$pclass}{$req};
}

sub queryPropAttrs
{
    my ($pclass, $req) = @_;

    return ($propAttrs{$pclass} && $propAttrs{$pclass}{$req})? getPropAttrs($pclass, $req) : 0;
}

sub addUncondAttr
{
    my ($root, $req, $pclass, $chk) = @_;
    my $prop = getChkPropName($chk);
    my $attr = getChkPropAttr($chk);
    my $store = getPropAttrs($pclass, $root);

    lexError "Incompatible unconditional attributes of '$pclass' in requirement '$req'" if ($store->{'uattr'} && $store->{'uattr'} ne $attr);
    lexError "Incompatible properties of '$pclass' in requirement '$req'" if ($store->{'prop'} && $store->{'prop'} ne $prop);

    $store->{'prop'}  = $prop;
    $store->{'uattr'} = $attr;
}

sub startCondAttr
{
    my ($root, $req, $pclass, $prop) = @_;
    my $store = getPropAttrs($pclass, $root);

    lexError "Too many conditionals for '$pclass' in requirement '$req'"  if ($store->{'code'});
    lexError "Incompatible properties of '$pclass' in requirement '$req'" if ($store->{'prop'} && $store->{'prop'} ne $prop);

    $store->{'prop'} = $prop;
}

sub addCondAttr
{
    my ($root, $req, $pclass, $prop, $chk) = @_;
    my $store = getPropAttrs($pclass, $root);

    my @asserts = grep { getChkPropName($_) eq $prop } getChkCondAsserts($chk);
    die "Internal error" if (@asserts != 1);

    my $attr = getChkPropAttr($asserts[0]);

    $store->{'cattr'} = (!$store->{'cattr'} || $store->{'cattr'} eq $attr)? $attr : "*";
    $store->{'code'} .= genCondAttrCode($chk, $asserts[0]);
}

# if all conditionals result in the same attr, replace cond with uncond
# verify that cond attrs do not contradict uncond
# remove uncond if there are cond which cannot be optimized out
sub optimizeReqAttrs
{
    my ($root, $pclass) = @_;
    my $store = queryPropAttrs($pclass, $root);
    return unless $store;

    if ($store->{'cattr'} && $store->{'cattr'} ne '*') # all conditionals result in the same attr
    {
        lexError "Contradicting attributes of $pclass in $root" if $store->{'uattr'} && $store->{'uattr'} ne $store->{'cattr'};
        $store->{'uattr'} = $store->{'cattr'};
        $store->{'cattr'} = '';
        $store->{'code'}  = ''; # re-generated below for uncond attr
    }
    elsif ($store->{'cattr'}) # conditionals cannot be optimized out
    {
        $store->{'uattr'} = '';
    }

    if (!$store->{'code'}) # there is no conditionals, so generate code to get uncond attr
    {
        die "Internal error" unless $store->{'uattr'};
        $store->{'code'} = genUnCondAttrCode($store->{'prop'}, $store->{'uattr'});
    }
}

sub analyzeReqAttrs
{
    my ($root, $req, $pclass, $filter) = @_;
    my @reqlist = @{$hdlReq{$req}};

    my $prop;
    my $isCond = 0;

    for my $chk (@reqlist)
    {
        if (isChkCond($chk)) # one of variants
        {
            lexError "Error in requirement '$req': calls in conditionals are not currently supported" if (grep { isChkCall($_) } getChkCondAsserts($chk));

            my @found   = map { getChkPropName($_) } grep { $filter->(getChkPropName($_)) } getChkCondAsserts($chk);
            my $current = @found? $found[0] : '';

            if (!$isCond)
            {
                $isCond = 1;
                $prop = $current;
                if ($prop) { startCondAttr($root, $req, $pclass, $prop); }
            }

            lexError "Ambiguous attributes of '$pclass' in requirement '$req'" if (@found > 1 || $prop ne $current);

            if ($prop) { addCondAttr($root, $req, $pclass, $prop, $chk); }
        }
        elsif (isChkEnd($chk)) # terminator: list of variants has finished
        {
            $isCond = 0;
        }
        elsif (isChkProp($chk))
        {
            if ($filter->(getChkPropName($chk))) { addUncondAttr($root, $req, $pclass, $chk); }
        }
        elsif (isChkCall($chk))
        {
            analyzeReqAttrs($root, getChkCallName($chk), $pclass, $filter);
        }
        else
        {
            die "internal error";
        }
    }
}

# NB: $pclass is not the name of property, but rather the name of property class
sub analyzePropAttrs
{
    my ($pclass, $base, $filter) = @_;

    createPropClass($pclass, $base);

    for my $inst (getRegisteredInst())
    {
        my $req = getInstReq($inst, "");
        setContext "analyzing attributes of property '$pclass' in '$req'";
        analyzeReqAttrs($req, $req, $pclass, $filter);
        optimizeReqAttrs($req, $pclass);
    }
}

sub analyzeAttrs
{
    # FIXME: generalize for arbitrary number of operands

    analyzePropAttrs('operand0', 'operand', sub { isOperandProp(shift(), 0); });
    analyzePropAttrs('operand1', 'operand', sub { isOperandProp(shift(), 1); });
    analyzePropAttrs('operand2', 'operand', sub { isOperandProp(shift(), 2); });
    analyzePropAttrs('operand3', 'operand', sub { isOperandProp(shift(), 3); });
    analyzePropAttrs('operand4', 'operand', sub { isOperandProp(shift(), 4); });
    analyzePropAttrs('operand5', 'operand', sub { isOperandProp(shift(), 5); });

    analyzePropAttrs('width', 'width', sub { return shift() eq 'width'; });
    analyzePropAttrs('round', 'round', sub { return shift() eq 'round'; });
}

sub genOperandAttrDef()
{
    print cpp(<<"EOT");
        |
        |public:
        |    unsigned getOperandAttr(Inst inst, unsigned operandIdx) const
        |    {
        |        switch(operandIdx)
        |        {
        |        case 0: return getOperand0Attr(inst);
        |        case 1: return getOperand1Attr(inst);
        |        case 2: return getOperand2Attr(inst);
        |        case 3: return getOperand3Attr(inst);
        |        case 4: return getOperand4Attr(inst);
        |        case 5: return getOperand5Attr(inst);
        |        default:
        |            assert(false);
        |            return OPERAND_ATTR_INVALID;
        |        }
        |    }
        |
EOT
}

sub genPropAttrDeclarations
{
    for my $prop (sort keys %propAttrs)
    {
        my $func = genTargetGetAttr($prop);

        print cpp(<<"EOT");
            |
            |public:
            |    unsigned $func(Inst inst) const;
            |
            |private:
EOT

        for my $req (sort keys %{$propAttrs{$prop}})
        {
            my $store = queryPropAttrs($prop, $req);

            if ($store && $store->{'cattr'})
            {
                print "    template<class T> unsigned ", getTargetProp2Attr($prop, $req), "(T inst) const;\n";
            }
        }
    }

    genOperandAttrDef();
}

sub genHelperAttrDef
{
    my ($prop, $req) = @_;

    my $store = queryPropAttrs($prop, $req);

    if ($store && $store->{'cattr'}) ### conditional attribute; create a helper function to handle this case
    {
        my $reqFunc = getTargetProp2Attr($prop, $req);
        my $invalid = getTargetAttrName(propClass2base($prop), $ATTR_INVALID);
        my $code    = $store->{'code'};

        setContext "generating $reqFunc";
        die "Internal error" unless $code;

        print cpp(<<"EOT");
            |template<class T> unsigned ${className}::$reqFunc(T inst) const
            |{
            |$code
            |    return $invalid;
            |}
            |
EOT
    }
}

sub genMainAttrDef
{
    my ($prop) = @_;

    my $invalid = getTargetAttrName(propClass2base($prop), $ATTR_INVALID);

    my $func = genTargetGetAttr($prop);

    setContext "generating $func";

    genSwitchHeader('unsigned', $func, 'Inst inst');
    for my $inst (sort keys %hdlInst)
    {
        my $chkHdlr;
        my $store = queryPropAttrs($prop, getInstReq($inst));
        next unless $store;

        if ($store->{'cattr'})
        {
            my $chkHdlr = sub { my ($fmt, $i) = @_; return 'return ' . getTargetProp2Attr($prop, getInstReq($inst)) . '<' . $fmt . '>(' . $i . ');' };
            my $errHdlr = sub { my ($i, $msg) = @_; return "return $invalid;" };

            genCase($inst, $chkHdlr, $errHdlr);
        }
        elsif ($store->{'uattr'})
        {
            genCaseHeader($inst, $store->{'code'});
        }
        else # attribute is not defined
        {
            die "Internal error";
        }
    }
    genSwitchFooter($func, sub { return "return $invalid;" });
    print "\n";
}

sub genPropAttrDefinitions
{
    for my $prop (sort keys %propAttrs)
    {
        for my $req (sort keys %{$propAttrs{$prop}})
        {
            genHelperAttrDef($prop, $req);
        }
        genMainAttrDef($prop);
    }
}

###############################################################################
###############################################################################
###############################################################################
# Main Parser

sub parseHDL
{
    my ($fname) = @_;

    my $fd;
    open($fd, '<', $fname);

    $it = make_charstream($fd);
    $lexer = make_lexer( $it, @input_tokens );

    setContext;
    while (my $val = getToken('NAME', 1))
    {
        if ($val eq 'BrigProp')        { parseBrigProp; }
        elsif ($val eq 'BrigBitProp')  { parseBrigBitProp; }
        elsif ($val eq 'OperandProp')  { parseOperandProp; }
        elsif ($val eq 'ExtProp')      { parseExtProp; }
        elsif ($val eq 'MetaProp')     { parseMetaProp; }
        elsif ($val eq 'DependsOn')    { parseDependsOn; }
        elsif ($val eq 'Affects')      { parseAffects; }
        elsif ($val eq 'BrigPrefix')   { parsePrefix; }
        elsif ($val eq 'ExtPropName')  { parseExtPropName; }
        elsif ($val eq 'PropAccessor') { parsePropAccessor; }
        elsif ($val eq 'Clone')        { parseClone; }
        elsif ($val eq 'Alias')        { parseAlias; }
        elsif ($val eq 'Attr')         { parseAttr; }
        elsif ($val eq 'Req')          { parseReq;  }
        elsif ($val eq 'Inst')         { parseInst; }
        elsif ($val eq 'CustomCheck')  { parseCustomCheck; }
        else {
            lexError "Invalid identifier '$val', expected one of: BrigProp, Prop, Clone, Alias, Req, Inst";
        }
        setContext;
    }
    
    close $fd;
}

parseHDL($lib);
parseHDL($idefs);

###############################################################################
# Properties Analyzer (for TestGen only)

                    # This hash is used to identify all instructions described with the same requirement
                    # This is necessary to minimize size of generated tables
my %instReq;        # instReq{$req} = [@inst]

sub registerReq
{
    my ($inst, $req) = @_;

    if (!$instReq{$req})                    # This is the first instruction which uses requirement '$req'
    {
        $instReq{$req} = [$inst];
        return 1;
    }
    else                                    # There are several instructions which use requirement '$req'
    {                                       # Validate that all instructions are encoded in the same format
        my $reqInst = $instReq{$req}[0];
        my $reqfmt  = getInstFormat($reqInst);
        my $fmt     = getInstFormat($inst);

        $fmt eq $reqfmt or lexError "Requirement '$req' is used by instructions '$inst' and '$reqInst' which have different encoding";

        push @{$instReq{$req}}, $inst;
        return 0;
    }
}

sub getRegisteredInst                       # Return one instruction for each registered requirement
{                                           # Tables generated for these instructions will be reused by other instructions
    return sort map { @{$_}[0] } values %instReq;
}

sub getIdenticalInst                        # Return all instructions described by the same requirement as the specified one
{
    my $inst = shift;
    return sort @{$instReq{getInstReq($inst)}};
}

#### For each instruction:
#### - identify all used properties
#### - identify all valid property values
#### - categorize properties by type (meta, primary, etc)

for my $inst (sort keys %hdlInst)
{
    setContext "analyzing instruction '$inst'";

    my $req = getInstReq($inst);
    if (registerReq($inst, $req) && ($ARGV[0] eq "-target=testgen")) { analyzeInstReq($inst, $req, 0); }
}
setContext;

###############################################################################
# Main Optimizer

for my $req (sort keys %hdlReq) {
    setContext "optimizing requirement '$req'";
    optimizeReq($req);
}
setContext;

analyzeAttrs();

###############################################################################
if ($ARGV[0] eq "-target=validator") {
###############################################################################
# Main Generator - Validator Declarations
print $textLicense;
print cpp(<<"EOT");
    |
    |class InstValidator : public PropValidator
    |{
    |private:
    |
    |    // Autogenerated accessors for BRIG properties
    |    #include "HSAILBrigPropsFastAcc_gen.hpp"
    |
    |public:
    |    InstValidator(unsigned model, unsigned profile) : PropValidator(model, profile) {}
    |    void validateInst(Inst inst) const;
EOT

genPropAttrDeclarations();
genCommonDeclarations();

print "\nprivate:\n";
for my $req (sort keys %hdlReq) {
    setContext "generating requirement declaration for '$req'";
    genReqDecl($req);
}
setContext;

print cpp(<<"EOT");
    |
    |}; // class InstValidator
    |
EOT

###############################################################################
# Main Generator - Validator  Definitions

genCommonDefinitions();

for my $req (sort keys %hdlReq)
{
    setContext "generating requirement definition for '$req'";
    genReq($req);
}

genSwitchHeader('void', 'validateInst', 'Inst inst');
for my $inst (sort keys %hdlInst)
{
    setContext "generating switch case for instruction '$inst'";
    genValidatorCase($inst);
}
genSwitchFooter('validateInst', sub { return 'validate(inst, false, "Invalid instruction opcode");' });

print cpp(<<"EOT");
    |
EOT

genPropAttrDefinitions();

###############################################################################
} elsif ($ARGV[0] eq "-target=testgen") {
###############################################################################
# Main Generator - TestGen Declarations

print cpp(<<"EOT");
    |using namespace HSAIL_ASM;
    |
    |class InstSetImpl : public InstSet
    |{
    |private: 
    |
    |    // Autogenerated accessors for BRIG properties
    |    #include "HSAILBrigPropsFastAcc_gen.hpp"
    |
    |public:
    |     InstSetImpl(unsigned model, unsigned profile, const Extension* e) : InstSet(model, profile, e) {}
    |
    |public:
    |    virtual const unsigned* getPropVals(unsigned propId, unsigned& num) const; // should include XXX_VAL_INVALID for invalid values (non-brig only)
    |
    |public:
    |    virtual       unsigned  getFormat(unsigned opcode) const;
    |    virtual const unsigned* getOpcodes(unsigned& num) const;
    |    virtual const unsigned* getProps(unsigned opcode, unsigned& prm, unsigned& sec) const;
    |    virtual const unsigned* getPropVals(unsigned opcode, unsigned propId, unsigned& num) const;
    |    virtual const InstCategory* getCategories(unsigned& num) const;
    |
    |public:
    |    virtual bool isValidProp(Inst inst, unsigned propId) const;
    |    virtual bool validatePrimaryProps(Inst inst) const;
    |    virtual bool isValidInst(Inst inst) const; // for debugging only
    |
    |private:
    |    static unsigned OPCODES[];
    |    static const InstCategory CATEGORIES[];
EOT

genPropAttrDeclarations();
genCommonDeclarations();

print "\nprivate:\n";
for my $prop (sort keys %hdlProp) {
    print '    static unsigned ', getTargetPropValListName($prop), "[];\n";
}

print "\nprivate:\n";
# for my $inst (sort keys %hdlInst) {
for my $inst (getRegisteredInst()) {
    print '    static unsigned ', getTargetReqPropsName($inst), "[];\n";
}

print "\nprivate:\n";
for my $inst (getRegisteredInst()) {
    for my $prop (getOrderedPropList($inst)) {
        print '    static unsigned ', getTargetReqPropValListName($inst, $prop), "[];\n";
    }
    print "\n";
}

print "\nprivate:\n";
for my $inst (getRegisteredInst()) {
    print '    template<class T> bool ', getTargetChkReqPropName($inst), "(T inst, unsigned propId) const;\n";
}

if ($validateTestGen)
{
    print "\nprivate:\n";
    for my $inst (getRegisteredInst()) {
        print '    template<class T> bool ', getTargetReqValidatorName($inst), "(T inst) const;\n";
    }
}

print cpp(<<"EOT");
    |}; // class $className
    |
EOT

genCommonDefinitions();
genPropAttrDefinitions();

#-------------------------------------------------------------------------------
# isBrigProp

### setContext "generating isBrigProp";
### 
### print cpp(<<"EOT");
###     |bool ${className}::isBrigProp(unsigned propId)
###     |{
###     |    switch(propId)
###     |    {
### EOT
### 
### for my $prop (sort keys %hdlProp) {
###     print '    case ', getTargetPropName($prop), ': return ', (isBrigProp($prop)? 'true' : 'false'), ";\n";
### }
### 
### for my $clone (sort keys %hdlClone) {
###     print '    case ', getTargetPropName($clone), ': return ', (isBrigProp($hdlClone{$clone})? 'true' : 'false'), ";\n";
### }
### 
### print cpp(<<"EOT");
###     |    }
###     |    assert(false);
###     |    return false;
###     |}
###     |
### EOT

#-------------------------------------------------------------------------------
# getOpcodes

setContext "generating getOpcodes";

print cpp(<<"EOT");
    |unsigned ${className}::OPCODES[] =
    |{
EOT

for my $name (@hdlInstList)
#for my $name (sort keys %hdlInst)
{
    print "    ", getTargetInstName($name), ",\n";
}

print cpp(<<"EOT");
    |};
    |
    |const unsigned* ${className}::getOpcodes(unsigned& num) const
    |{
    |    num = sizeof(OPCODES) / sizeof(unsigned);
    |    return OPCODES;
    |}
    |
EOT

#-------------------------------------------------------------------------------
# getCategories

setContext "generating getCategories";

print cpp(<<"EOT");
    |const InstCategory ${className}::CATEGORIES[] =
    |{
EOT

for my $name (sort keys %hdlInst)
{
    print "    {", getTargetCategoryName(getInstCategory($name)), ", ", getTargetInstName($name), "},\n";
}

print cpp(<<"EOT");
    |};
    |
    |const InstCategory* ${className}::getCategories(unsigned& num) const
    |{
    |    num = sizeof(CATEGORIES) / sizeof(InstCategory);
    |    return CATEGORIES;
    |}
    |
EOT

#-------------------------------------------------------------------------------
# getFormat

setContext "generating getFormat";

print cpp(<<"EOT");
    |unsigned ${className}::getFormat(unsigned opcode) const
    |{
    |    switch(opcode)
    |    {
EOT

for my $name (sort keys %hdlInst)
{
    my $brigFormat = getTargetFormatName(getInstFormat($name));
    print "    case ", getTargetInstName($name), ': return ', $brigFormat, ";\n";
}

print cpp(<<"EOT");
    |    }
    |
    |    assert(false);
    |    return (unsigned)-1;
    |}
    |
EOT

#-------------------------------------------------------------------------------
# getPropVals(unsigned propId, unsigned& num)

setContext "generating getPropVals(propId, num)";

sub printPropValList
{
    my ($prop, @list) = @_;

    my %values; # used to remove duplicates

    for my $val (@list)
    {
        # Property values may have attribites specified after the name, e.g. "reg.generic"
        # These attributes are not a part of property value and must be removed.
        # Attributes removal result in identical names which must be removed as well, e.g.
        # "reg.generic" and "reg.stype" are both reduced to "reg".

        ($val) = getAttr($prop, $val); # remove attr if any

        if (!$values{$val}) { # remove duplicates
            print '    ', getTargetValName($prop, $val), ",\n";
        }
        $values{$val} = 1;
    }
}

sub printPropValues
{
    my $prop = shift;

    printPropValList($prop, sort keys %{$hdlProp{$prop}});

    if (!isBrigProp($prop)) {
        print '    ', getTargetValName($prop, 'INVALID'), ",\n";
    }
}

for my $prop (sort keys %hdlProp) {
    print "unsigned ${className}::", getTargetPropValListName($prop), "[] = \n{\n";
    printPropValues($prop);
    print "};\n\n"
}

sub printPropValsCode
{
    my $prop = shift;
    my $arrName = getTargetPropValListName($prop);
    print '    case ', getTargetPropName($prop), "num = sizeof($arrName) / sizeof(unsigned); return $arrName;\n";
}

print cpp(<<"EOT");
    |const unsigned* ${className}::getPropVals(unsigned propId, unsigned& num) const // should include XXX_VAL_INVALID for invalid values (non-brig only)
    |{
    |    switch(propId)
    |    {
EOT

for my $prop (sort keys %hdlProp)
{
    for my $clone (sort keys %hdlClone) {
        if (getBaseProp($clone) eq $prop) {
            print '    case ', getTargetPropName($clone), ":\n";
        }
    }

    my $arrName = getTargetPropValListName($prop);
    print '    case ', getTargetPropName($prop), ": \tnum = sizeof($arrName) / sizeof(unsigned); return $arrName;\n\n";
}

print cpp(<<"EOT");
    |    }
    |    assert(false);
    |    num = 0;
    |    return 0;
    |}
    |
EOT

#-------------------------------------------------------------------------------
# getProps

setContext "generating getProps";

for my $inst (getRegisteredInst())
{
    print "unsigned ${className}::", getTargetReqPropsName($inst), "[] =\n";
    print "{\n";
    for my $prop (getOrderedPropList($inst)) {
        print '    ', getTargetPropName($prop), ',', ' ' x (20 - length(getTargetPropName($prop))), '// ', getPropKindName($inst, $prop), "\n";
    }
    print "};\n\n";
}

print cpp(<<"EOT");
    |const unsigned* ${className}::getProps(unsigned opcode, unsigned& prm, unsigned& sec) const
    |{
    |    switch(opcode)
    |    {
EOT

for my $inst (getRegisteredInst())
{
    for my $i (getIdenticalInst($inst)) {
        print '    case ', getTargetInstName($i), ":\n";
    }

    print '        prm = ', getInstPropsNum($inst, $LDG) + getInstPropsNum($inst, $PRM), ";\n";
    print '        sec = ', getInstPropsNum($inst, $CND) + getInstPropsNum($inst, $DEP) + getInstPropsNum($inst, $PLN), ";\n";
    print '        return ', getTargetReqPropsName($inst), ";\n";
    print "\n";
}

print cpp(<<"EOT");
    |    }
    |
    |    assert(false);
    |    prm = 0;
    |    sec = 0;
    |    return 0;
    |}
    |
EOT

#-------------------------------------------------------------------------------
# getPropVals(unsigned opcode, unsigned propId, unsigned& num)

setContext "generating getPropVals(opcode, propId, num)";

for my $inst (getRegisteredInst()) {
    for my $prop (getOrderedPropList($inst)) {
        print "unsigned ${className}::", getTargetReqPropValListName($inst, $prop), "[] =\n";
        print "{\n";
        printPropValList($prop, getInstPropVals($inst, $prop));
        print "};\n\n";
    }
}

print cpp(<<"EOT");
    |const unsigned* ${className}::getPropVals(unsigned opcode, unsigned propId, unsigned& num) const
    |{
    |    switch(opcode)
    |    {
EOT

for my $inst (getRegisteredInst())
{
    for my $i (getIdenticalInst($inst)) {
        print '    case ', getTargetInstName($i), ":\n";
    }

    print "        switch(propId)\n";
    print "        {\n";
    for my $prop (getOrderedPropList($inst)) {
        print '        case ', getTargetPropName($prop), ":\n";
        print '            num = sizeof(', getTargetReqPropValListName($inst, $prop), ") / sizeof(unsigned);\n";
        print '            return ', getTargetReqPropValListName($inst, $prop), ";\n";
    }
    print "        default: \n";
    print "            assert(false);\n";
    print "            return 0;\n";
    print "        }\n";
    print "\n";
}

print cpp(<<"EOT");
    |    }
    |
    |    assert(false);
    |    num = 0;
    |    return 0;
    |}
    |
EOT

#-------------------------------------------------------------------------------
# isValidProp

# The following table describes rules used for generation of property validation checks.
#
# -----------------------------------------------------------------------------------------------------------------------------------------
# |-- prop ----|-- name  --|-- skip cond --|-- keep all prm --|-- prop filter --| chk mode  |-- postponed ---|----- note -----------------|
# -----------------------------------------------------------------------------------------------------------------------------------------
# | primary    | PRM, LDG  |  y            |   no             |  this prop      |   LIGHT   |                |                            |
# | last prm   | PRM, LDG  |  no           |   in conds only  |  mta + all prm  |   HEAVY   |                |                            |
# | meta       |   MTA     |  no           |   in conds only  |  mta + all prm  |   HEAVY   |                | checked only with last prm |
# | conditional|   CND     |  no           |   in conds only  |  this + all prm |   HEAVY   | skip chk group |                            |
# | dependent  |   DEP     |  y            |   no             |  this prop      |   LIGHT   |                | not used in conds          |
# | plain      |   PLN     |  y            |   no             |  this prop      |   LIGHT   |                |                            |
# | all        |    -      |  no           |   yes            |     -           |   FULL    |                | for selfvalidation         |
# -----------------------------------------------------------------------------------------------------------------------------------------
#
# This table uses the following notation:
#
# - 'skip cond'     weather to skip conditionals { ... ? ... }
# - 'prop filter'   list of properties to keep
# - 'chk mode'      check mode as passed to 'genInstPropCheck'
#

sub genSelectorChk
{
    my ($chk, $mode, $indent, @list) = @_;

    my $prop = getChkPropName($chk);

    if ($mode eq 'FULL' || grep { $prop eq $_ } @list) {
        print $indent, genAssert($chk, '');
    }
}

sub genSelectorCond
{
    my ($cond, $mode, $indent, $first, @list) = @_;

    return if $mode eq 'LIGHT';

    if ($first) { # First format variant
        print "\n";
        print $indent, "if (\n";
    } else {
        print $indent, "else if (\n";
    }

    print join(" &&\n", map { genCheck($_, $indent . '    ') } getChkCondTests($cond)), "\n";
    print $indent, "   )\n";
    print $indent, "{\n";

    for my $chk (getChkCondAsserts($cond)) {
        if (isChkCall($chk)) {  # NB: nested conditionals are not supported. This is checked by analyzeInstReq
            genSelector(getChkCallName($chk), $mode, $indent, @list); # recursive
        } else {
            genSelectorChk($chk, $mode, $indent, @list);
        }
    }

    print $indent, "}\n";
}

sub genSelectorCondEnd
{
    my ($chk, $mode, $indent, @list) = @_;

    return if $mode eq 'LIGHT';

    print $indent, "else\n";
    print $indent, "{\n";
    print $indent, "    return false;\n";
    print $indent, "}\n";
}

sub genSelector
{
    #### Generate code that will validate property values
    ####    $req    - requirement for which code is generated
    ####    $mode   - check mode (LIGHT, HEAVY or FULL)
    ####    $indent - code indentation
    ####    @list   - list of properties which must be checked. Other properties are filtered out.

    my ($req, $mode, $indent, @list) = @_;
    my @reqlist = @{$hdlReq{$req}};
    my $first = 1;

    for my $chk (@reqlist)
    {
        if (isChkProp($chk)) {
            genSelectorChk($chk, $mode, $indent, @list);
        } elsif (isChkCall($chk)) {
            genSelector(getChkCallName($chk), $mode, $indent, @list); # recursive
        } elsif (isChkCond($chk)) {
            genSelectorCond($chk, $mode, $indent . '    ', $first, @list);
            $first = 0;
        } elsif (isChkEnd($chk)) {
            genSelectorCondEnd($chk, $mode, $indent . '    ', @list);
            $first = 1;
        } else {
            die "internal error";
        }
    }
}

sub genInstPropCheck
{
    #### Generate code that will validate property values
    ####    $inst - instruction for which code is generated
    ####    $prop - property being validated
    ####    $kind - kind of property (used in comments only)
    ####    $mode - check mode (LIGHT or HEAVY)
    ####    @list - list of properties '$prop' depends on. Other properties will be filtered out.

    my ($inst, $prop, $kind, $mode, @list) = @_;
    my $req = getInstReq($inst);

    print "        // $kind Property\n";
    print '        case ', getTargetPropName($prop), ":\n";
    print "        {\n";

    genSelector($req, $mode, '        ', @list);

    print "\n";
    print "            return true;\n";
    print "        }\n";
    print "\n";
}

sub genIsValidProp
{
    my $inst = shift;
    my @metaProps = getInstProps($inst, $MTA);
    my @prmProps  = (getInstProps($inst, $LDG), getInstProps($inst, $PRM));
    my @firstPrmProps = @prmProps[0 .. $#prmProps - 1];
    my $lastPrimaryProp = $prmProps[$#prmProps] // '';

    for my $prop (@firstPrmProps)            { genInstPropCheck($inst, $prop, 'Primary',      'LIGHT', ($prop)); }
    if (my $prop = $lastPrimaryProp)         { genInstPropCheck($inst, $prop, 'Last Primary', 'HEAVY', (@prmProps, @metaProps)); }
    for my $prop (getInstProps($inst, $CND)) { genInstPropCheck($inst, $prop, 'Conditional',  'HEAVY', ($prop, @prmProps)); } # FIXME: do not include checks for primary outside conds
    for my $prop (getInstProps($inst, $DEP)) { genInstPropCheck($inst, $prop, 'Dependent',    'LIGHT', ($prop)); }
    for my $prop (getInstProps($inst, $PLN)) { genInstPropCheck($inst, $prop, 'Plain',        'LIGHT', ($prop)); }
}


for my $inst (getRegisteredInst())
{
    print "template<class T> bool ${className}::", getTargetChkReqPropName($inst), "(T inst, unsigned propId) const\n";
    print "{\n";
    print "    switch(propId)\n";
    print "    {\n";

    genIsValidProp($inst);

    print "    default: \n";
    print "        assert(false);\n";
    print "        return false;\n";
    print "    }\n";
    print "}\n";
}

sub genChkPropCase
{
    my $name = shift;
    my $chkHdlr = sub { my ($fmt, $inst) = @_; return 'return ' . getTargetChkReqPropName($name) . '<' . $fmt . '>(' . $inst . ', propId);' };
    my $errHdlr = sub { my ($inst, $msg) = @_; return 'assert(false); return false;' };

    for my $i (getIdenticalInst($name)) {
        genCaseHeader($i);
    }

    genCaseBody($name, $chkHdlr, $errHdlr);
}

genSwitchHeader('bool', 'isValidProp', 'Inst inst, unsigned propId');

for my $inst (getRegisteredInst())
{
    setContext "generating switch case for instruction '$inst'";
    genChkPropCase($inst);
}

genSwitchFooter('isValidProp', sub { return 'assert(false); return false;' });

#-------------------------------------------------------------------------------
# validatePrimaryProps

print cpp(<<"EOT");
    |
    |bool ${className}::validatePrimaryProps(Inst inst) const
    |{
    |    unsigned prm;
    |    unsigned sec;
    |    const unsigned* props = getProps(inst.opcode(), prm, sec);
    |    if (prm > 0) return isValidProp(inst, props[prm - 1]);
    |    assert(false);
    |    return false;
    |}
    |
EOT

#-------------------------------------------------------------------------------
# isValidInst

sub genIsValidInst
{
    my $inst = shift;
    my $req = getInstReq($inst);

    genSelector($req, 'FULL', '', ());
}

sub genIsValid
{
    my $name = shift;
    my $chkHdlr = sub { my ($fmt, $inst) = @_; return 'return ' . getTargetReqValidatorName($name) . '<' . $fmt . '>(' . $inst . ');' };
    my $errHdlr = sub { my ($inst, $msg) = @_; return 'assert(false); return false;' };

    for my $i (getIdenticalInst($name)) {
        genCaseHeader($i);
    }

    genCaseBody($name, $chkHdlr, $errHdlr);
}

if ($validateTestGen)
{
    for my $inst (getRegisteredInst()) {
        print "template<class T> bool ${className}::", getTargetReqValidatorName($inst), "(T inst) const\n";
        print "{\n";

        genIsValidInst($inst);

        print "    return true;\n";
        print "}\n\n";
    }

    genSwitchHeader('bool', 'isValidInst', 'Inst inst');

    for my $inst (getRegisteredInst())
    {
        setContext "generating switch case for instruction '$inst'";
        genIsValid($inst);
    }

    genSwitchFooter('isValidInst', sub { return 'assert(false); return false;' });
}

###############################################################################
} # -target=testgen
###############################################################################

###############################################################################
# TODO
# - reimplement 'sub _tokens'
# - req_mov includes "OPERAND_VALUES_REGNOEXP", should be "OPERAND_VALUES_REG" as "EXP" is an attr
# -
# -
# - generate HSAILTestGenCategories.h
# - cannot define "MetaProp type.size = ..."
#    - problem with ".": internal error
#    - investigate issue detect error when metaprop with "." is defined
# - is it possible to move complex checks from Validator back to InstValidator?
# - in the following code, there is a missing ";" which causes the following err message: expected '('
#    s2 = (reg, imm).32 s3 = null;
# - format should be a part of requirement, not instruction!
#
#
# STYLE
# - minimize use of shift, $_[...], $_[x..y]
#
#
#
#
#
#
#
#
# POSTPONED
# - reviw parsing of '(', '*', etc
# - check diagnostic messages: they are misleading in some cases
# - testing
# - compare performance with old version
# - would it be possible to use new notation for TestGen?
# - extend optimizer to collect all err messages like "Invalid instruction format, expected InstBase"
# - optimize operands
# - optimize all other props
#   - AluMod:
# - make dumper
# - "." as NIL
# - in DEBUG mode, generate a list of all prop values for additional validation
#   - operands:
#     - validate generic operands
#     - some conditions must be asserts (checks are not supported)
#   - ctype: only one element in a list
#   - attribute is only allowed with non-Brig props
#   - Big props may only include Brig enum values
#   - Each prop is specified only once (except for variants)
#   - props correspond to instruction format

# - process attrs separately
#   - skip if NONE
#   - call check${prop}${attr} # e.g. checkOperandGeneric

###############################################################################
# DONE
#
# + err handling: refer to context in validator file
# + nested refs to req: req Add { req Sub; }
# + replace all " with ' where possible
# + allow "." in prop values, reqirements and aliases
# + make ";" before "?" optional
# + fix comments bug
# + check -> isValid
# + allow nested req only in toplevel or in asserts, disable in checks
# + PropAlias (e.g. to avoid defining both type and stype)
# + "." in identifiers
# + ";" is optional before "?" and "}"
# + grouping and concatenation using "(" and ")"
# + set substraction using "/"
# + "custom" checks
# + list of prop values may include duplicate values; eliminate them
# + improve error reporting
# + error reporting: improve for errors that occur just after req, etc (currently refer to that req, etc)
# + make sure there are no duplicated array names
# + limit length of generated names
# + revise attributes
# + how to select order of prm props chks? They might depend on each other!

