  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE   1
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is ".standard.".

       C    1    1  { %pragma listlvl:2; }
       C    1    2  {
       C    1    3   ******************************************************************************
       C    1    4   *                                                                            *
       C    1    5   *                                                                            *
       C    1    6   *                                                                            *
       C    1    7   *                        MMM    MMM   XXX      XXX  DDDDDDDD                 *
       C    1    8   *                        MMMM  MMMM    XXX    XXX   DDDDDDDDDD               *
       C    1    9   *                        MM MMMM MM     XXX  XXX    DD      DDD              *
       C    1   10   *                        MM  MM  MM      XXXXXX     DD       DD              *
       C    1   11   *                        MM      MM       XXXX      DD       DD              *
       C    1   12   *          T  H  E       MM      MM       XXXX      DD       DD              *
       C    1   13   *                        MM      MM      XXXXXX     DD       DD              *
       C    1   14   *                        MM      MM     XXX  XXX    DD      DDD              *
       C    1   15   *                        MM      MM    XXX    XXX   DDDDDDDDDD               *
       C    1   16   *                       MMMM    MMMM  XXX      XXX  DDDDDDDD                 *
       C    1   17   *                                                                            *
       C    1   18   *                                                                            *
       C    1   19   *                                                                            *
       C    1   20   *                 SSSSS Y     Y  SSSSS TTTTTTT EEEEEE M     M                *
       C    1   21   *                S       Y   Y  S         T    E      MM   MM                *
       C    1   22   *                S        Y Y   S         T    E      M M M M                *
       C    1   23   *                 SSSS     Y     SSSS     T    EEEEE  M  M  M                *
       C    1   24   *                     S    Y         S    T    E      M     M                *
       C    1   25   *                     S    Y         S    T    E      M     M  ..            *
       C    1   26   *                SSSSS     Y    SSSSS     T    EEEEEE M     M  ..            *
       C    1   27   *                                                                            *
       C    1   28   *                                                                            *
       C    1   29   *                                                                            *
       C    1   30   *              ---  Version  3.999 000 alpha -- 31/03/2010 ---               *
       C    1   31   *                                                                            *
       C    1   32   *                by :                                                        *
       C    1   33   *                                                                            *
       C    1   34   *                     P. Wolfers                                             *
       C    1   35   *                         c.n.r.s.                                           *
       C    1   36   *                         Institut Neel (MCMF), Bat F,                       *
       C    1   37   *                         B.P.  166 X   38042  Grenoble Cedex                *
       C    1   38   *                                                FRANCE.                     *
       C    1   39   *                                                                            *
       C    1   40   *                                                                            *
       C    1   41   ******************************************************************************
       C    1   42  
       C    1   43  
       C    1   44  ///////////////////////////////////////////////////////////////////////////////
       C    1   45  //                                                                           //
       C    1   46  //                                                                           //
       C    1   47  //                     Global Public Licence (GPL)                           //
       C    1   48  //                                                                           //
       C    1   49  //                                                                           //
       C    1   50  //    This license described in this file overrides all other licenses       //
       C    1   51  //    that might be specified in other files for this software.              //
       C    1   52  //                                                                           //
       C    1   53  //    This program is free software; you can redistribute it and/or          //
       C    1   54  //    modify it under the terms of the GNU Lesser General Public             //
       C    1   55  //    License as published by the Free Software Foundation; either           //
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE   2
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is ".standard.".

       C    1   56  //    version 2.1 of the License, or (at your option) any later version.     //
       C    1   57  //                                                                           //
       C    1   58  //    This software is distributed in the hope that it will be useful,       //
       C    1   59  //    but WITHOUT ANY WARRANTY; without even the implied warranty of         //
       C    1   60  //    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU      //
       C    1   61  //    Library General Public License for more details.                       //
       C    1   62  //                                                                           //
       C    1   63  //    You should have received a copy of the GNU Lesser General Public       //
       C    1   64  //    License along with this library (see COPYING.LIB); if not, write to    //
       C    1   65  //    the Free Software Foundation :                                         //
       C    1   66  //                         Inc., 675 Mass Ave, Cambridge, MA 02139, USA.     //
       C    1   67  //                                                                           //
       C    1   68  ///////////////////////////////////////////////////////////////////////////////
       C    1   69  
       C    1   70  
       C    1   71  
       C    1   72  *******************************************************************************
       C    1   73  *                                                                             *
       C    1   74  *                                                                             *
       C    1   75  *               MXD   Data   Compiler  Expression   Module                    *
       C    1   76  *                                                                             *
       C    1   77  *                                                                             *
       C    1   78  *******************************************************************************
       C    1   79  
       C    1   80  
       C    1   81  }
       C    1   82  
       C    1   83  {************     CPAS  version    *************}
       C    1   84  
       C    1   85  {
       C    1   86          *** Modification(s) from major version ***
       C    1   87  
       C    1   88  
       C    1   89                    ----
       C    1   90  
       C    1   91                   NOTHING
       C    1   92  
       C    1   93                    ----
       C    1   94  
       C    1   95  }
       C    1   96  
       C    1   97  
            1   98  module MXD_DCP_EXPR;
            1   99  
            1  100    %include        'MXDSRC:mxd_dcp_env';         { Load the MXD data Compiler Environment }
            1  101  
            1  102  
            1  103  const
            1  104  
            1  105    max_stk       =                 4096;         { Maximum of expression stack }
            1  106  
            1  107  
            1  108  [static] var
            1  109  
            1  110    stkp_base,                                    { Current stack base for mfunction return value }
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE   3
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

            1  111    exp_stkp:               integer := 0;         { Current stack pointer level }
            1  112  
            1  113    exp_stk: array[1..max_stk] of exp_rec;        { Expression stack }
            1  114  
            1  115    exp_nva:            boolean := false;         { Flag to No compile/(do not compute) a LSQ expression }
            1  116  
            1  117  
            1  118  
            1  119    ndcod_tab:  [static] array[ope_stm] of node_code := [
            1  120              nd_not,     nd_neg,     nd_neg,     nd_ipw, {   stm_not,   stm_neg,   stm_fng,   stm_iip }
            1  121              nd_ipw,     nd_pow,     nd_mul,     nd_mul, {   stm_fip,   stm_ffp,   stm_iml,   stm_fml }
            1  122             nd_idiv,     nd_mod,     nd_rem,     nd_div, {   stm_idv,   stm_mod,   stm_rem,   stm_fdv }
            1  123              nd_add,     nd_add,     nd_sub,     nd_sub, {    stm_iad,    stm_fad,    stm_isb,    stm_fsb }
            1  124              nd_nop,     nd_nop,      nd_eq,      nd_eq, {    stm_ssc,    stm_seq,    stm_ieq,    stm_feq }
            1  125              nd_nop,      nd_ne,      nd_ne,     nd_nop, {    stm_sne,    stm_ine,    stm_fne,    stm_slt }
            1  126               nd_lt,      nd_lt,     nd_nop,      nd_le, {    stm_ilt,    stm_flt,    stm_sle,    stm_ile }
            1  127               nd_le,     nd_nop,      nd_ge,      nd_ge, {    stm_fle,    stm_sge,    stm_ige,    stm_fge }
            1  128              nd_nop,      nd_gt,      nd_gt,     nd_and, {    stm_sgt,    stm_igt,    stm_fgt,    stm_and }
            1  129              nd_xor,      nd_or,     nd_abs,     nd_abs, {    stm_xor,     stm_or,   stm_iabs,   stm_fabs }
            1  130             nd_sqrt,    nd_sinr,    nd_cosr,    nd_tanr, {   stm_sqrt,   stm_sinr,   stm_cosr,   stm_tanr }
            1  131            nd_asinr,   nd_acosr,   nd_atanr,  nd_phaser, {  stm_asinr,  stm_acosr,  stm_atanr, stm_phaser }
            1  132             nd_sind,    nd_cosd,    nd_tand,   nd_asind, {   stm_sind,   stm_cosd,   stm_tand,  stm_asind }
            1  133            nd_acosd,   nd_atand,  nd_phased,     nd_exp, {  stm_acosd,  stm_atand, stm_phased,    stm_exp }
            1  134               nd_ln,    nd_tanh,   nd_bessj,     nd_nop, {     stm_ln,   stm_tanh,  stm_bessj,    stm_csi }
            1  135              nd_nop,     nd_nop,     nd_nop,     nd_nop, {    stm_csf,    stm_cis,    stm_cif,    stm_cfs }
            1  136            nd_trunc,   nd_round,     nd_nop              {    stm_cfi,    stm_rnd,    stm_nop }
            1  137          ];
            1  138  
            1  139  
            1  140  
            1  141  
       C    1  142  { ********************************************************************************* }
       C    1  143  { ***********  Expression Management routines of the MXD Data Compiler  *********** }
       C    1  144  { ********************************************************************************* }
       C    1  145  
       C    1  146  
       C    1  147  
       C    1  148  
            1  149  procedure POP_EXPRESSION;
       C    1  150  { Routine to get an expression, the result is located in the record exp_res }
            1  151  const
            1  152    mdnam = 'PEXP';
            1  153  
            1  154  begin
     1      1  155    if exp_stkp > 0 then
            1  156    begin { *** Get the expression result *** }
     2      1  157      exp_res  := exp_stk[exp_stkp];
            1  158      exp_stkp := exp_stkp - 1
     1      1  159    end
            1  160    else
            1  161    begin
     2      1  162      SRC_ERROR( mdnam, 7, e_severe );
            1  163      exp_res.exp_form := form_null
     1      1  164    end;
     0      1  165  end POP_EXPRESSION;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE   4
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

            1  166  
            1  167  
            1  168  
            1  169  procedure EXP_PUT_REFER( ip: ide_ptr );
            1  170  const
            1  171    mdnam = 'PURF';
            1  172  
            1  173  begin
     1      1  174    if exp_stkp < max_stk then exp_stkp := SUCC( exp_stkp )
            1  175                          else SRC_ERROR( mdnam, 6, e_severe );
            1  176    exp_stk[exp_stkp] := exp_null;
            1  177    with ip^, exp_stk[exp_stkp] do
            1  178    begin
     2      1  179      exp_ref   :=         ip;
            1  180      exp_asr   :=   idev_asr;
            1  181      exp_shift :=          1;
            1  182      if exp_asr <> nil then exp_edim := exp_asr^.asr_stp*exp_asr^.asr_siz
            1  183                        else exp_edim := 1;
            1  184      exp_flags := idev_flags;
            1  185      exp_form  :=  idev_form;
            1  186      case idev_form of
            1  187        form_valstr:  exp_str := str;
            1  188        form_valint:  exp_int := int;
            1  189        form_valflt:  begin
     3      1  190                        exp_flt := flt;
            1  191                        if objf_lsqob in idev_flags then
            1  192                        begin
     4      1  193                          if exp_nva then exp_form := form_lsqref;
            1  194                          exp_sig := sig
     3      1  195                        end else exp_sig := 0.0
     2      1  196                      end;
            1  197        form_tabstr:  begin
     3      1  198                        exp_aas := aas;
            1  199                        if aas = nil then SRC_ERROR( mdnam, 801, e_severe )
     2      1  200                      end;
            1  201        form_tabint:  begin
     3      1  202                        exp_aai := aai;
            1  203                        if aai = nil then SRC_ERROR( mdnam, 802, e_severe )
     2      1  204                      end;
            1  205        form_tabflt:  begin
     3      1  206                        exp_aaf := aaf;
            1  207                        if aaf = nil then SRC_ERROR( mdnam, 803, e_severe );
            1  208                        if objf_lsqob in idev_flags then exp_asg := asg
            1  209                                                    else exp_asg := nil
     2      1  210                      end;
            1  211      otherwise
            1  212      end
     1      1  213    end
     0      1  214  end EXP_PUT_REFER;
            1  215  
            1  216  
            1  217  
            1  218  procedure EXP_PUTVALUE(       typ:    typ_form;
            1  219                                 iv:     integer;
            1  220                                 rv, sg: mxd_flt;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE   5
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

            1  221                                 st:     str_ptr );
            1  222  const
            1  223    mdnam = 'EXPP';
            1  224  
            1  225  begin
     1      1  226    if exp_stkp < max_stk then exp_stkp := SUCC( exp_stkp )
            1  227                          else SRC_ERROR( mdnam, 6, e_severe );
            1  228    with sy_sym, exp_stk[exp_stkp] do
            1  229    begin
     2      1  230      exp_ref   := nil;
            1  231      exp_asr   := nil;
            1  232      exp_edim  :=   1;
            1  233      exp_shift :=   0;
            1  234      exp_form  := typ;
            1  235      case typ of
            1  236        form_valint: exp_int := iv;
            1  237        form_valflt: begin  exp_flt := rv; exp_sig := sg  end;
            1  238        form_valstr: if st <> nil then
            1  239                       if st^.length > 0 then
            1  240                       begin
     3      1  241                         NEW( exp_str, st^.length );
            1  242                         exp_str^ := st^
     2      1  243                       end else exp_str := nil
            1  244                     else exp_str := nil;
            1  245      otherwise
            1  246      end
     1      1  247    end;
            1  248    if debug_exp then
            1  249    with lst_current^ do
            1  250    begin
     2      1  251      WRITE( lst_file, ' PUSH : ', ORD( typ ) );
            1  252      case typ of
            1  253        form_valint:      WRITE( lst_file, iv );
            1  254        form_valflt:      WRITE( lst_file, rv, ':', sg );
            1  255        form_valstr:      WRITE( lst_file, '"', st, '"' );
            1  256      otherwise
            1  257      end;
            1  258      WRITELN( lst_file )
     1      1  259    end
     0      1  260  end EXP_PUTVALUE;
            1  261  
            1  262  
            1  263  
            1  264  [global]
            1  265  procedure EXP_PUTSTR( in_var st: string );
            1  266  begin
     1      1  267    EXP_PUTVALUE( form_valstr, 0, 0.0, 0.0, st"address )
     0      1  268  end EXP_PUTSTR;
            1  269  
            1  270  
            1  271  
            1  272  [global]
            1  273  procedure EXP_PUTINT( iv: integer );
            1  274  begin
     1      1  275    EXP_PUTVALUE( form_valint, iv, 0.0, 0.0, nil )
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE   6
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

     0      1  276  end EXP_PUTINT;
            1  277  
            1  278  
            1  279  
            1  280  [global]
            1  281  procedure EXP_PUTFLT( rv, sg: mxd_flt := 0.0 );
            1  282  begin
     1      1  283    EXP_PUTVALUE( form_valflt, 0, rv, sg, nil )
     0      1  284  end EXP_PUTFLT;
            1  285  
            1  286  
            1  287  
            1  288  procedure STACK_REMOVE( np: integer );
            1  289  begin
       C    1  290  (*
       C    1  291  WRITE( ' STK REMOVE( ', np:0, ' )' );
       C    1  292  *)
     1      1  293    while np > 0 do
            1  294    with exp_stk[exp_stkp] do
            1  295    begin
     2      1  296      if exp_ref = nil then
            1  297      case exp_form of
            1  298        form_valstr: DISPOSE( exp_str ); { String }
            1  299        form_tabstr: begin               { Array of strings }
     3      1  300                       for ii := 1 to exp_aas^.ide_all do  DISPOSE( exp_aas^.ide_stb[ii] );
            1  301                       DISPOSE( exp_aas )
     2      1  302                     end;
            1  303        form_tabint: DISPOSE( exp_aai ); { Array of integers }
            1  304        form_tabflt: begin               { Array of floats }
     3      1  305                       DISPOSE( exp_aaf );
            1  306                       if exp_asg <> nil then DISPOSE( exp_asg )
     2      1  307                     end;
            1  308      otherwise
            1  309      end;
            1  310      exp_stkp := exp_stkp - 1;
            1  311      np := np - 1
     1      1  312    end
       C    1  313  (*
       C    1  314  ;WRITELN( ' to lvl = ', exp_stkp:0 )
       C    1  315  *)
     0      1  316  end STACK_REMOVE;
            1  317  
            1  318  
            1  319  
            1  320  function  COMP_TYPE_STK( np: integer; frmty: ide_ptr ): boolean;
            1  321  var
            1  322    bok: boolean;
            1  323  
            1  324  
            1  325  
            1  326    function COMPARE_SCFRM( ef, ff: typ_form ): boolean;
            1  327    begin
     1      1  328      case ef of
            1  329        form_telstr, form_valstr: COMPARE_SCFRM := (ff = form_valstr);
            1  330        form_telint, form_valint: COMPARE_SCFRM := (ff = form_valint);
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE   7
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "PRC_00000000".

            1  331        form_telflt, form_valflt: COMPARE_SCFRM := (ff = form_valflt);
            1  332      otherwise
            1  333      end
     0      1  334    end COMPARE_SCFRM;
            1  335  
            1  336  
            1  337  begin { COMP_TYPE_STK }
     1      1  338    if frmty <> nil then
            1  339    with exp_stk[exp_stkp - np], frmty^ do
            1  340    begin
     2      1  341      bok := COMPARE_SCFRM( exp_form, idet_form ) and (exp_asr = idet_asr);
            1  342      if not bok then
            1  343      begin
     3      1  344        case idet_form of
            1  345          form_wscala: bok := (exp_asr = nil);
            1  346          form_sarray: bok := (exp_form = form_tabstr) and (exp_asr <> nil) and (exp_asr^.asr_sub = nil);
            1  347          form_iarray: bok := (exp_form = form_tabint) and (exp_asr <> nil) and (exp_asr^.asr_sub = nil);
            1  348          form_farray: bok := (exp_form = form_tabflt) and (exp_asr <> nil) and (exp_asr^.asr_sub = nil);
            1  349          form_warray: bok := (exp_asr <> nil);
            1  350          form_wild:   bok := true
            1  351        otherwise
            1  352        end
     2      1  353      end;
            1  354      COMP_TYPE_STK := bok
     1      1  355    end
            1  356    else COMP_TYPE_STK := false
     0      1  357  end COMP_TYPE_STK;
            1  358  
            1  359  
            1  360  
            1  361  function  GENERIC_SEARCH( ent: ent_ptr; npa: integer ): ent_ptr;
            1  362  const
            1  363    mdnam = 'GENS';
            1  364  
            1  365  var
            1  366    fnd:         boolean;
            1  367    idf:         ide_ptr;
            1  368    nef:         integer;
            1  369  
            1  370  begin
     1      1  371    fnd := false;
            1  372    if ent <> nil then
            1  373    repeat
     2      1  374      with ent^ do
            1  375      begin
     3      1  376        case ent_knd of
            1  377          entk_stm: { Intrinsec statement }
            1  378            if npa <= 2 then
       C    1  379  (*
       C    1  380  begin
       C    1  381  if npa = 1 then
       C    1  382  WRITELN( ' Search stm for ( "', ent_pt1^.ide_name^, '" )' );
       C    1  383  if npa = 2 then
       C    1  384  WRITELN( ' Search stm for ', ent_stm, ' ( "', ent_pt1^.ide_name^, '", "', ent_pt2^.ide_name^, '" )' );
       C    1  385  *)
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE   8
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "generic_search".

            1  386            case npa of
            1  387              0: fnd := (ent_pt1 = nil) and (ent_pt2 = nil);
            1  388              1: fnd := COMP_TYPE_STK( 0, ent_pt1 ) and (ent_pt2 = nil);
            1  389              2: fnd := COMP_TYPE_STK( 1, ent_pt1 ) and
            1  390                        COMP_TYPE_STK( 0, ent_pt2 );
            1  391            end;
       C    1  392  (*
       C    1  393  ;WRITELN( ' ==> ', fnd )
       C    1  394  end;
       C    1  395  *)
            1  396          entk_fnc: { User defined function }
            1  397            begin
     4      1  398              idf := ent_frl;
            1  399              nef := npa - 1;
            1  400              fnd := true;
            1  401              while fnd and (idf <> nil) and (nef >= 0) do
            1  402              with idf^ do
            1  403              begin
     5      1  404                fnd := COMP_TYPE_STK( nef, idef_typ );
            1  405                nef := nef - 1;
            1  406                idf := ide_lnk
     4      1  407              end
     3      1  408            end;
            1  409  
            1  410          entk_std: fnd := true { Builtin function (not a generic ///) } ;
            1  411  
            1  412        end;
            1  413        if not fnd then ent := ent_prv
     2      1  414      end
     1      1  415    until fnd or (ent = nil);
            1  416    GENERIC_SEARCH := ent
     0      1  417  end GENERIC_SEARCH;
            1  418  
            1  419  
            1  420  
            1  421  function  STRING_TO_NUMBER( var st: str_ptr; bfree: boolean ): mxd_flt;
            1  422  label
            1  423    LECT_ERR;
            1  424  
            1  425  var
            1  426    re: mxd_flt;
            1  427  
            1  428    function RD_ERR_TRAP( ierr: cc__int ): cc__int;
            1  429    begin
     1      1  430      if ierr = 51 then
            1  431                   begin
     2      1  432                      re := 0.0;
            1  433                      goto LECT_ERR
     1      1  434                   end
            1  435                   else RD_ERR_TRAP := 0 { 0 to continue the handler scan, -1 => standard RTL error message and st
                    op }
     0      1  436    end RD_ERR_TRAP;
            1  437  
            1  438  begin
     1      1  439    ESTABLISH( RD_ERR_TRAP );
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE   9
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "string_to_number".

            1  440    READV( st^, re );
            1  441  LECT_ERR:
            1  442    REVERT;
            1  443    if bfree then
            1  444    begin  DISPOSE( st ); st := nil  end;
            1  445    STRING_TO_NUMBER := re
     0      1  446  end STRING_TO_NUMBER;
            1  447  
            1  448  
            1  449  
            1  450  function NUMBER_TO_STRING( rv: mxd_flt; fl, dc: integer := 0 ): str_ptr;
            1  451  var
            1  452    st: string( 32 );
            1  453    sv: str_ptr;
            1  454  
            1  455  begin
     1      1  456    WRITEV( st, rv:fl:dc );
            1  457    if st.length > 0 then
            1  458    begin
     2      1  459      NEW( sv, st.length );
            1  460      sv^ := st
     1      1  461    end else sv := nil;
            1  462    NUMBER_TO_STRING := sv
     0      1  463  end NUMBER_TO_STRING;
            1  464  
            1  465  
            1  466  
            1  467  procedure STRING_CONCATE( var st1, st2: str_ptr; bf1, bf2: boolean );
            1  468  var
            1  469    str: string;
            1  470  
            1  471  begin
     1      1  472    if (st1 <> nil) and (st2 <> nil) then
            1  473    begin
     2      1  474      str := st1^||st2^;
            1  475      if bf1 then DISPOSE( st1 );
            1  476      if bf2 then begin  DISPOSE( st2 ); st2 := nil  end;
            1  477      NEW( st1, str.length ); st1^ := str
     1      1  478    end
            1  479    else
            1  480      if st1 = nil then
            1  481        if bf2 then
            1  482        begin  st1 := st2; st2 := nil  end
            1  483        else
            1  484        begin  NEW( st1, st2^.length ); st1^ := st2^  end
     0      1  485  end STRING_CONCATE;
            1  486  
            1  487  
            1  488  
            1  489  function  STRING_COMPARE( var st1, st2: str_ptr; bf1, bf2: boolean ): integer;
            1  490  var
            1  491    re: integer;
            1  492  
            1  493  begin
     1      1  494    if (st1 <> nil) and (st2 <> nil) then
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  10
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "string_compare".

            1  495    begin
     2      1  496      re := STR_MATCH( st1^, st2^ );
            1  497      if bf1 then DISPOSE( st1 ); st1 := nil;
            1  498      if bf2 then DISPOSE( st2 ); st2 := nil
     1      1  499    end
            1  500    else
            1  501      if (st1 = nil) and (st2 = nil) then re := 0
            1  502      else
            1  503        if st1 = nil then
            1  504        begin
     2      1  505          re := -1;
            1  506          if bf2 then DISPOSE( st2 ); st2 := nil
     1      1  507        end
            1  508        else
            1  509        begin
     2      1  510          re := 1;
            1  511          if bf1 then DISPOSE( st1 ); st1 := nil
     1      1  512        end;
            1  513    STRING_COMPARE := re
     0      1  514  end STRING_COMPARE;
            1  515  
            1  516  
            1  517  
            1  518  procedure ARGUMENTS_SETTING( npa: integer );
            1  519  var
            1  520    nv: integer;
            1  521  
            1  522  begin
     1      1  523    nv := exp_stkp - npa + 1;
            1  524    while nv <= exp_stkp do
            1  525    with exp_stk[nv] do
            1  526    begin
     2      1  527      case exp_form of
            1  528        form_telstr:
            1  529          begin
     3      1  530            if exp_aas <> nil then exp_str := exp_aas^.ide_stb[exp_shift]
            1  531                              else exp_str := nil;
            1  532            exp_form := form_valstr
     2      1  533          end;
            1  534  
            1  535        form_telint:
            1  536          begin
     3      1  537            if exp_aai <> nil then exp_int := exp_aai^.ide_itb[exp_shift]
            1  538                              else exp_int := 0;
            1  539            exp_form := form_valint
     2      1  540          end;
            1  541  
            1  542        form_telflt:
            1  543          begin
     3      1  544            if exp_aaf <> nil then
            1  545            begin
     4      1  546              exp_flt := exp_aaf^.ide_ftb[exp_shift];
            1  547              if exp_asg <> nil then exp_sig := exp_asg^.ide_ftb[exp_shift]
            1  548                                else exp_sig := 0.0
     3      1  549            end
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  11
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "arguments_setting".

            1  550            else
            1  551            begin  exp_flt := 0; exp_sig := 0.0  end;
            1  552            exp_form := form_valflt
     2      1  553          end;
            1  554  
            1  555      otherwise
            1  556      end;
            1  557      nv := nv + 1
     1      1  558    end
     0      1  559  end ARGUMENTS_SETTING;
            1  560  
            1  561  
            1  562  
            1  563  procedure OUT_PCD_VREF( var exp: exp_rec; binv: boolean := false );
            1  564  begin
     1      1  565    with exp do
            1  566    begin
     2      1  567      case exp_form of
            1  568        form_valint: WRITELN( pcd, ORD( nd_konst ):4, ' ', exp_int:0, '.0' );
            1  569  
            1  570        form_lsqref,
            1  571        form_telflt,
            1  572        form_valflt:
            1  573          if exp_ref <> nil then
            1  574            with exp_ref^ do
            1  575              if objf_lsqva in exp_flags then WRITELN( pcd, ORD( nd_varbl ):4, ' ', idev_sequnb+exp_shift:0 )
            1  576              else
            1  577              if objf_lsqpa in exp_flags then WRITELN( pcd, ORD( nd_param ):4, ' ', idev_sequnb+exp_shift:0 )
            1  578                                         else WRITELN( pcd, ORD( nd_coeff ):4, ' ', idev_sequnb+exp_shift:0 )
            1  579          else WRITELN( pcd, ORD( nd_konst ):4, ' ', exp_flt );
            1  580  
            1  581         form_itmref:
            1  582           if exp_ref <> nil then
            1  583             with exp_ref^ do
            1  584               WRITELN( pcd, ORD( nd_itmref ):4, ' ', exp_int:4, ' ', idev_sequnb:0 );
            1  585       otherwise
            1  586      end;
            1  587      if binv then WRITELN( pcd, ORD( nd_permut ):4 )
     1      1  588    end
     0      1  589  end OUT_PCD_VREF;
            1  590  
            1  591  
            1  592  
            1  593  procedure WRITE$OBJECT( var exp: exp_rec );
            1  594  begin
     1      1  595    with exp do
            1  596    begin
     2      1  597      case exp_form of
            1  598        form_valstr: if exp_str <> nil then WRITE( '"', exp_str^, '"' ) else WRITE( '""' );
            1  599        form_valint: WRITE( exp_int:0 );
            1  600        form_valflt: WRITE( exp_flt:12:6 );
            1  601      otherwise
            1  602      end
     1      1  603    end
     0      1  604  end WRITE$OBJECT;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  12
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

            1  605  
            1  606  
            1  607  
            1  608  procedure EXE_VAL_UNA( ent: ent_ptr  );
            1  609  const
            1  610    mdnam = 'EUNA';
            1  611  
            1  612  begin
     1      1  613    ARGUMENTS_SETTING( 1 );
            1  614    with ent^, exp_stk[exp_stkp] do
            1  615    begin
     2      1  616      if ent_cv1 <> nil then EXE_VAL_UNA( ent_cv1 );
            1  617      if exp_form = form_lsqref then
       C    1  618        { The statement cannot be execute here => output Pcode }
            1  619        WRITELN( pcd, ORD( ndcod_tab[ent_stm] ):4 )
            1  620      else
            1  621      begin
     3      1  622  WRITE( ' Una Op ', ent_stm, ' ( ', exp_stk[exp_stkp], ' )' );
       C    1  623        { Execute the unary operator }
            1  624        case ent_stm of
       C    1  625          { For conversion }
            1  626          stm_csi: begin  exp_int := ROUND( STRING_TO_NUMBER( exp_str, exp_ref = nil ) )  end;
            1  627          stm_csf: begin  exp_flt := ROUND( STRING_TO_NUMBER( exp_str, exp_ref = nil ) ); exp_sig := 0.0  end;
            1  628          stm_cis: exp_str := NUMBER_TO_STRING( MXD_FLT( exp_int ) );
            1  629          stm_cif: exp_flt := exp_int;
            1  630          stm_cfs: exp_str := NUMBER_TO_STRING( exp_flt );
            1  631          stm_cfi: exp_int := TRUNC( exp_flt );
            1  632          stm_rnd: exp_int := ROUND( exp_flt );
            1  633  
            1  634          stm_not: if exp_int <> 0 then exp_int := 0
            1  635                                   else exp_int := 1;
            1  636          stm_neg: exp_int := - exp_int;
            1  637          stm_fng: exp_flt := - exp_flt;
            1  638  
            1  639          stm_iabs:   exp_int :=  ABS( exp_int );
            1  640          stm_fabs:   exp_flt :=  ABS( exp_flt );
            1  641          stm_sqrt:   exp_flt := SQRT( exp_flt );
            1  642  
            1  643          stm_sinr:   exp_flt :=  SIN( exp_flt );
            1  644          stm_cosr:   exp_flt :=  COS( exp_flt );
            1  645          stm_tanr:   exp_flt :=  TAN( exp_flt );
            1  646  
            1  647          stm_asinr:  exp_flt :=  ARCSIN( exp_flt );
            1  648          stm_acosr:  exp_flt :=  ARCCOS( exp_flt );
            1  649          stm_atanr:  exp_flt :=  ARCTAN( exp_flt );
            1  650  
            1  651          stm_sind:   exp_flt :=  SIN( inrd*exp_flt );
            1  652          stm_cosd:   exp_flt :=  COS( inrd*exp_flt );
            1  653          stm_tand:   exp_flt :=  TAN( inrd*exp_flt );
            1  654  
            1  655          stm_asind:  exp_flt :=  ARCSIN( exp_flt )/inrd;
            1  656          stm_acosd:  exp_flt :=  ARCCOS( exp_flt )/inrd;
            1  657          stm_atand:  exp_flt :=  ARCTAN( exp_flt )/inrd;
            1  658  
            1  659          stm_exp:    exp_flt :=  EXP( exp_flt );
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  13
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "exe_val_una".

            1  660          stm_ln:     exp_flt :=  LN( exp_flt );
            1  661          stm_tanh:   exp_flt :=  TANH( exp_flt );
            1  662  
            1  663        otherwise
            1  664        end
     2      1  665      end;
       C    1  666      { Force the resulting type }
            1  667      with ent_typ^ do
            1  668      begin
     3      1  669        exp_asr  :=  idet_asr;
            1  670        exp_form := idet_form
     2      1  671      end
            1  672  ;WRITELN( ' -> ', exp_stk[exp_stkp] );
     1      1  673    end
     0      1  674  end EXE_VAL_UNA;
            1  675  
            1  676  
            1  677  
            1  678  procedure EXE_VAL_BIN( ent: ent_ptr  );
            1  679  const
            1  680    mdnam = 'EBIN';
            1  681  
            1  682  var
            1  683    r: mxd_flt;
            1  684  
            1  685  begin
     1      1  686    ARGUMENTS_SETTING( 2 );
            1  687    with ent^ do
            1  688    begin
     2      1  689      if ent_cv2 <> nil then EXE_VAL_UNA( ent_cv2 );
            1  690      POP_EXPRESSION;
            1  691      if ent_cv1 <> nil then EXE_VAL_UNA( ent_cv1 );
            1  692      with exp_stk[exp_stkp] do
            1  693      begin
     3      1  694        if (exp_res.exp_form = form_lsqref) or (exp_form = form_lsqref) then
            1  695        begin
     4      1  696          if exp_form = form_lsqref then OUT_PCD_VREF( exp_res )
            1  697                                    else OUT_PCD_VREF( exp_res, true );
            1  698          WRITELN( pcd, ORD( ndcod_tab[ent_stm] ):4 )
     3      1  699        end
            1  700        else
            1  701        begin
     4      1  702  WRITE( ' Bin Op ', ent_stm, ' ( ', exp_stk[exp_stkp], ', ', exp_res, ' )' );
            1  703          case ent_stm of
            1  704            stm_iip: ;
            1  705            stm_fip: ;
            1  706            stm_ffp: ;
            1  707            stm_iml: exp_int := exp_int*exp_res.exp_int;
            1  708            stm_fml: exp_flt := exp_flt*exp_res.exp_flt;
            1  709            stm_idv: exp_int := exp_int div exp_res.exp_int;
            1  710            stm_mod: exp_int := exp_int mod exp_res.exp_int;
            1  711            stm_rem: exp_int := exp_int rem exp_res.exp_int;
            1  712            stm_fdv: exp_flt := exp_flt/exp_res.exp_flt;
            1  713            stm_iad: exp_int := exp_int+exp_res.exp_int;
            1  714            stm_fad: exp_flt := exp_flt+exp_res.exp_flt;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  14
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "exe_val_bin".

            1  715            stm_isb: exp_int := exp_int-exp_res.exp_int;
            1  716            stm_fsb: exp_flt := exp_flt-exp_res.exp_flt;
            1  717            stm_ssc: STRING_CONCATE( exp_str, exp_res.exp_str, exp_ref = nil, exp_res.exp_ref = nil );
            1  718            stm_seq: if STRING_COMPARE( exp_str, exp_res.exp_str, exp_ref = nil, exp_res.exp_ref = nil )  = 0 then
                     exp_int := 1 else exp_int := 0;
            1  719            stm_sne: if STRING_COMPARE( exp_str, exp_res.exp_str, exp_ref = nil, exp_res.exp_ref = nil ) <> 0 then
                     exp_int := 1 else exp_int := 0;
            1  720            stm_slt: if STRING_COMPARE( exp_str, exp_res.exp_str, exp_ref = nil, exp_res.exp_ref = nil )  < 0 then
                     exp_int := 1 else exp_int := 0;
            1  721            stm_sle: if STRING_COMPARE( exp_str, exp_res.exp_str, exp_ref = nil, exp_res.exp_ref = nil ) <= 0 then
                     exp_int := 1 else exp_int := 0;
            1  722            stm_sge: if STRING_COMPARE( exp_str, exp_res.exp_str, exp_ref = nil, exp_res.exp_ref = nil ) >= 0 then
                     exp_int := 1 else exp_int := 0;
            1  723            stm_sgt: if STRING_COMPARE( exp_str, exp_res.exp_str, exp_ref = nil, exp_res.exp_ref = nil )  > 0 then
                     exp_int := 1 else exp_int := 0;
            1  724            stm_ieq: if exp_int  = exp_res.exp_int then exp_int := 1 else exp_int := 0;
            1  725            stm_ine: if exp_int <> exp_res.exp_int then exp_int := 1 else exp_int := 0;
            1  726            stm_ilt: if exp_int  < exp_res.exp_int then exp_int := 1 else exp_int := 0;
            1  727            stm_ile: if exp_int <= exp_res.exp_int then exp_int := 1 else exp_int := 0;
            1  728            stm_ige: if exp_int >= exp_res.exp_int then exp_int := 1 else exp_int := 0;
            1  729            stm_igt: if exp_int  > exp_res.exp_int then exp_int := 1 else exp_int := 0;
            1  730            stm_feq: if exp_flt  = exp_res.exp_flt then exp_int := 1 else exp_int := 0;
            1  731            stm_fne: if exp_flt <> exp_res.exp_flt then exp_int := 1 else exp_int := 0;
            1  732            stm_flt: if exp_flt  < exp_res.exp_flt then exp_int := 1 else exp_int := 0;
            1  733            stm_fle: if exp_flt <= exp_res.exp_flt then exp_int := 1 else exp_int := 0;
            1  734            stm_fge: if exp_flt >= exp_res.exp_flt then exp_int := 1 else exp_int := 0;
            1  735            stm_fgt: if exp_flt  > exp_res.exp_flt then exp_int := 1 else exp_int := 0;
            1  736            stm_and: if (exp_int <> 0) and (exp_res.exp_int <> 0) then exp_int := 1 else exp_int := 0;
            1  737            stm_xor: if (exp_int <> 0) xor (exp_res.exp_int <> 0) then exp_int := 1 else exp_int := 0;
            1  738            stm_or:  if (exp_int <> 0) or  (exp_res.exp_int <> 0) then exp_int := 1 else exp_int := 0;
            1  739  
            1  740            stm_phaser: exp_flt := ARCTAN( exp_flt, exp_res.exp_flt );
            1  741            stm_phased: exp_flt := ARCTAN( exp_flt, exp_res.exp_flt )/inrd;
            1  742            stm_bessj:  exp_flt := BESSEL_J( exp_flt, exp_res.exp_flt );
            1  743          otherwise
            1  744          end
     3      1  745        end;
       C    1  746        { Force the resulting type }
            1  747        with ent_typ^ do
            1  748        begin
     4      1  749          exp_asr  :=  idet_asr;
            1  750          exp_form := idet_form
     3      1  751        end
     2      1  752      end
            1  753  ;WRITELN( ' -> ', exp_stk[exp_stkp] );
     1      1  754    end
     0      1  755  end EXE_VAL_BIN;
            1  756  
            1  757  
            1  758  
            1  759  procedure GEN_GENERIC_CALL( ent: ent_ptr; nm: integer; bfnc: boolean );
            1  760  const
            1  761    mdnam = 'CAGE';
            1  762  
            1  763  var
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  15
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "gen_generic_call".

            1  764    fp:                  ide_ptr;
            1  765    sz, savestk, npa:    integer;
            1  766    pr:                  idm_rec;
            1  767    c1, c2:                 char;
            1  768  
            1  769  begin
     1      1  770    with ent^, pr do
            1  771    begin
     2      1  772      if not bfnc and ent_typ <> nil then
            1  773      begin
     3      1  774        if exp_stkp < max_stk then exp_stkp := SUCC( exp_stkp )         { A result is given by the function but it
                    is not used }
            1  775                              else SRC_ERROR( mdnam, 6, e_severe )
     2      1  776      end;
            1  777      savestk := stkp_base; stkp_base := curr_disp;                     { Save the current stack base end install 
                    the new one }
            1  778      with exp_stk[exp_stkp], ent_typ^ do
            1  779      begin { Prepare the resulting expression room in the stack }
     3      1  780        exp_ref   := nil;
            1  781        exp_asr   := idet_asr;
            1  782        if exp_asr <> nil then exp_edim := exp_asr^.asr_stp
            1  783                          else exp_edim := 1;
            1  784        exp_shift := 0;
            1  785        exp_flags := idet_flags;
            1  786        exp_form  :=  idet_form;
            1  787        if exp_asr <> nil then with exp_asr^ do sz := asr_siz*asr_stp
            1  788                          else sz := 1;
            1  789        case exp_form of
            1  790          form_valstr: exp_str := nil;  { String result }
            1  791          form_valint: exp_int :=   0;  { Integer result }
            1  792          form_valflt: begin            { Float result }
     4      1  793                         exp_flt := 0.0; exp_sig := 0.0
     3      1  794                       end;
            1  795          form_tabstr: begin            { Array of string }
     4      1  796                         NEW( exp_aas, sz );
            1  797                         for ii := 1 to sz do exp_aas^.ide_stb[ii] := nil
     3      1  798                       end;
            1  799          form_tabint: begin
     4      1  800                         NEW( exp_aai, sz );
            1  801                         for ii := 1 to sz do exp_aai^.ide_itb[ii] :=   0
     3      1  802                       end;
            1  803          form_tabflt: begin
     4      1  804                         NEW( exp_aaf, sz );
            1  805                         for ii := 1 to sz do exp_aaf^.ide_ftb[ii] := 0.0;
            1  806                         if objf_sigma in exp_flags then
            1  807                         begin
     5      1  808                           NEW( exp_asg, sz );
            1  809                           for ii := 1 to sz do exp_asg^.ide_ftb[ii]:=0.0
     4      1  810                         end else exp_asg := nil
     3      1  811                       end;
            1  812        otherwise
            1  813        end
     2      1  814      end;
            1  815  
       C    1  816      { Create the formal display level }
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  16
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "gen_generic_call".

            1  817      DISPLAY_NEW;
            1  818      with disp_tab[curr_disp] do
            1  819      begin  disp_idt := ent_frl; disp_lid := ent_frl  end;
            1  820  
            1  821      DISPLAY_NEW;                                { Create the function body display }
            1  822  
            1  823      idm_name    :=        nil;
            1  824      idm_parl    :=        nil;
            1  825      idm_nxt     :=        nil;
            1  826      idm_prv     :=        nil;
            1  827      idm_run     :=      false;
            1  828      idm_kind    :=   idm_list;
            1  829      idm_tab     :=    ent_cod;
            1  830      idm_cntx    := idm_actstk;
            1  831      idm_actstk  := pr"address;
            1  832      idm_run     :=       true;
            1  833      idm_nch     :=          1;
            1  834      c1 := sy_ch; c2 := sy_cmin; sy_ch := ' ';
            1  835      STATELIST( endsy );
            1  836      sy_ch := c1; sy_cmin := c2;
            1  837      DISPLAY_FREE;                       { Suppress the display level of the code }
            1  838      curr_disp := curr_disp - 1;         { take of the formal display level }
            1  839  
            1  840      if ent_typ <> nil then              { For the function (with result) }
            1  841      begin
     3      1  842        exp_stkp := stkp_base;            { Force the init function stack, level }
            1  843        exp_stk[exp_stkp - ent_npa] := exp_stk[exp_stkp] { Force the place of function result for next use }
     2      1  844      end;
            1  845      if npa > 0 then STACK_REMOVE( npa );
            1  846      INSYMBOL
     1      1  847    end
     0      1  848  end GEN_GENERIC_CALL;
            1  849  
            1  850  
            1  851  
            1  852  procedure GEN_GENOPER( op: dcp_oper; npa: integer );
            1  853  const
            1  854    mdnam = 'COPE';
            1  855  
            1  856  var
            1  857    ent: ent_ptr;
            1  858  
            1  859    nam_ope: [static] array[dcp_oper] of string( 4 ) :=
            1  860      [ 'not',  '**',   '*',   '/', 'div', 'mod', 'rem',   '+',
            1  861          '-',  '||',   '<',  '<=',  '>=',   '>',  '<>',   '=',
            1  862        'and',  'or', 'xor',  ':=',   ';',   ' ' ];
            1  863  
            1  864  begin
     1      1  865    ent := GENERIC_SEARCH( mop_tab[op].mop_last, npa );
            1  866  
            1  867  if ent <> nil then
            1  868  with ent^ do
            1  869  begin
     2      1  870    WRITELN( ' Found ', ent_stm, '( ', ent_pt1^.ide_name^, ', ', ent_pt2^.ide_name^, ' ) -> ', ent_typ^.ide_name )
                    ;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  17
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "gen_genoper".

     1      1  871  end;
            1  872  
            1  873    if ent <> nil then
            1  874    begin
     2      1  875      case ent^.ent_knd of
            1  876        entk_stm: { Intrinsec statement }
            1  877          if npa = 1 then EXE_VAL_UNA( ent )      { Unary operator }
            1  878                     else EXE_VAL_BIN( ent );     { Binary operator }
            1  879  
            1  880        entk_fnc: { User defined operation }
            1  881          GEN_GENERIC_CALL( ent, npa, true );    { User defined operator }
            1  882  
            1  883      otherwise
            1  884      end
     1      1  885    end
            1  886    else SRC_ERROR_S( mdnam, 128, e_error, nam_ope[op] )
     0      1  887  end GEN_GENOPER;
            1  888  
            1  889  
            1  890  
            1  891  
            1  892  
            1  893  [global]
            1  894  procedure EXP_GENERIC_CALL( idp: ide_ptr; bexpr: boolean );
            1  895  const
            1  896    mdnam = 'EGCA';
            1  897  
            1  898  var
            1  899    npa: integer;
            1  900    ent: ent_ptr;
            1  901  
            1  902  begin
     1      1  903    with sy_sym do
            1  904    begin
     2      1  905      INSYMBOL;                                   { Gobble up the function/procedure identifier }
       C    1  906      { Push each argument in the stack }
            1  907      npa := 0;
            1  908      if sy = lparen then
            1  909      begin
     3      1  910        sy := comma;
            1  911        while sy = comma do                       { Loop on the argument list }
            1  912        begin
     4      1  913          INSYMBOL;                               { Gobble up "(" or "," }
            1  914          if (sy <> comma) and (sy <> rparen) then
            1  915          begin
     5      1  916            EXPRESSION; npa := SUCC( npa )        { Get each argument }
     4      1  917          end
     3      1  918        end;
            1  919        if sy <> rparen then SRC_ERROR( mdnam, 23, e_error )
            1  920                        else INSYMBOL
     2      1  921      end;
            1  922  
       C    1  923      { Search the entry that match with the parameter list }
            1  924      ent := GENERIC_SEARCH( idp^.ideg_last, npa );
            1  925      if ent <> nil then
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  18
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_exp_generic_call".

            1  926      begin
     3      1  927        case ent^.ent_knd of
            1  928          entk_stm: { Intrinsec statement }
            1  929            if npa = 1 then EXE_VAL_UNA( ent )    { Exec the Unary Intrinsec function }
            1  930                       else EXE_VAL_BIN( ent );   { exec the Binary Intrinsec function }
            1  931  
            1  932          entk_fnc: { User defined operation }
            1  933            GEN_GENERIC_CALL( ent, npa, true );   { Exec the user function }
            1  934  
            1  935          entk_std: { Builtin procedure and function }
            1  936            EXEC_BUILTIN( ent^.ent_std, npa );    { Exec the Builtin function }
            1  937  
            1  938        otherwise
            1  939        end
     2      1  940      end
            1  941      else SRC_ERROR_S( mdnam, 128, e_error, idp^.ide_name^ )
     1      1  942    end
     0      1  943  end EXP_GENERIC_CALL;
            1  944  
            1  945  
            1  946  
       C    1  947  {////////////}
       C    1  948  
       C    1  949  
       C    1  950  
       C    1  951  
       C    1  952  
            1  953  [global]
            1  954  procedure GET_EXPRESSION;
       C    1  955  { Routine to get an expression, the result is located in the record exp_res }
            1  956  const
            1  957    mdnam = 'GEXP';
            1  958  
            1  959  var
            1  960    sp: integer;
            1  961  
            1  962  begin
     1      1  963    sp := exp_stkp;            { Save the stack pointer }
            1  964    EXPRESSION;                { Manage the current expression }
            1  965    POP_EXPRESSION;            { Pop the resulting expression from the stack }
            1  966    if sp <> exp_stkp then
            1  967    begin
     2      1  968      SRC_ERROR( mdnam, 9, e_error );
            1  969      exp_stkp := sp           { Restore the stack pointer }
     1      1  970    end
     0      1  971  end GET_EXPRESSION;
            1  972  
            1  973  
            1  974  
            1  975  [global]
            1  976  function EXP_GETKINDS( ish: integer ): typ_form;
            1  977  const
            1  978    mdnam = 'EXGK';
            1  979  
            1  980  var
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  19
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_exp_getkinds".

            1  981    typ: typ_form;
            1  982  
            1  983  begin
     1      1  984    typ := form_null;
            1  985    ish := exp_stkp - ish;
            1  986    if ish > 0 then typ := exp_stk[ish].exp_form
            1  987               else SRC_ERROR( mdnam, 8, e_severe );
            1  988    EXP_GETKINDS := typ
     0      1  989  end EXP_GETKINDS;
            1  990  
            1  991  
       C    1  992  { ***  Routines to get an expression value of a predefined type *** }
       C    1  993  
            1  994  procedure CHECK_LVALUE_REF;
            1  995  begin
     1      1  996    if debug_exp then
            1  997    with lst_current^, exp_res do
            1  998    begin
     2      1  999      WRITE( lst_file, ' Lvalue POP : ' );
            1 1000      if exp_ref = nil then WRITE( lst_file, '<Not a Identifier Ref.>' )
            1 1001      else
            1 1002        with exp_ref^ do
            1 1003          if ide_name <> nil then WRITE( lst_file, '"',ide_name, '"' )
            1 1004                             else WRITE( lst_file, '<Identifier Without Name>' );
            1 1005      WRITELN( lst_file )
     1      1 1006    end;
            1 1007    if exp_res.exp_ref = nil then SRC_ERROR( 'EXRF', 111, e_severe )
     0      1 1008  end CHECK_LVALUE_REF;
            1 1009  
            1 1010  
            1 1011  
            1 1012  [global]
            1 1013  procedure POP_EXP_REFER( var rec: exp_rec );
            1 1014  begin
     1      1 1015    POP_EXPRESSION;
            1 1016    CHECK_LVALUE_REF;
            1 1017    rec := exp_res
     0      1 1018  end POP_EXP_REFER;
            1 1019  
            1 1020  
            1 1021  
            1 1022  [global]
            1 1023  procedure GET_EXP_REFER( var rec: exp_rec );
            1 1024  begin
     1      1 1025    GET_EXPRESSION;
            1 1026    CHECK_LVALUE_REF;
            1 1027    rec := exp_res
     0      1 1028  end GET_EXP_REFER;
            1 1029  
            1 1030  
            1 1031  
            1 1032  [global]
            1 1033  procedure POP_EXP_VALUE( var typ: typ_form; var iv:     integer;
            1 1034                                              var rv, sg: mxd_flt;
            1 1035                                              var st:      string );
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  20
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

       C    1 1036  { To pop a number value }
            1 1037  const
            1 1038    mdnam = 'POVL';
            1 1039  
            1 1040  begin
     1      1 1041    POP_EXPRESSION;
            1 1042    with exp_res do
            1 1043    case exp_form of
            1 1044      form_telstr,
            1 1045      form_valstr: begin
     2      1 1046                    if exp_form = form_telstr then
            1 1047                    begin
     3      1 1048                      if exp_aas <> nil then exp_str := exp_aas^.ide_stb[exp_shift]
            1 1049                                        else exp_str := nil
     2      1 1050                    end;
            1 1051                    typ := form_valstr;
            1 1052                    if exp_str <> nil then
            1 1053                    begin
     3      1 1054                      st := exp_str^;
            1 1055                      if exp_ref = nil then
            1 1056                      begin { Free any temporary string }
     4      1 1057                        DISPOSE( exp_str ); exp_str := nil
     3      1 1058                      end
     2      1 1059                    end else st.length := 0
     1      1 1060                  end;
            1 1061  
            1 1062      form_telint,
            1 1063      form_valint: begin
     2      1 1064                    if exp_form = form_telint then
            1 1065                      if exp_aai <> nil then exp_int := exp_aai^.ide_itb[exp_shift]
            1 1066                                        else exp_int := 0;
            1 1067                    typ := form_valint;
            1 1068                    iv  := exp_int
     1      1 1069                  end;
            1 1070  
            1 1071      form_telflt,
            1 1072      form_valflt: begin
     2      1 1073                    if exp_form = form_telflt then
            1 1074                    begin
     3      1 1075                      if exp_aaf <> nil then exp_flt := exp_aaf^.ide_ftb[exp_shift]
            1 1076                                        else exp_flt := 0.0;
            1 1077                      if exp_asg <> nil then exp_sig := exp_asg^.ide_ftb[exp_shift]
     2      1 1078                    end;
            1 1079                    typ := form_valflt;
            1 1080                    rv  := exp_flt
     1      1 1081                  end;
            1 1082  
            1 1083    otherwise
       C    1 1084      { Illegal array use or null expression }
     2      1 1085      if exp_form <> form_null then SRC_ERROR( mdnam, 112, e_severe );
            1 1086      typ := form_null
     1      1 1087    end;
            1 1088  
            1 1089    if debug_exp then
            1 1090    with lst_current^ do
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  21
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_pop_exp_value".

            1 1091    begin
     2      1 1092      WRITE( lst_file, ' POP : ', ORD( typ ) );
            1 1093      case typ of
            1 1094        form_valint:      WRITE( lst_file, iv );
            1 1095        form_valflt:      WRITE( lst_file, rv );
            1 1096        form_valstr:      WRITE( lst_file, '"', st, '"' );
            1 1097      otherwise
            1 1098      end;
            1 1099      WRITELN( lst_file )
     1      1 1100    end
     0      1 1101  end POP_EXP_VALUE;
            1 1102  
            1 1103  
            1 1104  
            1 1105  [global]
            1 1106  procedure GET_EXP_VALUE( var typ: typ_form; var iv:     integer;
            1 1107                                              var rv, sg: mxd_flt;
            1 1108                                              var st:      string );
       C    1 1109  { To get a value }
            1 1110  const
            1 1111    mdnam = 'GEVL';
            1 1112  
            1 1113  var
            1 1114    sp: integer;
            1 1115  
            1 1116  begin
     1      1 1117    sp := exp_stkp;            { Save the stack pointer }
            1 1118    EXPRESSION;                { Manage the current expression }
            1 1119    POP_EXP_VALUE( typ, iv, rv, sg, st );
            1 1120    if sp <> exp_stkp then
            1 1121    begin
     2      1 1122      SRC_ERROR( mdnam, 9, e_error );
            1 1123      exp_stkp := sp           { Restore the stack pointer }
     1      1 1124    end
     0      1 1125  end GET_EXP_VALUE;
            1 1126  
            1 1127  
            1 1128  
            1 1129  [global]
            1 1130  procedure POP_NUMEXPR( var   bf:       boolean;
            1 1131                         var   iv:       integer;
            1 1132                         var   rv, sg:   mxd_flt );
       C    1 1133  { To pop a number value }
            1 1134  var
            1 1135    ty:         typ_form;
            1 1136    st:       str_string;
            1 1137  
            1 1138  begin
     1      1 1139    POP_EXP_VALUE( ty, iv, rv, sg, st );
            1 1140    case ty of
            1 1141      form_valstr: begin
     2      1 1142                     bf := false;
            1 1143                     if st.length > 0 then READV( st, iv )
            1 1144                                      else iv := 0
     1      1 1145                   end;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  22
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_pop_numexpr".

            1 1146      form_valint: bf := false;
            1 1147      form_valflt: bf :=  true;
            1 1148    otherwise
            1 1149    end
     0      1 1150  end POP_NUMEXPR;
            1 1151  
            1 1152  
            1 1153  
            1 1154  [global]
            1 1155  procedure GET_NUMEXPR( var   bf:       boolean;
            1 1156                         var   iv:       integer;
            1 1157                         var   rv, sg:   mxd_flt );
       C    1 1158  { To get a number value }
            1 1159  var
            1 1160    ty:         typ_form;
            1 1161    st:       str_string;
            1 1162  
            1 1163  begin
     1      1 1164    GET_EXP_VALUE( ty, iv, rv, sg, st );
            1 1165    case ty of
            1 1166      form_valstr: begin
     2      1 1167                     bf := false;
            1 1168                     if st.length > 0 then READV( st, iv )
            1 1169                                      else iv := 0
     1      1 1170                   end;
            1 1171      form_valint: bf := false;
            1 1172      form_valflt: bf :=  true;
            1 1173    otherwise
            1 1174    end
     0      1 1175  end GET_NUMEXPR;
            1 1176  
            1 1177  
            1 1178  
            1 1179  [global]
            1 1180  function POP_INTEXPR( iv: integer ): integer;
       C    1 1181  { To pop an integer value }
            1 1182  var
            1 1183    ty:         typ_form;
            1 1184    st:       str_string;
            1 1185    rv, sg:      mxd_flt;
            1 1186  
            1 1187  begin
     1      1 1188    POP_EXP_VALUE( ty, iv, rv, sg, st );
            1 1189    case ty of
            1 1190      form_valstr: if st.length > 0 then READV( st, iv )
            1 1191                                    else iv := 0;
            1 1192      form_valflt: iv := ROUND( rv );
            1 1193      form_valint: ;
            1 1194    otherwise
            1 1195    end;
            1 1196    POP_INTEXPR := iv
     0      1 1197  end POP_INTEXPR;
            1 1198  
            1 1199  
            1 1200  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  23
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

            1 1201  [global]
            1 1202  function GET_INTEXPR( iv: integer ): integer;
       C    1 1203  { To get an integer value }
            1 1204  var
            1 1205    ty:         typ_form;
            1 1206    st:       str_string;
            1 1207    rv, sg:      mxd_flt;
            1 1208  
            1 1209  begin
     1      1 1210    GET_EXP_VALUE( ty, iv, rv, sg, st );
            1 1211    case ty of
            1 1212      form_valstr: if st.length > 0 then READV( st, iv )
            1 1213                                    else iv := 0;
            1 1214      form_valflt: iv := ROUND( rv );
            1 1215      form_valint: ;
            1 1216    otherwise
            1 1217    end;
            1 1218    GET_INTEXPR := iv
     0      1 1219  end GET_INTEXPR;
            1 1220  
            1 1221  
            1 1222  
            1 1223  [global]
            1 1224  function POP_FLTEXPR( rv: mxd_flt ): mxd_flt;
       C    1 1225  { To pop a floatting value }
            1 1226  var
            1 1227    ty:         typ_form;
            1 1228    st:       str_string;
            1 1229    iv:          integer;
            1 1230    sg:          mxd_flt;
            1 1231  
            1 1232  begin
     1      1 1233    POP_EXP_VALUE( ty, iv, rv, sg, st );
            1 1234    case ty of
            1 1235      form_valstr: if st.length > 0 then READV( st, rv )
            1 1236                                    else rv := 0.0;
            1 1237      form_valflt: ;
            1 1238      form_valint: rv := iv;
            1 1239    otherwise
            1 1240    end;
            1 1241    POP_FLTEXPR := rv
     0      1 1242  end POP_FLTEXPR;
            1 1243  
            1 1244  
            1 1245  
            1 1246  
            1 1247  [global]
            1 1248  function GET_FLTEXPR( rv: mxd_flt ): mxd_flt;
       C    1 1249  { To get a floatting value }
            1 1250  var
            1 1251    ty:         typ_form;
            1 1252    st:       str_string;
            1 1253    iv:          integer;
            1 1254    sg:          mxd_flt;
            1 1255  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  24
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_get_fltexpr".

            1 1256  begin
     1      1 1257    GET_EXP_VALUE( ty, iv, rv, sg, st );
            1 1258    case ty of
            1 1259      form_valstr: if st.length > 0 then READV( st, rv )
            1 1260                                    else rv := 0.0;
            1 1261      form_valflt: ;
            1 1262      form_valint: rv := iv;
            1 1263    otherwise
            1 1264    end;
            1 1265    GET_FLTEXPR := rv
     0      1 1266  end GET_FLTEXPR;
            1 1267  
            1 1268  
            1 1269  
            1 1270  [global]
            1 1271  procedure POP_STREXPR( var st: string );
       C    1 1272  { To pop a string value }
            1 1273  var
            1 1274    ty:         typ_form;
            1 1275    iv:          integer;
            1 1276    rv, sg:      mxd_flt;
            1 1277  
            1 1278  begin
     1      1 1279    POP_EXP_VALUE( ty, iv, rv, sg, st );
            1 1280    case ty of
            1 1281      form_valstr: ;
            1 1282      form_valflt: WRITEV( st, rv );
            1 1283      form_valint: WRITEV( st, iv );
            1 1284    otherwise
            1 1285    end
     0      1 1286  end POP_STREXPR;
            1 1287  
            1 1288  
            1 1289  
            1 1290  [global]
            1 1291  procedure GET_STREXPR( var st: string );
       C    1 1292  { To get a string value }
            1 1293  var
            1 1294    ty:         typ_form;
            1 1295    iv:          integer;
            1 1296    rv, sg:      mxd_flt;
            1 1297  
            1 1298  begin
     1      1 1299    GET_EXP_VALUE( ty, iv, rv, sg, st );
            1 1300    case ty of
            1 1301      form_valstr: ;
            1 1302      form_valflt: WRITEV( st, rv );
            1 1303      form_valint: WRITEV( st, iv );
            1 1304    otherwise
            1 1305    end
     0      1 1306  end GET_STREXPR;
            1 1307  
            1 1308  
            1 1309  
            1 1310  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  25
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

            1 1311  [global]
            1 1312  procedure ARRSCA_SS_OPE( op: dcp_oper; var src, dst: exp_rec );
            1 1313  var
            1 1314    idst: integer;
            1 1315  
            1 1316  begin
     1      1 1317    with dst do
            1 1318    begin
     2      1 1319      idst := exp_shift;
            1 1320      if exp_aas <> nil then
            1 1321      with exp_aas^ do
       C    1 1322      { case op of }
       C    1 1323        { ass_op: }
            1 1324                for ii := 1 to dst.exp_edim do
            1 1325                begin
     3      1 1326                  if ide_stb[idst] <> nil then DISPOSE( ide_stb[idst] );
            1 1327                  if src.exp_str <> nil then
            1 1328                    if src.exp_ref = nil then
       C    1 1329                      { Temporary string begin permanent }
            1 1330                      ide_stb[idst] := src.exp_str
            1 1331                    else
            1 1332                    begin
       C    1 1333                      { Create a string copy }
     4      1 1334                      NEW( ide_stb[idst], src.exp_str^.length );
            1 1335                      ide_stb[idst]^ := src.exp_str^
     3      1 1336                    end
            1 1337                  else ide_stb[idst] := nil;
            1 1338                  idst := idst + 1
     2      1 1339                end;
       C    1 1340      { end }
     1      1 1341    end
     0      1 1342  end ARRSCA_SS_OPE;
            1 1343  
            1 1344  
            1 1345  
            1 1346  [global]
            1 1347  procedure ARRSCA_II_OPE( op: dcp_oper; vsrc: integer; var dst: exp_rec );
            1 1348  var
            1 1349    idst: integer;
            1 1350  
            1 1351  begin
     1      1 1352    with dst do
            1 1353    begin
     2      1 1354      idst := exp_shift;
            1 1355      if exp_aai <> nil then
            1 1356      with exp_aai^ do
            1 1357      case op of
            1 1358        ass_op: for ii := 1 to exp_edim do
            1 1359                begin
     3      1 1360                  ide_itb[idst] := vsrc; idst := idst + 1
     2      1 1361                end;
            1 1362        add_op: for ii := 1 to exp_edim do
            1 1363                begin
     3      1 1364                  ide_itb[idst] := ide_itb[idst] + vsrc; idst := idst + 1
     2      1 1365                end;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  26
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_arrsca_ii_ope".

            1 1366        sub_op: for ii := 1 to exp_edim do
            1 1367                begin
     3      1 1368                  ide_itb[idst] := ide_itb[idst] - vsrc; idst := idst + 1
     2      1 1369                end;
            1 1370        mul_op: for ii := 1 to exp_edim do
            1 1371                begin
     3      1 1372                  ide_itb[idst] := ide_itb[idst] * vsrc; idst := idst + 1
     2      1 1373                end;
            1 1374        idiv_op: for ii := 1 to exp_edim do
            1 1375                begin
     3      1 1376                  ide_itb[idst] := ide_itb[idst] div vsrc; idst := idst + 1
     2      1 1377                end;
            1 1378      otherwise
            1 1379      end
     1      1 1380    end
     0      1 1381  end ARRSCA_II_OPE;
            1 1382  
            1 1383  
            1 1384  
            1 1385  [global]
            1 1386  procedure ARRSCA_FF_OPE( op: dcp_oper; vsrc, vsig: mxd_flt; var dst: exp_rec );
            1 1387  var
            1 1388    idst: integer;
            1 1389  
            1 1390  begin
     1      1 1391    with dst do
            1 1392    begin
     2      1 1393      idst := exp_shift;
            1 1394      if exp_aaf <> nil then
            1 1395      with exp_aaf^ do
            1 1396      case op of
            1 1397        ass_op: for ii := 1 to exp_edim do
            1 1398                begin
     3      1 1399                  ide_ftb[idst] := vsrc;
            1 1400                  if exp_asg <> nil then exp_asg^.ide_ftb[idst] := vsig;
            1 1401                  idst := idst + 1
     2      1 1402                end;
            1 1403        add_op: for ii := 1 to exp_edim do
            1 1404                begin
     3      1 1405                  ide_ftb[idst] := ide_ftb[idst] + vsrc;
            1 1406                  if exp_asg <> nil then with exp_asg^ do ide_ftb[idst] := SQRT( SQR( ide_ftb[idst] ) + SQR( vsig 
                    ) );
            1 1407                  idst := idst + 1
     2      1 1408                end;
            1 1409        sub_op: for ii := 1 to exp_edim do
            1 1410                begin
     3      1 1411                  ide_ftb[idst] := ide_ftb[idst] - vsrc;
            1 1412                  if exp_asg <> nil then with exp_asg^ do ide_ftb[idst] := SQRT( SQR( ide_ftb[idst] ) + SQR( vsig 
                    ) );
            1 1413                  idst := idst + 1
     2      1 1414                end;
            1 1415        mul_op: for ii := 1 to exp_edim do
            1 1416                begin
     3      1 1417                  ide_ftb[idst] := ide_ftb[idst] * vsrc;
       C    1 1418                  { /// }
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  27
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_arrsca_ff_ope".

            1 1419                  idst := idst + 1
     2      1 1420                end;
            1 1421        div_op: for ii := 1 to exp_edim do
            1 1422                begin
     3      1 1423                  ide_ftb[idst] := ide_ftb[idst] / vsrc;
       C    1 1424                  { /// }
            1 1425                  idst := idst + 1
     2      1 1426                end;
            1 1427      otherwise
            1 1428      end
     1      1 1429    end
     0      1 1430  end ARRSCA_FF_OPE;
            1 1431  
            1 1432  
            1 1433  
            1 1434  procedure ARRAY_DEF_MATCH( src, dst: exp_rec;
            1 1435                             var siz: integer; var flg: boolean );
            1 1436  const
            1 1437    mdnam = 'ARMA';
            1 1438  
            1 1439  var
            1 1440    p1, p2:      asr_ptr;
            1 1441    ok:          boolean;
            1 1442  
            1 1443  begin
     1      1 1444    ok := true;
            1 1445    p1 := src.exp_asr;
            1 1446    p2 := dst.exp_asr;
            1 1447    if src.exp_edim = dst.exp_edim then
            1 1448      while (p1 <> nil) and (p2 <> nil) and ok do
            1 1449      begin
     2      1 1450        ok := (p1^.asr_stp = p2^.asr_stp) and
            1 1451              (p1^.asr_siz = p2^.asr_siz);
            1 1452        p1 := p1^.asr_sub;
            1 1453        p2 := p2^.asr_sub
     1      1 1454      end
            1 1455    else ok := false;
            1 1456    flg := ok and (p1 = p2);
            1 1457    if not flg then SRC_ERROR( mdnam, 78, e_severe );
            1 1458    siz := dst.exp_edim  
     0      1 1459  end ARRAY_DEF_MATCH;
            1 1460  
            1 1461  
            1 1462  
            1 1463  [global]
            1 1464  procedure ARRAY_SS_OPE( op: dcp_oper; var src, dst: exp_rec );
            1 1465  var
            1 1466    size, isrc, idst:    integer;
            1 1467    psrc:            ^ide_arrstr;
            1 1468    bok:                 boolean;
            1 1469  
            1 1470  begin
     1      1 1471    ARRAY_DEF_MATCH( src, dst, size, bok );
            1 1472    if bok and (src.exp_aas <> nil) and (dst.exp_aas <> nil) then
            1 1473    with dst.exp_aas^, src do
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  28
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_array_ss_ope".

            1 1474    begin
     2      1 1475      psrc := exp_aas;
            1 1476      isrc := exp_shift;
            1 1477      idst := dst.exp_shift;
       C    1 1478      { case op of }
       C    1 1479        { ass_op: }
            1 1480           for ii := 1 to size do
            1 1481           begin
     3      1 1482             if ide_stb[isrc] <> nil then DISPOSE( ide_stb[idst] );
            1 1483             if psrc^.ide_stb[isrc] <> nil then
            1 1484             begin
     4      1 1485               NEW( ide_stb[idst], psrc^.ide_stb[isrc]^.length );
            1 1486               ide_stb[idst]^ := psrc^.ide_stb[isrc]^
     3      1 1487             end
            1 1488             else ide_stb[idst] := nil;
            1 1489             idst := idst + 1; isrc := isrc + 1
     2      1 1490           end;
       C    1 1491      { end }
     1      1 1492    end
     0      1 1493  end ARRAY_SS_OPE;
            1 1494  
            1 1495  
            1 1496  
            1 1497  [global]
            1 1498  procedure ARRAY_II_OPE( op: dcp_oper; var src, dst: exp_rec );
            1 1499  var
            1 1500    size, isrc, idst: integer;
            1 1501    psrc:             ^ide_arrint;
            1 1502    bok:              boolean;
            1 1503  
            1 1504  begin
     1      1 1505    ARRAY_DEF_MATCH( src, dst, size, bok );
            1 1506    if bok and (src.exp_aai <> nil) and (dst.exp_aai <> nil) then
            1 1507    with dst.exp_aai^, src do
            1 1508    begin
     2      1 1509      psrc := exp_aai;
            1 1510      isrc := exp_shift;
            1 1511      idst := dst.exp_shift;
            1 1512      case op of
            1 1513        ass_op: for ii := 1 to size do
            1 1514                begin
     3      1 1515                  ide_itb[idst] := psrc^.ide_itb[isrc];
            1 1516                  idst := idst + 1; isrc := isrc + 1
     2      1 1517                end;
            1 1518        add_op: for ii := 1 to size do
            1 1519                begin
     3      1 1520                  ide_itb[idst] := ide_itb[idst] + psrc^.ide_itb[isrc];
            1 1521                  idst := idst + 1; isrc := isrc + 1
     2      1 1522                end;
            1 1523        sub_op: for ii := 1 to size do
            1 1524                begin
     3      1 1525                  ide_itb[idst] := ide_itb[idst] - psrc^.ide_itb[isrc];
            1 1526                  idst := idst + 1; isrc := isrc + 1
     2      1 1527                end;
            1 1528        mul_op: for ii := 1 to size do
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  29
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_array_ii_ope".

            1 1529                begin
     3      1 1530                  ide_itb[idst] := ide_itb[idst] * psrc^.ide_itb[isrc];
            1 1531                  idst := idst + 1; isrc := isrc + 1
     2      1 1532                end;
            1 1533        div_op: for ii := 1 to size do
            1 1534                begin
     3      1 1535                  ide_itb[idst] := ide_itb[idst] div psrc^.ide_itb[isrc];
            1 1536                  idst := idst + 1; isrc := isrc + 1
     2      1 1537                end;
            1 1538      otherwise
            1 1539      end
     1      1 1540    end
     0      1 1541  end ARRAY_II_OPE;
            1 1542  
            1 1543  
            1 1544  
            1 1545  [global]
            1 1546  procedure ARRAY_IF_OPE( op: dcp_oper; var src, dst: exp_rec );
            1 1547  var
            1 1548    size, isrc, idst: integer;
            1 1549    psrc:             ^ide_arrflt;
            1 1550    bok:              boolean;
            1 1551  
            1 1552  begin
     1      1 1553    ARRAY_DEF_MATCH( src, dst, size, bok );
            1 1554    if bok and (src.exp_aaf <> nil) and (dst.exp_aai <> nil) then
            1 1555    with dst.exp_aai^, src do
            1 1556    begin
     2      1 1557      psrc := exp_aaf;
            1 1558      isrc := exp_shift;
            1 1559      idst := dst.exp_shift;
            1 1560      case op of
            1 1561        ass_op: for ii := 1 to size do
            1 1562                begin
     3      1 1563                  ide_itb[idst] := ROUND( psrc^.ide_ftb[isrc] );
            1 1564                  idst := idst + 1; isrc := isrc + 1
     2      1 1565                end;
            1 1566        add_op: for ii := 1 to size do
            1 1567                begin
     3      1 1568                  ide_itb[idst] := ide_itb[idst] + ROUND( psrc^.ide_ftb[isrc] );
            1 1569                  idst := idst + 1; isrc := isrc + 1
     2      1 1570                end;
            1 1571        sub_op: for ii := 1 to size do
            1 1572                begin
     3      1 1573                  ide_itb[idst] := ide_itb[idst] - ROUND( psrc^.ide_ftb[isrc] );
            1 1574                  idst := idst + 1; isrc := isrc + 1
     2      1 1575                end;
            1 1576        mul_op: for ii := 1 to size do
            1 1577                begin
     3      1 1578                  ide_itb[idst] := ide_itb[idst] * ROUND( psrc^.ide_ftb[isrc] );
            1 1579                  idst := idst + 1; isrc := isrc + 1
     2      1 1580                end;
            1 1581        div_op: for ii := 1 to size do
            1 1582                begin
     3      1 1583                  ide_itb[idst] := ide_itb[idst] div ROUND( psrc^.ide_ftb[isrc] );
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  30
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_array_if_ope".

            1 1584                  idst := idst + 1; isrc := isrc + 1
     2      1 1585                end;
            1 1586      otherwise
            1 1587      end
     1      1 1588    end
     0      1 1589  end ARRAY_IF_OPE;
            1 1590  
            1 1591  
            1 1592  
            1 1593  [global]
            1 1594  procedure ARRAY_FI_OPE( op: dcp_oper; var src, dst: exp_rec );
            1 1595  var
            1 1596    size, isrc, idst: integer;
            1 1597    psrc:             ^ide_arrint;
            1 1598    bok:              boolean;
            1 1599  
            1 1600  begin
     1      1 1601    ARRAY_DEF_MATCH( src, dst, size, bok );
            1 1602    if bok and (src.exp_aai <> nil) and (dst.exp_aaf <> nil) then
            1 1603    with dst.exp_aaf^, src do
            1 1604    begin
     2      1 1605      psrc := exp_aai;
            1 1606      isrc := exp_shift;
            1 1607      idst := dst.exp_shift;
            1 1608      case op of
            1 1609        ass_op: for ii := 1 to size do
            1 1610                begin
     3      1 1611                  ide_ftb[idst] := psrc^.ide_itb[isrc];
            1 1612                  idst := idst + 1; isrc := isrc + 1
     2      1 1613                end;
            1 1614        add_op: for ii := 1 to size do
            1 1615                begin
     3      1 1616                  ide_ftb[idst] := ide_ftb[idst] + psrc^.ide_itb[isrc];
            1 1617                  idst := idst + 1; isrc := isrc + 1
     2      1 1618                end;
            1 1619        sub_op: for ii := 1 to size do
            1 1620                begin
     3      1 1621                  ide_ftb[idst] := ide_ftb[idst] - psrc^.ide_itb[isrc];
            1 1622                  idst := idst + 1; isrc := isrc + 1
     2      1 1623                end;
            1 1624        mul_op: for ii := 1 to size do
            1 1625                begin
     3      1 1626                  ide_ftb[idst] := ide_ftb[idst] * psrc^.ide_itb[isrc];
            1 1627                  idst := idst + 1; isrc := isrc + 1
     2      1 1628                end;
            1 1629        div_op: for ii := 1 to size do
            1 1630                begin
     3      1 1631                  ide_ftb[idst] := ide_ftb[idst] / psrc^.ide_itb[isrc];
            1 1632                  idst := idst + 1; isrc := isrc + 1
     2      1 1633                end;
            1 1634      otherwise
            1 1635      end
     1      1 1636    end
     0      1 1637  end ARRAY_FI_OPE;
            1 1638  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  31
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

            1 1639  
            1 1640  
            1 1641  [global]
            1 1642  procedure ARRAY_FF_OPE( op: dcp_oper; var src, dst: exp_rec );
            1 1643  var
            1 1644    size, isrc, idst: integer;
            1 1645    psrc:             ^ide_arrflt;
            1 1646    bok:              boolean;
            1 1647  
            1 1648  begin
     1      1 1649    ARRAY_DEF_MATCH( src, dst, size, bok );
            1 1650    if bok and (src.exp_aaf <> nil) and (dst.exp_aaf <> nil) then
            1 1651    with dst.exp_aaf^, src do
            1 1652    begin
     2      1 1653      psrc := exp_aaf;
            1 1654      isrc := exp_shift;
            1 1655      idst := dst.exp_shift;
            1 1656      case op of
            1 1657        ass_op: for ii := 1 to size do
            1 1658                begin
     3      1 1659                  ide_ftb[idst] := psrc^.ide_ftb[isrc];
            1 1660                  idst := idst + 1; isrc := isrc + 1
     2      1 1661                end;
            1 1662        add_op: for ii := 1 to size do
            1 1663                begin
     3      1 1664                  ide_ftb[idst] := ide_ftb[idst] + psrc^.ide_ftb[isrc];
            1 1665                  idst := idst + 1; isrc := isrc + 1
     2      1 1666                end;
            1 1667        sub_op: for ii := 1 to size do
            1 1668                begin
     3      1 1669                  ide_ftb[idst] := ide_ftb[idst] - psrc^.ide_ftb[isrc];
            1 1670                  idst := idst + 1; isrc := isrc + 1
     2      1 1671                end;
            1 1672        mul_op: for ii := 1 to size do
            1 1673                begin
     3      1 1674                  ide_ftb[idst] := ide_ftb[idst] * psrc^.ide_ftb[isrc];
            1 1675                  idst := idst + 1; isrc := isrc + 1
     2      1 1676                end;
            1 1677        div_op: for ii := 1 to size do
            1 1678                begin
     3      1 1679                  ide_ftb[idst] := ide_ftb[idst] / psrc^.ide_ftb[isrc];
            1 1680                  idst := idst + 1; isrc := isrc + 1
     2      1 1681                end;
            1 1682      otherwise
            1 1683      end
     1      1 1684    end
     0      1 1685  end ARRAY_FF_OPE;
            1 1686  
            1 1687  
            1 1688  
            1 1689  [global]
            1 1690  procedure CREATE_NEW_ARR_DEF( var pn: asr_ptr; var  sz:     integer;
            1 1691                                    po: asr_ptr;      np, nc: integer );
       C    1 1692  { Procedure to create array dimension structures form
       C    1 1693    the np parameters in expression stack and copy the old array structure
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  32
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

       C    1 1694    for the undefined dimension }
            1 1695  const
            1 1696    mdnam = 'ARDF';
            1 1697  
            1 1698  var
            1 1699    pl, pc:      asr_ptr;
            1 1700  
            1 1701  begin
     1      1 1702    if po <> nil then
            1 1703    begin
     2      1 1704      NEW( pn );                                  { Create the new array definition block }
            1 1705      with pn^ do
            1 1706      begin
     3      1 1707        asr_sub := nil;
            1 1708        asr_siz := po^.asr_siz;                   { Set the old size  as default }
            1 1709        if po^.asr_sub <> nil then                { Array of array }
            1 1710        begin
     4      1 1711          CREATE_NEW_ARR_DEF( asr_sub, asr_stp, po^.asr_sub, np, nc+1 );
            1 1712          if np >= nc then                        { If a dimension is given, ... }
            1 1713          begin
     5      1 1714            asr_siz := POP_INTEXPR( 0 );          { ... get it and ... }
            1 1715            if asr_siz <= 0 then                  { ... if not > 0 => error and set at 1 }
            1 1716            begin
     6      1 1717              SRC_ERROR( mdnam, 75, e_severe );
            1 1718              asr_siz := 1
     5      1 1719            end
     4      1 1720          end
     3      1 1721        end
            1 1722        else
            1 1723        begin                                     { Array of scalar or top sub-array }
     4      1 1724          asr_sub := nil;
            1 1725          asr_stp := 1;
            1 1726          if np > nc then
            1 1727          begin { ** Too many specified dimension error ** }
     5      1 1728            SRC_ERROR( mdnam, 114, e_severe );
            1 1729            while np > nc do
            1 1730            begin { Take off the overflow of parameters }
     6      1 1731              exp_stkp := exp_stkp - 1;
            1 1732              np := np - 1
     5      1 1733            end
     4      1 1734          end;
            1 1735          if np = nc then                         { All dimension was specified }
            1 1736          begin                                   { Get the specified dimension }
     5      1 1737            asr_siz := POP_INTEXPR( 0 );          { Get it and ... }
            1 1738            if asr_siz <= 0 then                  { ... if not > 0 => error and set at 1 }
            1 1739            begin
     6      1 1740              SRC_ERROR( mdnam, 75, e_severe );
            1 1741              asr_siz := 1
     5      1 1742            end
     4      1 1743          end
     3      1 1744        end;
            1 1745        sz := asr_stp*asr_siz                     { Return the step of outer dimension }
     2      1 1746      end
     1      1 1747    end
     0      1 1748  end CREATE_NEW_ARR_DEF;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  33
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

            1 1749  
            1 1750  
            1 1751  
            1 1752  procedure EMODIF_ARRAY( np: integer );
            1 1753  const
            1 1754    mdnam = 'ARMD';
            1 1755  
            1 1756  type
            1 1757    e_r = record case integer of
            1 1758      1:( ps: ^ide_arrstr );
            1 1759      2:( pi: ^ide_arrint );
            1 1760      3:( pf: ^ide_arrflt )
            1 1761    end;
            1 1762  
            1 1763  var
            1 1764    dat_new: [static]          e_r;
            1 1765    size, iold, inew, sps: integer;
            1 1766    pold, pnew:            asr_ptr;
            1 1767    ip:                    ide_ptr;
            1 1768  
            1 1769  
            1 1770    procedure COPY_ELEM( typ: typ_form; pn, po: asr_ptr );
            1 1771    var
            1 1772      sz: integer;
            1 1773    begin
     1      1 1774      with pn^, ip^, dat_new do
            1 1775      begin
     2      1 1776        if po^.asr_siz > asr_siz then sz := asr_siz
            1 1777                                 else sz := po^.asr_siz;
            1 1778        if asr_sub = nil then
       C    1 1779          { For the array of scalar (or last sub-array) }
       C    1 1780          { Copy all the common element and init the new others }
            1 1781          case typ of
            1 1782            form_tabstr:  with ps^ do
            1 1783                          begin
     3      1 1784                            for ii := 1 to sz do
            1 1785                            begin
     4      1 1786                              iold := iold + 1; inew := inew + 1;
            1 1787                              ide_stb[inew] := aas^.ide_stb[iold]
     3      1 1788                            end;
            1 1789                            for ii := sz + 1 to asr_siz do
            1 1790                            begin
     4      1 1791                              inew := inew + 1;
            1 1792                              ide_stb[inew] := nil
     3      1 1793                            end
     2      1 1794                          end;
            1 1795            form_tabint:  with pi^ do
            1 1796                          begin
     3      1 1797                            for ii := 1 to sz do
            1 1798                            begin
     4      1 1799                              iold := iold + 1; inew := inew + 1;
            1 1800                              ide_itb[inew] := aai^.ide_itb[iold]
     3      1 1801                            end;
            1 1802                            for ii := sz + 1 to asr_siz do
            1 1803                            begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  34
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "PRC_00000003".

     4      1 1804                              inew := inew + 1;
            1 1805                              ide_itb[inew] := 0
     3      1 1806                            end
     2      1 1807                          end;
            1 1808            form_tabflt:  with pf^ do
            1 1809                          begin
     3      1 1810                            for ii := 1 to sz do
            1 1811                            begin
     4      1 1812                              iold := iold + 1; inew := inew + 1;
            1 1813                              ide_ftb[inew] := aaf^.ide_ftb[iold]
     3      1 1814                            end;
            1 1815                            for ii := sz + 1 to asr_siz do
            1 1816                            begin
     4      1 1817                              inew := inew + 1;
            1 1818                              ide_ftb[inew] := 0.0
     3      1 1819                            end
     2      1 1820                          end;
            1 1821          otherwise
            1 1822          end { case knd of }
            1 1823        else
            1 1824        begin { For an array of array }
       C    1 1825          { For the previously existing sub-array elements }
     3      1 1826          for ii := 1 to sz do  COPY_ELEM( typ, asr_sub, po^.asr_sub );
       C    1 1827          { For the new sub sub-array elements }
            1 1828          for ii := sz + 1 to asr_siz do
            1 1829          case typ of
            1 1830            form_tabstr:  with ps^ do
            1 1831                            for jj := 1 to asr_stp do
            1 1832                            begin
     4      1 1833                              inew := inew + 1;
            1 1834                              ide_stb[inew] := nil
     3      1 1835                            end;
            1 1836            form_tabint:  with pi^ do
            1 1837                            for jj := 1 to asr_stp do
            1 1838                            begin
     4      1 1839                              inew := inew + 1;
            1 1840                              ide_itb[inew] := 0
     3      1 1841                            end;
            1 1842            form_tabflt:  with pf^ do
            1 1843                            for jj := 1 to asr_stp do
            1 1844                            begin
     4      1 1845                              inew := inew + 1;
            1 1846                              ide_ftb[inew] := 0.0
     3      1 1847                            end;
            1 1848          otherwise
            1 1849          end
     2      1 1850        end
     1      1 1851      end
     0      1 1852    end COPY_ELEM;
            1 1853  
            1 1854  
            1 1855  begin { EMODIF_ARRAY }
     1      1 1856    ip := nil;
            1 1857    sps := exp_stkp - np;
            1 1858    if exp_stkp < np then
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  35
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "emodif_array".

            1 1859      SRC_ERROR( mdnam, 7, e_fatal ) { expression stack underflow }
            1 1860    else
            1 1861    with exp_stk[sps + 1] do
            1 1862    begin
     2      1 1863      if exp_ref = nil then
            1 1864        SRC_ERROR( mdnam, 111, e_severe )  { not a space reference error }
            1 1865      else
            1 1866      case exp_form of
            1 1867        form_tabstr,
            1 1868        form_tabint,
            1 1869        form_tabflt: ip := exp_ref;
            1 1870      otherwise { Not an array error }
     3      1 1871        SRC_ERROR( mdnam, 113, e_severe )
     2      1 1872      end
     1      1 1873    end;
            1 1874    if ip <> nil then
            1 1875    with ip^ do
            1 1876    if objf_lockd in idev_flags then SRC_ERROR( mdnam, 79, e_error )
            1 1877    else
            1 1878    begin
     2      1 1879      CREATE_NEW_ARR_DEF( pnew, size, idev_asr, np - 1, 1 );
            1 1880      if pnew <> nil then
            1 1881      with dat_new, pnew^ do
            1 1882      begin
       C    1 1883        { allocate the new data space }
     3      1 1884        size := asr_stp*asr_siz;
            1 1885        case idev_form of
            1 1886          form_tabstr: NEW( ps, size );
            1 1887          form_tabint: NEW( pi, size );
            1 1888          form_tabflt: NEW( pf, size );
            1 1889        otherwise
            1 1890        end;
       C    1 1891        { Initialize the data indexes }
            1 1892        iold := 0; inew := 0;
       C    1 1893        { Copy the already existing element and initialize the new ones }
            1 1894        COPY_ELEM( idev_form, pnew, idev_asr );
       C    1 1895        { free the old data space and set the new one }
            1 1896        case idev_form of
            1 1897          form_tabstr: begin  DISPOSE( aas ); aas := ps  end;
            1 1898          form_tabint: begin  DISPOSE( aai ); aai := pi  end;
            1 1899          form_tabflt: begin  DISPOSE( aaf ); aaf := pf  end;
            1 1900        otherwise
            1 1901        end;
       C    1 1902        { set the new array structure definition and free the old one }
            1 1903        pold := idev_asr;
            1 1904        idev_asr := pnew;
            1 1905        while pold <> nil do
            1 1906        begin
     4      1 1907          pnew := pold;
            1 1908          pold := pold^.asr_sub;
            1 1909          DISPOSE( pnew )
     3      1 1910        end
     2      1 1911      end
     1      1 1912    end;
            1 1913    exp_stkp := sps
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  36
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "mxd_dcp_expr".

     0      1 1914  end EMODIF_ARRAY;
            1 1915  
            1 1916  
            1 1917  
            1 1918  [global]
            1 1919  function IN_FILEMODE( iv: integer ): flags_file;
            1 1920  var
            1 1921    imd: flags_file;
            1 1922  
            1 1923  begin
     1      1 1924    if ODD( iv ) then imd := [case_dis_file]
            1 1925                 else imd := [];
            1 1926    if ODD( iv div 2 ) then imd := imd + [nolog_file];
            1 1927    IN_FILEMODE := imd
     0      1 1928  end IN_FILEMODE;
            1 1929  
            1 1930  
            1 1931  
            1 1932  procedure EXP_CALLBLT( npa: integer; fnc: std_fnc );
       C    1 1933  { To perform the builtin functions }
            1 1934  const
            1 1935    mdnam = 'BLTF';
            1 1936  
       C    1 1937    { *** Array operator definitions *** }
       C    1 1938  
            1 1939  var
            1 1940    iv, i, j, k, l, r:           integer;
            1 1941    rv, sg:                      mxd_flt;
            1 1942    bf, bs:                      boolean;
            1 1943    st, ss:                   str_string;
            1 1944    ftst:                           text;
            1 1945    rec, rec1:                   exp_rec;
            1 1946    typ:                        typ_form;
            1 1947    arf:                        dcp_oper;
            1 1948    ip:                          ide_ptr;
            1 1949    ch, cc:                         char;
            1 1950    imd, jmd:                 flags_file;
            1 1951  
            1 1952  begin
            1 1953  end EXP_CALLBLT;
            1 1954  
            1 1955  
            1 1956  
            1 1957  procedure EXP_ARRAY_REF( exp_elem: typ_form );
       C    1 1958  { To manipulate the array reference in the stack }
            1 1959  const
            1 1960    mdnam = 'ARRF';
            1 1961  
            1 1962  var
            1 1963    idx, jdx: integer;
            1 1964  
            1 1965  begin
     1      1 1966    with sy_sym, exp_stk[exp_stkp] do
            1 1967    if exp_asr <> nil then                        { For correct array definition }
            1 1968    with exp_asr^ do
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  37
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "exp_array_ref".

            1 1969    begin
     2      1 1970      INSYMBOL;                                   { Gobble up the "," or "[" }
            1 1971      idx := GET_INTEXPR( asr_min-1 ) - asr_min;  { Get the specified index }
            1 1972      if (idx < 0) or (idx >= asr_siz) then
            1 1973      begin                                       { If the index is out of range }
     3      1 1974        SRC_ERROR( mdnam, 71, e_error );          { Error ! }
            1 1975        idx := 0
     2      1 1976      end;
       C    1 1977      { Set the shift of object in the array }
            1 1978      exp_shift := exp_shift + idx*asr_stp;
            1 1979      exp_asr   := asr_sub;                       { Set as a sub-array or scalar ref. }
            1 1980      if sy = comma then EXP_ARRAY_REF( exp_elem ){ When there are more internal dimension }
            1 1981      else                                        { Last index, a sub-array ref. ? }
            1 1982      if sy = twodot then
            1 1983      begin { Sub-array reference }
     3      1 1984        INSYMBOL;
            1 1985        jdx := GET_INTEXPR( idx ) - asr_min;      { Get the upper index bound }
            1 1986        if (jdx < idx) or (jdx >= asr_siz) then
            1 1987        begin { Upper bound < lower bound or upper bound greater than max. }
     4      1 1988          SRC_ERROR( mdnam, 80, e_error );
            1 1989          jdx := asr_siz - idx + 1
     3      1 1990        end;
            1 1991        exp_edim := asr_stp*(jdx - idx + 1);
            1 1992        if (exp_asr = nil) and (jdx = idx) then exp_form := exp_elem
     2      1 1993      end
            1 1994      else
            1 1995      begin
     3      1 1996        exp_edim := asr_stp;
            1 1997        if exp_asr = nil then
            1 1998        begin
     4      1 1999          exp_form := exp_elem; { Array Element Reference }
            1 2000          if objf_lsqob in exp_flags then
            1 2001            if exp_nva then exp_form := form_lsqref { Array element LSQ reference }
     3      1 2002        end
     2      1 2003      end
     1      1 2004    end
            1 2005    else
            1 2006    begin { Not a good array or too many index are specified }
     2      1 2007      SRC_ERROR( mdnam, 82, e_error );
            1 2008      SKIP_SYMBOL( rbrack )
     1      1 2009    end
     0      1 2010  end EXP_ARRAY_REF;
            1 2011  
            1 2012  
            1 2013  
            1 2014  procedure EXP_ENTRY;
            1 2015  const
            1 2016    mdnam = 'EXPE';
            1 2017  
            1 2018  var
            1 2019    ip:       ide_ptr;
            1 2020    binsymb:  boolean;
            1 2021    npa, idw: integer;
            1 2022  
            1 2023  begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  38
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "exp_entry".

     1      1 2024    binsymb := true;
            1 2025    with sy_sym, exp_stk[exp_stkp] do
            1 2026    case sy of
            1 2027      definedsy,
            1 2028      mdefinedsy:                                 { Special macro related function }
            1 2029        begin
     2      1 2030          sy_nomacrflg := (sy = mdefinedsy);
            1 2031          INSYMBOL;                               { Gobble up the function identifier }
            1 2032          EXP_PUTINT( 0 (* , false *) );
            1 2033          if sy = lparen then INSYMBOL
            1 2034                         else SRC_ERROR( mdnam, 22, e_error );
            1 2035          if sy = identsy then
            1 2036          begin
     3      1 2037            if sy_nomacrflg and (sy_macro <> nil) then
            1 2038              case sy_macro^.idm_kind of
            1 2039                idm_macro: exp_int := 20;
            1 2040                idm_parm:  exp_int := 21;
            1 2041                idm_list:  exp_int := 22;
            1 2042                idm_temp:  exp_int := 23;
            1 2043              otherwise
     4      1 2044                exp_int := -2
     3      1 2045              end
            1 2046            else
            1 2047            begin
     4      1 2048             ip := IDE_SEARCH( false );      { Search the identifier }
            1 2049             if ip <> nil then
            1 2050               case ip^.idev_form of
            1 2051                 form_valstr: exp_int := 1;
            1 2052                 form_valint: exp_int := 2;
            1 2053                 form_valflt: if objf_lsqob in ip^.idev_flags then exp_int := 4
            1 2054                                                              else exp_int := 3;
            1 2055                 form_tabstr: exp_int := 11;
            1 2056                 form_tabint: exp_int := 12;
            1 2057                 form_tabflt: if objf_lsqob in ip^.idev_flags then exp_int := 14
            1 2058                                                              else exp_int := 13;
            1 2059               otherwise
     5      1 2060                 exp_int := -1
     4      1 2061               end
     3      1 2062            end
     2      1 2063          end
            1 2064          else exp_int := -99;
            1 2065          sy_nomacrflg := false;
            1 2066          INSYMBOL;
            1 2067          if sy <> rparen then SRC_ERROR( mdnam, 23, e_error )
            1 2068                          else INSYMBOL
     1      1 2069        end;
            1 2070  
            1 2071      identsy:
            1 2072        begin
     2      1 2073          ip := IDE_SEARCH( true );               { Search the identifier }
            1 2074          if ip = nil then EXP_PUTINT( 0 )        { When undeclared identifier push integer cte 0 }
            1 2075          else
            1 2076          with ip^ do
            1 2077            case ide_class of
            1 2078              cla_standard,
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  39
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "exp_entry".

            1 2079              cla_generic: begin
     3      1 2080                             EXP_GENERIC_CALL( ip, true ); { Call function an expression }
            1 2081                             binsymb := false
     2      1 2082                           end;
            1 2083  
            1 2084              cla_varbl,
            1 2085              cla_field:   EXP_PUT_REFER( ip );
            1 2086  
            1 2087              cla_formal: { Formal argument of a user macro function }
            1 2088                begin { Get a copy of effective parameter in the current stack }
     3      1 2089                  exp_stk[exp_stkp] := exp_stk[stkp_base - idef_efn]
     2      1 2090                end;
            1 2091  
            1 2092              cla_type: SRC_ERROR_S( mdnam, 125, e_severe, ide_name^ );
            1 2093  
            1 2094            end
     1      1 2095        end;
            1 2096  
            1 2097      intconst:    EXP_PUTINT(   sy_ival );
            1 2098      singleconst,
            1 2099      doubleconst: EXP_PUTFLT(   sy_rval );
            1 2100      stringconst: EXP_PUTSTR( sy_string );
            1 2101  
            1 2102    otherwise
     2      1 2103      SRC_ERROR( mdnam, 81, e_error )
     1      1 2104    end;
            1 2105    if debug_exp then
            1 2106    with exp_stk[exp_stkp], lst_current^ do
            1 2107    begin
     2      1 2108      WRITE( lst_file, ' Entry_push : ', exp_form, ORD( exp_form ):6, ' ' );
            1 2109      case exp_form of
            1 2110        form_valint:     WRITE( lst_file, exp_int );
            1 2111        form_valflt:     WRITE( lst_file, exp_flt );
            1 2112        form_valstr:     if exp_str <> nil then WRITE( lst_file, '"', exp_str^, '"' );
            1 2113      otherwise
            1 2114      end;
            1 2115      WRITELN( lst_file )
     1      1 2116    end;
            1 2117    if binsymb then INSYMBOL;
     0      1 2118  end EXP_ENTRY;
            1 2119  
            1 2120  
            1 2121  
            1 2122  procedure EXP_INDEX;
            1 2123  const
            1 2124    mdnam = 'EIND';
            1 2125  
            1 2126  var
            1 2127    frm: typ_form;
            1 2128  
            1 2129  begin
     1      1 2130  WRITELN( ' Start of EXP_INDEX on ', sy_sym.sy );
            1 2131    with sy_sym, exp_stk[exp_stkp] do
            1 2132    begin
     2      1 2133      if exp_asr = nil then
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  40
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "exp_index".

            1 2134      begin
     3      1 2135        SRC_ERROR( mdnam, 83, e_error );
            1 2136        SKIP_SYMBOL( rbrack )
     2      1 2137      end
            1 2138      else
            1 2139      begin
     3      1 2140        case exp_form of
            1 2141          form_tabstr: frm := form_telstr;
            1 2142          form_tabint: frm := form_telint;
            1 2143          form_tabflt: frm := form_telflt;
            1 2144        otherwise
            1 2145        end;
            1 2146        EXP_ARRAY_REF( frm );
            1 2147        if sy <> rbrack then SRC_ERROR( mdnam, 26, e_error )
            1 2148                        else INSYMBOL
     2      1 2149      end
     1      1 2150    end
            1 2151  ;WRITELN( ' End of EXP_INDEX on ', sy_sym.sy );
     0      1 2152  end EXP_INDEX;
            1 2153  
            1 2154  
            1 2155  
            1 2156  [global]
            1 2157  procedure EXPRESSION;
            1 2158  const
            1 2159    mdnam = 'EXPR';
            1 2160  
            1 2161  var
            1 2162    bi, bj:     boolean;
            1 2163    ops:        dcp_oper;
            1 2164  
            1 2165    procedure EXP_AND;
            1 2166    var
            1 2167      ops: dcp_oper;
            1 2168  
            1 2169      procedure EXP_NOT;
            1 2170      var
            1 2171        ops: dcp_oper;
            1 2172  
            1 2173        procedure EXP_REL;
            1 2174        var
            1 2175          ops: dcp_oper;
            1 2176  
            1 2177          procedure EXP_ADD;
            1 2178          var
            1 2179            ops: dcp_oper;
            1 2180  
            1 2181            procedure EXP_MUL;
            1 2182            var
            1 2183              ops: dcp_oper;
            1 2184  
            1 2185              procedure EXP_POW; 
            1 2186              var
            1 2187                ops: dcp_oper;
            1 2188  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  41
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "PRC_00000009".

            1 2189                procedure EXP_UNA;
            1 2190                var
            1 2191                  ops:  dcp_oper;
            1 2192                  bf:    boolean;
            1 2193  
            1 2194                begin { EXP_UNA }
     1      1 2195                  with sy_sym do
            1 2196                  begin
     2      1 2197                    bf := false;
            1 2198                    ops := sub_op;
            1 2199                    while (sy = addop) and ((op = sub_op) or (op = add_op)) do
            1 2200                    begin  if op = sub_op then bf := not bf; INSYMBOL   end;
            1 2201                    if bf then
            1 2202                    begin
     3      1 2203                      EXP_UNA;                    { Get the parameter }
            1 2204                      GEN_GENOPER( ops, 1 )       { Manage the unary operator }
     2      1 2205                    end
            1 2206                    else
            1 2207                    if sy = lparen then           { For exprssion between parenthesys }
            1 2208                    begin
     3      1 2209                      INSYMBOL;
            1 2210                      EXPRESSION;
            1 2211                      if sy = rparen then INSYMBOL
            1 2212                                     else SRC_ERROR( mdnam, 23, e_severe )
     2      1 2213                    end
            1 2214                    else EXP_ENTRY;               { Get the object }
            1 2215                    while sy = lbrack do EXP_INDEX
     1      1 2216                  end
     0      1 2217                end EXP_UNA;
            1 2218  
            1 2219              begin { EXP_POW }
     1      1 2220                EXP_UNA;
            1 2221                with sy_sym do
            1 2222                  if sy = powop then      { For any power class operator }
            1 2223                  begin
     2      1 2224                    ops := op;            { Save the operator }
            1 2225                    INSYMBOL;             { Gobble up it }
            1 2226                    EXP_UNA;              { Get the second operand }
            1 2227                    GEN_GENOPER( ops, 2 ) { Manage the power class operator }
     1      1 2228                  end
     0      1 2229              end EXP_POW;
            1 2230  
            1 2231            begin { EXP_MUL }
     1      1 2232              EXP_POW;
            1 2233              with sy_sym do
            1 2234              while sy = mulop do         { For any power class operator }
            1 2235              begin
     2      1 2236                ops := op;                { Save the operator }
            1 2237                INSYMBOL;                 { Gobble up it }
            1 2238                EXP_POW;                  { Get the second operand }
            1 2239                GEN_GENOPER( ops, 2 )     { Manage the multiply class operator }
     1      1 2240              end
     0      1 2241            end EXP_MUL;
            1 2242  
            1 2243          begin { EXP_ADD }
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  42
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "PRC_00000007".

     1      1 2244            EXP_MUL;
            1 2245            with sy_sym do
            1 2246            while sy = addop do          { For any power class operator }
            1 2247            begin
     2      1 2248              ops := op;                 { Save the operator }
            1 2249              INSYMBOL;                  { Gobble up it }
            1 2250              EXP_MUL;                   { Get the second operand }
            1 2251              GEN_GENOPER( ops, 2 )      { Manage the addition class operator }
     1      1 2252            end
     0      1 2253          end EXP_ADD;
            1 2254  
            1 2255        begin { EXP_REL }
     1      1 2256          EXP_ADD;
            1 2257          with sy_sym do
            1 2258          while sy = relop do
            1 2259          begin
     2      1 2260            ops := op;            { Get the definition list head }
            1 2261            INSYMBOL;
            1 2262            EXP_ADD;
            1 2263            GEN_GENOPER( ops, 2 ) { Manage the comparaizon class operator }
     1      1 2264          end
     0      1 2265        end EXP_REL;
            1 2266  
            1 2267      begin { EXP_NOT }
     1      1 2268        with sy_sym do
            1 2269          if sy = notop then
            1 2270          begin
     2      1 2271            ops := op;
            1 2272            INSYMBOL;
            1 2273            EXP_NOT;
            1 2274            GEN_GENOPER( ops, 1 ) { Manage the logical not class operator }
     1      1 2275          end
            1 2276          else EXP_REL;
     0      1 2277      end EXP_NOT;
            1 2278  
            1 2279    begin { EXP_AND }
     1      1 2280      EXP_NOT;
            1 2281      with sy_sym do
            1 2282      while sy = lgandop do
            1 2283      begin
     2      1 2284        ops := op;
            1 2285        INSYMBOL;
            1 2286        EXP_NOT;
            1 2287        GEN_GENOPER( ops, 2 )     { Manage the and class operator }
     1      1 2288      end
     0      1 2289    end EXP_AND;
            1 2290  
            1 2291  begin { EXPRESSION }
     1      1 2292    EXP_AND;
            1 2293    with sy_sym do
            1 2294    while sy = lgorop do
            1 2295    begin
     2      1 2296      ops := op;
            1 2297      INSYMBOL;
            1 2298      EXP_AND;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:41     PAGE  43
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_expr.pas".

 The Current Compiled Module is "P_expression".

            1 2299      GEN_GENOPER( ops, 2 )       { Manage the or class operator }
     1      1 2300    end;
            1 2301    if debug_exp then
            1 2302    with exp_stk[exp_stkp], lst_current^ do
            1 2303    begin
     2      1 2304      WRITE( lst_file, ' EXP : ', ORD( exp_form ), ' ' );
            1 2305      case exp_form of
            1 2306        form_valint:     WRITE( lst_file, exp_int );
            1 2307        form_valflt:     WRITE( lst_file, exp_flt );
            1 2308        form_valstr:     if exp_str <> nil then WRITE( lst_file, '"', exp_str^, '"' );
            1 2309      otherwise
            1 2310      end;
            1 2311      WRITELN( lst_file )
     1      1 2312    end
     0      1 2313  end EXPRESSION;
            1 2314  
            1 2315  
            1 2316  
            1 2317  
            1 2318  end.
            1 2319  
