{ %pragma listlvl:2; }
{
 ******************************************************************************
 *                                                                            *
 *                                                                            *
 *                                                                            *
 *                        MMM    MMM   XXX      XXX  DDDDDDDD                 *
 *                        MMMM  MMMM    XXX    XXX   DDDDDDDDDD               *
 *                        MM MMMM MM     XXX  XXX    DD      DDD              *
 *                        MM  MM  MM      XXXXXX     DD       DD              *
 *                        MM      MM       XXXX      DD       DD              *
 *          T  H  E       MM      MM       XXXX      DD       DD              *
 *                        MM      MM      XXXXXX     DD       DD              *
 *                        MM      MM     XXX  XXX    DD      DDD              *
 *                        MM      MM    XXX    XXX   DDDDDDDDDD               *
 *                       MMMM    MMMM  XXX      XXX  DDDDDDDD                 *
 *                                                                            *
 *                                                                            *
 *                                                                            *
 *                 SSSSS Y     Y  SSSSS TTTTTTT EEEEEE M     M                *
 *                S       Y   Y  S         T    E      MM   MM                *
 *                S        Y Y   S         T    E      M M M M                *
 *                 SSSS     Y     SSSS     T    EEEEE  M  M  M                *
 *                     S    Y         S    T    E      M     M                *
 *                     S    Y         S    T    E      M     M  ..            *
 *                SSSSS     Y    SSSSS     T    EEEEEE M     M  ..            *
 *                                                                            *
 *                                                                            *
 *                                                                            *
 *              ---  Version  3.999 000 alpha -- 31/03/2010 ---               *
 *                                                                            *
 *                by :                                                        *
 *                                                                            *
 *                     P. Wolfers                                             *
 *                         c.n.r.s.                                           *
 *                         Institut Neel (MCMF), Bat F,                       *
 *                         B.P.  166 X   38042  Grenoble Cedex                *
 *                                                FRANCE.                     *
 *                                                                            *
 *                                                                            *
 ******************************************************************************


///////////////////////////////////////////////////////////////////////////////
//                                                                           //
//                                                                           //
//                     Global Public Licence (GPL)                           //
//                                                                           //
//                                                                           //
//    This license described in this file overrides all other licenses       //
//    that might be specified in other files for this software.              //
//                                                                           //
//    This program is free software; you can redistribute it and/or          //
//    modify it under the terms of the GNU Lesser General Public             //
//    License as published by the Free Software Foundation; either           //
//    version 2.1 of the License, or (at your option) any later version.     //
//                                                                           //
//    This software is distributed in the hope that it will be useful,       //
//    but WITHOUT ANY WARRANTY; without even the implied warranty of         //
//    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU      //
//    Library General Public License for more details.                       //
//                                                                           //
//    You should have received a copy of the GNU Lesser General Public       //
//    License along with this library (see COPYING.LIB); if not, write to    //
//    the Free Software Foundation :                                         //
//                         Inc., 675 Mass Ave, Cambridge, MA 02139, USA.     //
//                                                                           //
///////////////////////////////////////////////////////////////////////////////



*******************************************************************************
*                                                                             *
*                                                                             *
*            MXD   Data   Compiler   item   management   module               *
*                                                                             *
*                                                                             *
*******************************************************************************


}

{************     CPAS  version    *************}

{
        *** Modification(s) from major version ***


                  ----

                 NOTHING

                  ----

}

module MXD_DCP_ITEM;


  %include       'MXDSRC:mxd_dcp_env';          { Load the MXD data Compiler Environment }




{**************************************************}
{*******          Type Declarations          ******}
{**************************************************}




{ ******************************************************************** }
{ ***********  Variables to get and parse a SHELL command  *********** }
{ ******************************************************************** }

var
  itm_cfl:                     ide_ptr;         { Local pointer of current item }
  itm_idx:                     integer;         { Current local item field index }



{ ************************************************************************************* }
{ ***  Global Variables of MXD-Data ComPiler environment declared with init values  *** }
{ ************************************************************************************* }





procedure ITEM_ADAPT_NAME( in_var snm: string; var nam: string; var nv: integer );
{ Item Name adaptation.
    When the name is null we force the default name "?Undefined?",
    Else
      we elliminate any not authorized character ( Control char., "?" or ";") that
      are replaced by spaces.
    When the string is too long we keep the six last characters and suppress the
    there previous one too fit with the maximum identifier name size.
}
var
  ii, jj, sz:  integer;
  ch:             char;
  sn:     string( 30 );

begin
  nv := 0;
  if snm.length = 0 then nam := '?Undefined?'
  else
  begin { Handle the version number when it is specified }
    sz := snm.length;                           { get the input string length }
    ii := INDEX( snm, ';', -1 );                { Look for the last semicolon in the name }
    if (ii > 1) and (snm.length-ii <= 6) then
    begin
      jj := ii + 1;
      while jj <= snm.length do                 { Loop to get a legal item version number }
      begin
        ch := snm[jj];
      exit if (ch < '0') or (ch > '9');         { Stop when ch is not a digit }
        nv := nv*10 + (ORD( ch ) - ORD( '0' )); { Compute the version number }
        jj := jj + 1
      end;
      if jj > snm.length then sz := ii - 1      { Change the string length to suppress the version number and its related ";" }
                         else nv := 0           { Illegal version number => we ignore it }
    end;
    ii := 0;
    if sz > ide_maxsize then jj := ide_maxsize - 7
                        else jj := sz;
    while ii < jj do
    begin { Loop to copy and replace illegal character }
      ii := ii + 1; ch := snm[ii];
      if (ch < ' ') or (ch = ';') or (ch = '?') or (ch > '}') then ch := ' ';
      nam[ii] := ch
    end;
    if ii < sz then                             { When some character(s) was not copied (too long string) }
      while ii < ide_maxsize do                 { Loop to copy (and replace ill. char.) the six last characters }
      begin { Complementary loop to copy for too long item name }
        jj := jj + 1; ch := snm[jj];
        if (ch < ' ') or (ch = ';') or (ch = '?') or (ch > '}') then ch := ' ';
        ii := ii + 1; nam[ii] := ch
      end;
    nam.length := ii                            { set the final string length }
  end
end ITEM_ADAPT_NAME;



procedure ITEM_SET_NAME( itl: itm_ptr; in_var snm: string; var nam: string; var nv: integer );
{ Create a new unique string and version number set in the item list <itl> from the string <snm>.
  The resulting item name is put in the procedure argument <nam> and the related version number
  is nv.
}
var
  ii, jj, np:  integer;
  ch:             char;

begin
  nv := 0;
  np := 0;
  ITEM_ADAPT_NAME( snm, nam, nv );

  { Loop to search any identical item name of the same type }
  while itl <> nil do
    with itl^ do
    begin
      if nam = itm_name^ then                   { When the name are same }
        { When a version is specified, and the versions are matching we increment the version number }
        if nv > 0 then begin  if itm_nver = nv then nv := nv + 1  end
                  else if np < itm_nver then np := itm_nver; { Else, we keep the maximum version number }
      itl := itm_next
    end;

  if nv = 0 then nv := np + 1                   { When a version was not specified, we return the max. version number + 1 or 0 ... }
                                                { ... else we return the maximum version number + 1 }
end ITEM_SET_NAME;



[global]
function ITEM_SEARCH( typ: typ_ptr; in_var sname: string ): itm_ptr;
var
  tpa:         typ_ptr;
  itc, itm:    itm_ptr;
  nv:          integer;
  tmp:          string;
  ch:             char;

begin
  ITEM_ADAPT_NAME( sname, tmp, nv );            { Put the string name in form of item name and version number }
  itm := nil;
(*
WRITELN( ' Search item "', sname, '" in item type list "', itmty^.ide_name, '"' );
*)

  if typ <> nil then
  begin
   if typ^.typ_par <> nil then typ := typ^.typ_par;  { Always search item in the parent item list }
   itc := typ^.typ_fit;                         { Get the head of item list }
    while itc <> nil do                         { Loop to search the specified item }
      with itc^ do
      begin
        if tmp = itm_name^ then                 { When the name match ... }
          if nv > 0 then                        { ... and a version was specified, ... }
          begin
            if nv = itm_nver then               { ... if the versions match then we stop the loop, ... }
            begin  itm := itc; exit  end
          end
          else itm := itc;                      { ... else when no version was specified, we keep the reference and loop }
        itc := itm_next
      end

    { Here, itm^ is the selected item in the queue or nil (when not found) }
(*
;WRITELN( ' Find item "', itm^.itm_name^, '"' )
*)
  end;
  ITEM_SEARCH := itm
end ITEM_SEARCH;



function  ITEM_NEW( itmty: ide_ptr; in_var sname: string ): itm_ptr;
const
  mdnam = 'CITM';

var
  itm, it2:    itm_ptr;
  typ, tpa:    typ_ptr;
  snm:          string;
  nver, idf:   integer;
  fid:         ide_ptr;

begin
  itm := nil;
  if itmty <> nil then                          { For previous error security }
  begin
    typ := itmty^.ide_typ;
    if typ <> nil then                          { For previous error security }
    with typ^ do
    begin
      if typ_par <> nil then tpa := typ_par     { Get parent item definition when it exist }
                        else tpa := typ;
      NEW( itm, typ_nfl );                      { Create the item record }
      ITEM_SET_NAME( tpa^.typ_fit, sname, snm, nver );  { Create an Unique String Item Name }
      with itm^ do
      begin
        NEW( itm_name, snm.length );            { Create the item name string }
        itm_name^  :=      snm;
        itm_next   :=      nil;                 { Init the item record }
        itm_sitm   :=      nil;
        itm_own    :=      nil;                 { Assume no owner until shown otherwise }
        itm_typ    :=      typ;                 { Set the item type link }
        itm_nver   :=     nver;                 { Set the version number }
        itm_nref   :=        0;                 { Init the reference count }

        { Allocate an integer identifier number when required (for LSQ code items) }
        with tpa^ do
          if typ_nsq > 0 then begin  itm_sequ := typ_nsq; typ_nsq := typ_nsq + 1  end
                         else itm_sequ := 0;

        { Allocate and Init the argument table }
        fid := typ_fel; idf := 1;
        while (fid <> nil) and (idf <= typ_nfl) do
        begin
          VAL_ALLOCATE( itm_tab[idf], fif^.ide_typ );
          fid := fid^.ide_lnk; idf := idf + 1
        end;
(*
        { Init the argument table }
        for ii := 1 to typ_nfl do
        begin
          itm_tab[ii].val_frm := vfrm_null
        end;
*)
(*
;WRITELN( ' Create the item ', itm_name^, ';', itm_nver:0, ' of type "', itm_typ^.ide_name^,
          '" with nid = ', typ_nid:0, ', nfl = ', typ_nfl:0, ', nsq = ', typ_nsq:0 );
*)
      end;
      itm_cfl := typ_fel;                       { Init the currents field pointer and index }
      itm_idx := 1
    end
  end;
  ITEM_NEW := itm
end ITEM_NEW;



function  ITEM_SET_FIELD( itp: itm_ptr; var exp: exp_rec; idx: integer := 0 ): boolean;
{ Put the expression in the <exp>, in the item field # <idx> of the item <itm^>.
}
const
  mdnam = 'ITSF';

var
  its:         itm_ptr;
  id2:         integer;
  rfm:       val_forms;
  ber:         boolean;

begin
  if itp <> nil then
  with itp^ do
  begin
    if itm_typ <> nil then
    with itm_typ^ do
    begin
      if idx > 0 then
      begin
        itm_cfl := typ_fel; itm_idx := 1;
        while (id2 < idx) and (itm_cfl <> nil) do
        begin
          if itm_cfl^.ide_lnk <> nil then itm_cfl := itm_cfl^.ide_lnk;
          itm_idx := itm_idx + 1
        end
      end;
      if itm_cfl <> nil then
      with itm_cfl^, exp, exp_val do
      begin
        if val_frm = vfrm_null then             { For any empty parameters }
        begin
          exp_flg := [];                        { Clear any trailing flags }
          exp_typ := itm_cfl^.ide_typ;          { Set the field expression type }
          if exp_typ <> nil then
            with exp_typ^ do
              if typ_frm = tfrm_array then exp_esz := typ_siz*typ_stp;

          if (not itm_cfl^.idef_option) then    { Signal error when the field was not optional }
            SRC_ERROR_S( mdnam, 254, e_error, itm_cfl^.ide_name^, itm_name^ )
        end
        else
        begin
          rfm := GET_VAL_FORMS( ide_typ );      { Get the value form corresponding to the field type }
          if rfm = vfrm_itm then
          begin
            its := nil;
            if val_frm = vfrm_str then          { Item field is specified as a string name }
            begin
              its:=ITEM_SEARCH( ide_typ,str^ ); { Find the item pointer ... }
              val_frm := vfrm_itm; itm := its   { ... and change the expression to item reference }
            end
          end;
          ber := false;
          if rfm <> val_frm then                { Check for expression match }
            case rfm of
              vfrm_int: case val_frm of
                          vfrm_flt: begin val_frm := vfrm_int; int := ROUND( flt )  end;
                        otherwise
                          ber := true
                        end;
              vfrm_flt: case val_frm of
                          vfrm_int: begin val_frm := vfrm_flt; flt :=int  end;
                        otherwise
                          ber := true
                        end;
            otherwise
              ber := true
            end;
            if ber then
            begin
              SRC_ERROR_S( mdnam, 255, e_error, itm_cfl^.ide_name^, itm_name^ );
              val_frm := vfrm_null
            end
        end;
        if not objf_lsqex in exp_flg then
        case  of
        otherwise
        end;
        itm_tab[itm_idx] := exp.exp_val;
        if itm_sequ > 0 then OUT_PCD_VREF( exp, false )
      end;
      if itm_idx < typ_nfl then
      begin  itm_idx := itm_idx + 1; itm_cfl := itm_cfl^.ide_lnk  end
    end
  end;
  ITEM_SET_FIELD := false
end ITEM_SET_FIELD;



[global]
procedure DECLARE_ITEM_TYPE;
{ Item Type Declaration procedure ::
   The syntax is :

   ITEM [ <int_lvl> ] <item_type_ide> [ ( <item_type> <str_ide> [, <item_type> <str_ide> [*] [, ... ] ] ]
           [: <int_def_node_code> [: <int_ref_node_code> ]] IS
           <field_item> [, ... ] : <type_ide>
           [ ; ... ]
   END

   The star character flag the optionel identification string in the declaration of this item object.

   When LSQ code(s) are specified, the item definition generate always a LSQ node code to be handle by the application programs.

}
const
  mdnam = 'NITT';

var
  typ, tpa:            typ_ptr;
  idf, ide, idc:       ide_ptr;
  lvl, nid, nfl, nsq:  integer;

begin
  with sy_sym do
  begin
    INSYMBOL;                                   { Gobble up the ITEM keyword }
    ide := nil;
    typ := nil;
    if sy = intconst then                       { When a lex level display is specified }
    begin
      lvl := sy_ival;                           { When a target display level is specified, we get it }
      if lvl <= 0 then lvl := curr_disp - lvl;
      if lvl < 0 then lvl := 1                  { It is possible to create item type in the predefined lex level display }
                 else if lvl > curr_disp then lvl := curr_disp;
      INSYMBOL
    end else lvl := 1;                          { The predefined les level display is defaulted for item types }

    { We try to create the item type identifier }
    if CHECK_SYMB_ERR( mdnam, identsy, 251 ) then goto ET_END
                                             else ide := IDE_NEW( cla_type, nil, lvl );
    INSYMBOL;                                   { Gobble up the item type identifier name }
    if ide <> nil then
    begin
      tpa := nil;                               { Assume as native item until shown otherwise }
      if (sy = relop) and (op = eq_op) then
      begin
        INSYMBOL;                               { Gobble up ":" }
        if sy = identsy then
        begin
          idc := IDE_SEARCH( false,[cla_type] );{ Look for an item type identifier is specified }
          INSYMBOL;                             { Gobble up the parent item type identifier name }
          if idc <> nil then
          begin
            tpa := idc^.ide_typ;
            if tpa <> nil then
              if tpa^.typ_frm <> tfrm_itmty then
              begin  SRC_ERROR( mdnam, 256, e_error ); tpa := nil  end
          end
        end
      end;
      typ := TYP_NEW( tfrm_itmty, ide, tpa, lvl );      { Create the item type record }
      ide^.ide_typ := typ
    end;

    if typ <> nil then                          { When the item type creation is a success }
    with typ^ do
    begin
      nfl := 0;
      DISPLAY_NEW;                              { Create an Item display level }
      if sy = lparen then                       { When some complementary identification fields are required ... }
      begin
        repeat                                  { ... perform the identification field definition loop }
          INSYMBOL;                             { Gobble up "(" or ";" }
          nfl := nfl + VARBL_DECL( cla_field, true );

        until sy <> semicolon;
        if sy = rparen then INSYMBOL
                       else SRC_ERROR( mdnam, 23, e_error )
      end;
      nid := nfl;                               { Keep the number of identification field(s) }

      if tpa <> nil then                        { For children item, the default is to use parent code }
      begin
        typ_nsq := tpa^.typ_nsq;
        typ_dcd := tpa^.typ_dcd;
        typ_rcd := tpa^.typ_rcd
      end;

      if sy = colon then                        { When the colon used to specify LSQ node Codes is readden }
      begin
        INSYMBOL;                               { Gobble up ":" }
        typ_dcd := GET_INTEXPR( typ_dcd );      { Set the definition LSQ node code }
        if typ_dcd > 0 then typ_nsq := 1;       { Initialize the specific item count index (integer identifier) }
        if sy = colon then                      { Set the reference LSQ node code when specified }
        begin  INSYMBOL; typ_rcd := GET_INTEXPR( typ_rcd )  end
      end;

      if (sy <> issy) and ((sy <> relop) or (op <> eq_op)) then SRC_ERROR( mdnam, 55, e_error );

      repeat                                    { Perform the fields definition loop }
        INSYMBOL;                               { Gobble up "is", "=" or ";" }
        nfl := nfl + VARBL_DECL( cla_field, true );     { Declare field(s) for each specified type }
      until sy <> semicolon;

      { Re-ordered the item field list in the declaration order }
      idf := nil;
      ide := disp_tab[curr_disp].disp_lid;
      while ide <> nil do                       { Loop to reverse the ordering }
      begin
        idc := ide;                             { Keep the address of current field identifier }
        with idc^ do                            { Warning: the with pointer is a copy of idc (not ide), then ... }
        begin
          ide := ide_lnk;                       { ... we can keep the next of the original LIFO }
          ide_lnk := idf;                       { Save the previous field address in the formal link }
          idf := idc                            { Set the current field address as the new first field  }
        end
      end;

      typ_fel := disp_tab[curr_disp].disp_idt;  { Set the first and last item field pointer }
      typ_lel := disp_tab[curr_disp].disp_lid;

      nsq := 0;
      idc := typ_fel;
      for ii := 1 to nfl do
        with idc^ do
        begin
          idef_sequnb :=  ii;
          idef_offset := nsq;
          if ide_typ <> nil then
            with ide_typ^ do
              case typ_frm of
                tfrm_array: nsq := nsq + typ_siz*typ_stp;
              otherwise
                nsq := nsq + 1
              end;
          idc := ide_lnk
        end;

      curr_disp := curr_disp - 1;               { Go out of the Item displaty level }

      typ_nid := nid;                           { Keep the numbers of item fields }
      typ_nfl := nfl;
(*
WRITELN( ' NEW item type "', typ_ide^.ide_name^, '" with nid = ', typ_nid:0, ' nfl = ', typ_nfl:0 );
WRITELN( '    nsq = ', typ_nsq:0, ', dcd = ', typ_dcd:0, ', rcd = ', typ_rcd:0 );
WRITELN( '    With fields : ' );
idc := typ_fel;
while idc <> nil do
with idc^ do
begin
  WRITELN( ' ':6, 'ide = ', ide_name^, ':', ide_typ^.typ_ide^.ide_name^, ' opt = ', idef_option, ', sqnb = ', idef_sequnb:0 );
  idc := ide_lnk
end;
WRITELN;
*)
      if sy <> endsy then begin  SRC_ERROR( mdnam, 58, e_severe ); SKIP_SYMBOL( semicolon )  end
                     else INSYMBOL
    end;
ET_END:
  end
end DECLARE_ITEM_TYPE;



[global]
procedure DECLARE_ITEM_OBJ( idt: ide_ptr );
{ Procedure to create an Item object.

  The syntax is :

    <item_type_ide> [ [<lex>] <attached_identifier> ] ( <item_ident_list> ) = <Item_field_list>

  The <item_ident_list> is the list of string identifiers used to define the Item Object.
  The first string is the identifier name of object also :

     item my_vector x, y, z: float end;

 can accept the following declarations :

     my_vector v1 = 3.2, 8.3, 7.5;        or         my_vector( 'v1' ) = 3.2, 8.3, 7.5;

 these two forms are equivalent.

  The <Item_field_list> can be incomplete :
     my_vector v1 = 3.2;        is equivalent with   my_vector v1 = 3.2, 0.0, 0.0;
  and
     my_vector v1 = ,,5.5;      is equivalent with   my_vector v1 = 0.0, 0.0, 5.5;

}
const
  mdnam = 'NITM';

var
  typ, tpa:    typ_ptr;
  idr, idf:    ide_ptr;
  itm:         itm_ptr;
  lvl, idx:    integer;
  bln:         boolean;
  sid0, sid1:   string;

begin
  typ := idt^.ide_typ;                          { Get the item type definition }
  if typ <> nil then
  with sy_sym, typ^ do
  begin
(*
WRITELN( ' Create NEW item "', typ_ide^.ide_name^, '" with nid = ', typ_nid:0, ' nfl = ', typ_nfl:0, ', nsq = ', typ_nsq:0 );
*)
    INSYMBOL;                                   { Gobble up the Item type identifier }
    idr := nil;                                 { Assume no reference identifier }
    if (sy = identsy) or (sy = intconst) then
    begin                                       { A Reference Item identifier is specified }
      idx := idt^.ide_displ;                    { Get the lex display level of the Item Type }
      if sy = intconst then
      begin
        lvl := sy_ival;                         { When a target display level is specified, we get it }
        if lvl <= 0 then lvl := curr_disp - lvl;
        if lvl < idx then lvl := idx            { The minimum lex is the item Type lex }
                     else if lvl > curr_disp then lvl := curr_disp;
        INSYMBOL
      end else lvl := curr_disp;                { The default lex is the current lex }
      if sy <> identsy then SRC_ERROR_S( mdnam, 252, e_error, idt^.ide_name^ )
      else
      begin
        idr := IDE_NEW( cla_varbl, typ );       { Create the item reference identifier }
        INSYMBOL;
        if idr <> nil then                      { On success, initialize it }
          with idr^.idev_val do
          begin  val_frm := vfrm_itm; itm := nil  end
      end
    end;

    if (typ_nid > 0) and (sy <> lparen) then SRC_ERROR_S( mdnam, 258, e_error, idt^.ide_name^ );

    if sy = lparen then
    begin { Declaration Form "<item_type> ( <item_ide> , ... ) = ... }
      INSYMBOL; GET_STREXPR( sid0 );            { Skip parenthesys and get the name of item to create }
      itm := ITEM_NEW( idt, sid0 );             { Create the item record }
      for ii := 1 to typ_nid do
      begin
        { When other symbol identification are specified, we get it }
        if sy = comma then begin  INSYMBOL; GET_EXPRESSION( exp_res )  end      { Get the field specification related value (in exp_res) }
                      else EXPRV_REMOVE( exp_res );     { Force null expression on end of value }
        bln := ITEM_SET_FIELD( itm, exp_res )
      end;
      if idr <> nil then idr^.idev_val.itm := itm;      { Attach the reference identifier to item }
      if sy = rparen then INSYMBOL
                     else SRC_ERROR( mdnam, 23, e_error );
      if typ_dcd > 0 then exp_nva := true       { For any LSQ exported Item we force the Compilation Mode }
    end
    else
      if idr <> nil then
      with idr^ do
      begin
        itm := ITEM_NEW( idt, ide_name^ );      { Create the item record with the name of ref. identifier }
        idev_val.itm := itm;                    { Attach the reference identifier to item }
        if typ_nid > 1 then
        begin
          if typ_dcd > 0 then exp_nva := true;  { For any LSQ exported Item we force the Compilation Mode }
          exp_res.exp_val.val_frm := vfrm_null; { Define a null expression ... }
          for ii := 1 to typ_nid do             { ... and set it for all identification fields ... }
            exit if ITEM_SET_FIELD( itm, exp_res )      { ... but stop on error }
        end
      end
      else begin { When no item name was specified}
             SRC_ERROR_S( mdnam, 253, e_severe, idt^.ide_name^ );
             SKIP_SYMBOL( semicolon ); goto ET_END
           end;

    if typ_dcd > 0 then exp_nva := true;        { For any LSQ exported Item we force the Compilation Mode }

    { Now we must get all fields of the ITEM. The separator ("is" or "=") is optional }
    if (sy = issy) or ((sy = relop) and (op = eq_op)) then INSYMBOL;

    for ii := typ_nid+1 to typ_nfl do
    begin
      GET_EXPRESSION( exp_res );
      bln := ITEM_SET_FIELD( itm, exp_res );    { Put the expression in the item }
      if sy = comma then INSYMBOL
    end;

    if typ_par <> nil then tpa := typ_par
                      else tpa := typ;
    with tpa^ do
    begin
      if typ_fit = nil then typ_fit := itm      { Put the new item in the type item queue }
                       else typ_lit^.itm_next := itm;
      typ_lit := itm
    end;
    if exp_nva then begin  ITEM_EXPORT( itm ); exp_nva := false  end

  end
  else SKIP_SYMBOL( semicolon );
ET_END:
end DECLARE_ITEM_OBJ;



[global]
procedure DECLARE_DATA_ITEM;
begin
end DECLARE_DATA_ITEM;


end MXD_DCP_ITEM.
