  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE   1
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.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:52     PAGE   2
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.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  Interpretor   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_exec;
            1   99  
            1  100    %include        'MXDSRC:mxd_dcp_env';         { Load the MXD data Compiler Environment }
            1  101  
            1  102  
            1  103  
            1  104  
            1  105  
       C    1  106       {**************************************}
       C    1  107       { MACRO CODE GENERATION group Routines }
       C    1  108       {**************************************}
       C    1  109  
       C    1  110  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE   3
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "mxd_dcp_exec".

            1  111  [global]
            1  112  function GET_INT_VALUE( pa: idm_ptr ): integer;
            1  113  const
            1  114    mdnam = 'IVAL';
            1  115  
            1  116  var
            1  117    res: integer;
            1  118  
            1  119  begin
     1      1  120    res := 0;
            1  121    with pa^ do
            1  122    if idm_kind <> idm_parm then SRC_ERROR( mdnam, 351, e_severe )
            1  123    else
            1  124    begin
     2      1  125      ACTIVE_MACRO_CODE( pa );
            1  126      INSYMBOL;
            1  127      res := GET_INTEXPR( 0 );
            1  128      RET_OF_MACRO_CODE( pa )
     1      1  129    end;
            1  130    GET_INT_VALUE := res
     0      1  131  end GET_INT_VALUE;
            1  132  
            1  133  
            1  134  
            1  135  [global]
            1  136  function GET_FLT_VALUE( pa: idm_ptr ): mxd_flt;
            1  137  const
            1  138    mdnam = 'FVAL';
            1  139  
            1  140  var
            1  141    res: mxd_flt;
            1  142  
            1  143  begin
     1      1  144    res := 0.0;
            1  145    with pa^ do
            1  146    if idm_kind <> idm_parm then SRC_ERROR( mdnam, 352, e_severe )
            1  147    else
            1  148    begin
     2      1  149      ACTIVE_MACRO_CODE( pa );
            1  150      INSYMBOL;
            1  151      res := GET_FLTEXPR( 0.0 );
            1  152      RET_OF_MACRO_CODE( pa )
     1      1  153    end;
            1  154    GET_FLT_VALUE := res
     0      1  155  end GET_FLT_VALUE;
            1  156  
            1  157  
            1  158  
            1  159  [global]
            1  160  procedure GET_STR_VALUE( var st: string; pa: idm_ptr );
            1  161  const
            1  162    mdnam = 'SVAL';
            1  163  
            1  164  begin
     1      1  165    with pa^ do
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE   4
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "P_get_str_value".

            1  166    if idm_kind <> idm_parm then SRC_ERROR( mdnam, 353, e_severe )
            1  167    else
            1  168    begin
     2      1  169      ACTIVE_MACRO_CODE( pa );
            1  170      INSYMBOL;
            1  171      GET_STREXPR( st );
            1  172      RET_OF_MACRO_CODE( pa )
     1      1  173    end
     0      1  174  end GET_STR_VALUE;
            1  175  
            1  176  
            1  177  
            1  178  function GEN_MACRO_LIST( mcmd: symbol ): idm_apt;
            1  179  var
            1  180    p:           idm_apt;
            1  181    iv:          integer;
            1  182    sv_noexec:   boolean;
            1  183  
            1  184  begin
     1      1  185    sv_noexec    :=    sy_noexec;
            1  186    sy_noexec    :=         true;
            1  187    idm_space    :=        false;
            1  188    idm_outmacro :=         true;
            1  189    with sy_sym, src_control^ do
            1  190    if sy <> eofsy then
            1  191    begin
     2      1  192      src_insnb := src_insnb + 1;
            1  193      if sy_ch > ' ' then GEN_MACRO_CODE;
            1  194      SKIP_SYMBOL( mcmd );
            1  195      if mcmd = untilsy then
            1  196      begin
     3      1  197         INSYMBOL;
            1  198         iv := GET_INTEXPR( 1 )
     2      1  199      end;
       C    1  200      { We create a length adapted macro code array }
            1  201      if idm_newmac <> nil then
            1  202      with idm_newmac^ do
            1  203      if idm_use > 0 then
            1  204      begin
     3      1  205        NEW( p, idm_use );
            1  206        p^.idm_use := idm_use;
            1  207        for i := 1 to idm_use do  p^.idm_ctb[i] := idm_ctb[i];
            1  208        idm_use := 0
     2      1  209      end
            1  210      else p := nil;
            1  211      src_insnb := src_insnb - 1
     1      1  212    end;
            1  213    idm_outmacro := false;
            1  214    sy_noexec := sv_noexec;
            1  215    GEN_MACRO_LIST := p
     0      1  216  end GEN_MACRO_LIST;
            1  217  
            1  218  
            1  219  
            1  220  [global]
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE   5
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "mxd_dcp_exec".

            1  221  function NEW_MACRO_LIST( mcmd: symbol ): idm_ptr;
       C    1  222  { Create a unnamed macro list }
       C    1  223  { The created macro parameter is not put in the defined stack }
            1  224  var
            1  225    p: idm_ptr;
            1  226  
            1  227  begin
     1      1  228    NEW( p );
            1  229    with p^ do
            1  230    begin
     2      1  231      idm_name := nil;
            1  232      idm_parl := nil;
            1  233      idm_cntx := nil;
            1  234      idm_nxt  := nil;
            1  235      idm_kind := idm_list;
            1  236      idm_run  := false;
            1  237      idm_tab  := GEN_MACRO_LIST( mcmd )
     1      1  238    end;
            1  239    NEW_MACRO_LIST := p
     0      1  240  end NEW_MACRO_LIST;
            1  241  
            1  242  
            1  243  
            1  244  
            1  245  
       C    1  246       {************************************************}
       C    1  247       { EXECUTION MANAGER                     Routines }
       C    1  248       {************************************************}
       C    1  249  
       C    1  250  
       C    1  251  
            1  252  function  INPUT_LETTER: char;
       C    1  253  { To get a letter symbol for pragma, lattice ... }
            1  254  var
            1  255    ch: char;
            1  256  
            1  257  begin
     1      1  258    with sy_sym do
            1  259      if sy = identsy then ch := sy_ident[1]
            1  260      else
            1  261        if sy = stringconst then
            1  262          if sy_string.length > 0 then ch := sy_string[1]
            1  263                                  else ch := ' ';
       C    1  264    { Always set letter in minor case }
            1  265    if (ch >= 'A') and (ch <= 'Z') then ch := CHR( ORD( ch ) + 32 );
            1  266    INPUT_LETTER := ch
     0      1  267  end INPUT_LETTER;
            1  268  
            1  269  
            1  270  
            1  271  procedure PRAGMA_STATE( p_src: src_ptr );
            1  272  const
            1  273    mdnam = 'PRAG';
            1  274  
            1  275  type
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE   6
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "pragma_state".

            1  276    optionsty = ( opt_liston,   opt_listoff,
            1  277                  opt_echoon,   opt_echooff,
            1  278                  opt_listlvl,  opt_format,
            1  279                  opt_sh_sym,   opt_sh_exp,
            1  280                  opt_sh_mac,   opt_macsrc,
            1  281                  opt_sh_dat,
            1  282                  opt_C, opt_D, opt_E, opt_F, opt_L, opt_M, opt_P
            1  283                );
            1  284  
            1  285  var
       C    1  286    { warning this table must be modified when the identifier size is changed }
            1  287    opttab: [static] array[optionsty] of string( 15 ) := (
            1  288    'list_on',            { List on }
            1  289    'list_off',           { List off }
            1  290    'echo_on',            { Echo on }
            1  291    'echo_off',           { No echo }
            1  292    'listlvl',            { Listing source level }
            1  293    'format',             { Listing source format }
            1  294    'show_syntax',        { Listing of readen syntax unit by INSYMBOL }
            1  295    'show_expr',          { Listing of readen syntax unit by INSYMBOL }
            1  296    'show_macro',         { Listing of macro expension }
            1  297    'show_macrosrc',      { Listing of macro source at macro creation }
            1  298    'show_data',          { Listing of macro expension }
            1  299    'c', 'd', 'e', 'f', 'l', 'm', 'p' { Old supported MXD-V3 options }
            1  300    );
            1  301  
            1  302    i, ipa, iln, ierr:           integer;
            1  303    plist:                lst_ptr := nil;
            1  304    save_status:               src_flagw;
            1  305    bok, bpar, bsg, bsp:         boolean;
            1  306    ch:                             char;
            1  307    option:                    optionsty;
            1  308    sopt, fspc:               str_string;
            1  309  
            1  310  
            1  311    procedure PRAGMA_OPT_FLAG( var bflg: boolean );
            1  312    begin
     1      1  313      with sy_sym, p_src^ do
            1  314        if sy = colon then
            1  315        begin  INSYMBOL; bflg := (GET_INTEXPR( 1 ) > 0)  end
            1  316        else bflg := not bflg;
     0      1  317    end PRAGMA_OPT_FLAG;
            1  318  
            1  319  
            1  320  
            1  321  begin { PRAGMA_STATE }
     1      1  322    with sy_sym, p_src^ do
            1  323    begin
     2      1  324      bpar := (sy = lparen);                                      { Set the variable_driving(=VDM)/traditional mod
                    e }
            1  325      sy := comma;                                                { Simule a comma }
            1  326      save_status := src_flags;
            1  327      while sy = comma do                                         { Loop on all pragma specifications }
            1  328      begin
     3      1  329        bok := true;                                              { Assume option correct until shown otherwise }
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE   7
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "pragma_state".

            1  330        INSYMBOL;
            1  331        if bpar then
            1  332          GET_STREXPR( sopt )                                     { For VDM, get the option name string }
            1  333        else
            1  334        begin
     4      1  335          if (sy = stringconst) and (sy_string.length >= 1) then
            1  336            sopt := sy_string                                     { Option name is in a string }
            1  337          else if sy = identsy then
            1  338            sopt := sy_ident                                      { Option name is an identifier }
            1  339          else
            1  340          begin
     5      1  341            SRC_ERROR( mdnam, 201, e_severe );                    { Illegal pragma option form error }
            1  342            SKIP_SYMBOL( comma );                                 { Skip to next option or ";" }
            1  343            bok := false
     4      1  344          end
     3      1  345        end;
            1  346  
            1  347        if bok then                                               { When an option name can be search }
            1  348        begin
     4      1  349          bok := false;
            1  350          for popt := optionsty"first to optionsty"last do        { Option name search loop }
            1  351          begin
     5      1  352            option := popt;
            1  353            bok := (STR_MATCH( sopt, opttab[popt] ) = 0);         { Equal strings ? }
            1  354          exit if bok                                             { Stop loop when found }
     4      1  355          end
     3      1  356        end;
            1  357  
            1  358        if bok then                                               { When the option name is found }
            1  359        begin
     4      1  360          INSYMBOL;                                               { Goggle up the option name }
            1  361          if option >= opt_d then                                 { When an old MXD-V3 option is used }
            1  362          begin
     5      1  363            if bpar then                                          { For the VDLM mode, ... }
            1  364            begin
     6      1  365              if sy = colon then                                  { ... when a flag value is specified, ... }
            1  366              begin
     7      1  367                INSYMBOL; i := GET_INTEXPR( -1 );                 { ... we get this flag value and ... }
            1  368                bsp := (i >= 0); bsg := (i > 0)                   { ... set the related flags. }
     6      1  369              end
     5      1  370            end
            1  371            else if sy = addop then                               { For the traditional MXD-V3 options ... }
            1  372            begin
     6      1  373              if (op = add_op) or (op = sub_op) then              { Manage the '+'/'-' specifications }
            1  374              begin  bsp := true; bsg := (op = add_op)  end;
            1  375              INSYMBOL
     5      1  376            end
     4      1  377          end;
            1  378  
            1  379          case option of
            1  380            opt_liston: { * List_on * }
            1  381              begin
     5      1  382                if sy = colon then
            1  383                with lst_current^ do
            1  384                begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE   8
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "pragma_state".

     6      1  385                  INSYMBOL;
            1  386                  GET_STREXPR( fspc );
            1  387                  ipa := -1; iln := -1;
            1  388                  if sy = colon then
            1  389                  begin
     7      1  390                    INSYMBOL;
            1  391                    ipa := GET_INTEXPR( ipa );
            1  392                    if sy = colon then
            1  393                    begin
     8      1  394                      INSYMBOL;
            1  395                      iln := GET_INTEXPR( iln )
     7      1  396                    end
     6      1  397                  end;
       C    1  398                  { Flush output if some output line is begining }
            1  399                  if lst_currline^.length > 0 then LST_EOLN;
            1  400                  LST_OPEN( lst_current, fspc, lst_heading^,
            1  401                            lst_title^, lst_sbttl^,
            1  402                            iln,                                  { 80/132 for tty/file in char./line }
            1  403                            ipa,                                  { TTY/NO => dis./ena. page managment }
            1  404                            false,                                { New version mode }
            1  405                            false,                                { No print on close time }
            1  406                            false,                                { No append }
            1  407                            ierr );
            1  408  
            1  409                  if ierr <> 0 then
            1  410                    if not sy_init_mod then                       { If error lst -> terminal }
            1  411                      SRC_ERROR_S( mdnam, 211, e_error, fspc )
            1  412                    else
            1  413                      save_status := save_status - [src_blist]
            1  414                  else
            1  415                  begin
     7      1  416                    if src_lstmxlev < src_level then src_lstmxlev := src_level;
            1  417                    save_status := save_status + [src_blist]
     6      1  418                  end
     5      1  419                end
            1  420                else
            1  421                begin
     6      1  422                  if src_lstmxlev < src_level then src_lstmxlev := src_level;
            1  423                  save_status := save_status + [src_blist]
     5      1  424                end
     4      1  425              end;
            1  426  
            1  427            opt_listoff: save_status := save_status - [src_blist];        { * List_off * }
            1  428            opt_echoon:  save_status := save_status + [src_becho];        { * Echo_on * }
            1  429            opt_echooff: save_status := save_status - [src_becho];        { * Echo_off * }
            1  430  
            1  431            opt_listlvl: { * Listlvl * }
            1  432              if sy = colon then
            1  433              begin
     5      1  434                INSYMBOL;
            1  435                src_lstmxlev := GET_INTEXPR( 1 )
     4      1  436              end else src_lstmxlev := 1;
            1  437  
            1  438            opt_format, opt_F: { * Format * }
            1  439              if sy = colon then
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE   9
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "pragma_state".

            1  440              begin
     5      1  441                INSYMBOL; src_frspos := GET_INTEXPR( 1 );
            1  442                if sy = colon then
            1  443                begin  INSYMBOL; src_lstpos := GET_INTEXPR( str_maxsize )  end
     4      1  444              end
            1  445              else begin  src_frspos := 1; src_lstpos := 255  end;
            1  446  
            1  447            opt_sh_sym: PRAGMA_OPT_FLAG( debug_sym );             { * INSYMBOL Debug * }
            1  448            opt_sh_exp: PRAGMA_OPT_FLAG( debug_exp );             { * EXPRESSION Debug * }
            1  449            opt_sh_mac: PRAGMA_OPT_FLAG( debug_mac );             { * Macro Debug * }
            1  450            opt_sh_dat: PRAGMA_OPT_FLAG( debug_dat );             { * Macro Data Debug * }
            1  451            opt_macsrc: PRAGMA_OPT_FLAG( debug_macsrc );          { * Macro source debug * }
            1  452  
            1  453            opt_C:        debug_macsrc := bsg;                    { * To enable/disable Macro source output * }
            1  454            opt_D:        list_dataflg := bsg;                    { * To enable/disable Data Listing * }
            1  455            opt_E: if bsg then save_status := save_status + [src_becho]   { * Echo_on * }
            1  456                          else save_status := save_status - [src_becho];  { * Echo_off * }
            1  457  
            1  458            opt_L: { * MXD-V3 like 'L' option * }
            1  459              begin
     5      1  460                i := -1;
            1  461                if sy = colon then
            1  462                begin  INSYMBOL; i := GET_INTEXPR( i )  end;
            1  463                  if bsp then                                     { When an ON/OFF specification is given }
            1  464                    if bsg then begin                             { By default we set the max. level to the curren
                    t one }
     6      1  465                                  if src_lstmxlev < src_level then src_lstmxlev := src_level;
            1  466                                  save_status := save_status + [src_blist]
     5      1  467                                end
            1  468                           else save_status := save_status - [src_blist];
            1  469                  if i >= 0 then src_lstmxlev := i                { When a maximum level is specified, we set it }
     4      1  470                end;
            1  471  
            1  472            opt_M:        debug_mac := bsg;                       { * To enable/disable macro expanssion list * }
            1  473            opt_P:        debug_dat := bsg;                       { * To enable/disable Macro Data output * }
            1  474  
            1  475          otherwise { no legal option }
            1  476          end { * end of case * };
            1  477          if bpar then
            1  478            if sy = rparen then INSYMBOL
            1  479                           else SRC_ERROR( mdnam, 23, e_error )
     3      1  480        end { * if bok then * }
            1  481        else
            1  482          SRC_ERROR_S( mdnam, 202, e_warning, sopt)               { Unknown option ignored }
     2      1  483      end;
            1  484      src_flags := save_status
     1      1  485    end
     0      1  486  end PRAGMA_STATE;
            1  487  
            1  488  
            1  489  
            1  490  [global]
            1  491  procedure INCLUDE_STATE( bincl: boolean );
            1  492  const
            1  493    mdnam = 'INCL';
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  10
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "P_include_state".

            1  494  
            1  495  var
            1  496    src_p:               src_ptr;
            1  497    fname, fext:      str_string;
            1  498    i, ierr:             integer;
            1  499    fspc:             str_string;
            1  500  
            1  501  begin { INCLUDE_STATE }
     1      1  502    INSYMBOL;
            1  503    with sy_sym do
            1  504    begin
     2      1  505      GET_STREXPR( fspc );
       C    1  506      { By default of file type we set the ".cpsh" file type }
            1  507      if fspc.length > 0 then                     { We append the mxd extention only for real file }
            1  508      begin
     3      1  509        i := INDEX( fspc, '.', -1 );
            1  510        if i = 0 then fspc := fspc || '.mxd'
     2      1  511      end else WRITELN( ' No input => stdin' ); {
            1  512      end;                                        { The null file is equivalent to console }
            1  513  
            1  514      src_p := nil;                               { To force allocation by SRC_OPEN ... }
            1  515      SRC_OPEN( src_p, fspc, false, ierr);        { ... during the open of file to include }
            1  516      io_err^.int := ierr;
            1  517      if ierr = 0 { no open error } then
            1  518      begin
     3      1  519        with src_p^ do
            1  520        begin
     4      1  521          src_previous := src_control;            { Link the file to the previous src. }
            1  522          src_level := src_control^.src_level;
            1  523          if bincl then src_level := src_level + 1;
            1  524          src_lstmxlev := src_control^.src_lstmxlev;
            1  525          src_insnb := src_control^.src_insnb;
            1  526          src_frspos := src_control^.src_frspos;
            1  527          src_lstpos := src_control^.src_lstpos;
            1  528          src_flags := src_flags +
            1  529            src_control^.src_flags * [src_blist,src_bmacroex,src_bphys,
            1  530                                      src_becho,src_echerr]
     3      1  531        end;
            1  532        if sy = comma then PRAGMA_STATE( src_p ); { Look for %PRAGMA options }
            1  533  
            1  534        if bincl then SAVE_SYM_CNTX( true )
            1  535                 else SRC_END_OF_LINE;
            1  536  
            1  537        src_control := src_p;                     { Switch to new source file }
            1  538        LISTING_SET_TITLE;
            1  539        sy_ch := ' ';                             { Init the read character }
            1  540        sy    := semicolon;                       { Force to unsignificant value }
            1  541        if not bincl then                         { Chaine STATEMENT }
            1  542        begin
     4      1  543          with src_control^ do
            1  544          begin
     5      1  545            src_p := src_previous;
            1  546            src_previous := src_p^.src_previous   { Get the true previous src}
     4      1  547          end;
            1  548          SRC_CLOSE( src_p, true )                { Elliminate the old source file context }
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  11
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "P_include_state".

     3      1  549        end
     2      1  550      end else
            1  551      begin
     3      1  552        if not sy_init_mod then
            1  553          SRC_ERROR( mdnam, 212, e_severe );      { Cannot open the file }
            1  554        SKIP_SYMBOL( semicolon )
     2      1  555      end
     1      1  556    end
     0      1  557  end INCLUDE_STATE;
            1  558  
            1  559  
            1  560  
            1  561  [global]
            1  562  procedure ENDFILE_STATE;
            1  563  var
            1  564    src_p: src_ptr;
            1  565  
            1  566  begin { ENDFILE_STATE }
     1      1  567    with src_control^ do
            1  568    begin
     2      1  569      if src_previous <> nil then
            1  570      begin { Return to a previous source file }
     3      1  571        src_p := src_control;
            1  572        src_control := src_p^.src_previous;
            1  573        SRC_CLOSE( src_p, true );                 { Close end elliminate old src context }
            1  574        RESTORE_SYM_CNTX                          { Restore the context with symbol in saved varbl. }
     2      1  575      end
            1  576      else
            1  577        sy_sym.sy := eofsy                        { It is the external end of file }
     1      1  578    end;
            1  579    LISTING_SET_TITLE
     0      1  580  end ENDFILE_STATE;
            1  581  
            1  582  
            1  583  
            1  584  
            1  585  [global]
            1  586  procedure EXECUTE_MACRO_CODE( pmc: idm_ptr; stopper: symbol );
            1  587  var
            1  588    s: sym_rec;
            1  589  
            1  590  begin
     1      1  591    if pmc <> nil then
            1  592    begin
     2      1  593      s := sy_sym;
            1  594      ACTIVE_MACRO_CODE( pmc );
            1  595      STATELIST( endsy );
            1  596      RET_OF_MACRO_CODE( pmc );
            1  597      sy_sym := s;
     1      1  598    end
     0      1  599  end EXECUTE_MACRO_CODE;
            1  600  
            1  601  
            1  602  
            1  603  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  12
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "mxd_dcp_exec".

            1  604  procedure REPEAT_STATE;
            1  605  const
            1  606    mdnam = 'REAP';
            1  607  
            1  608  var
            1  609    pr: idm_rec;
            1  610    ir: integer;
            1  611    c1, c2: char;
            1  612  
            1  613  begin
     1      1  614    with sy_sym, pr do
            1  615    begin
     2      1  616      idm_name := nil;
            1  617      idm_parl := nil;
            1  618      idm_nxt  := nil;
            1  619      idm_prv  := nil;
            1  620      idm_kind := idm_list;
            1  621      idm_run  := false;
            1  622      sy       := nothing;                        { To force to ignore the present repeat }
            1  623      idm_tab  := GEN_MACRO_LIST( untilsy );
            1  624      idm_cntx := idm_actstk;
            1  625      c1 := sy_ch; c2 := sy_cmin;
            1  626      if sy <> eofsy then
            1  627      begin
     3      1  628        repeat
     4      1  629          idm_actstk := pr"address;
            1  630          idm_run    := true;
            1  631          sy_ch := ' ';
            1  632          idm_nch := 1;                           { Exec from the begining }
            1  633          STATELIST( untilsy );
            1  634          INSYMBOL;
            1  635          ir := GET_INTEXPR( 1 )
     3      1  636        until ir > 0
     2      1  637      end
            1  638      else
            1  639        SRC_ERROR( mdnam, 303, e_severe );
       C    1  640      { Restore the previous context }
            1  641      sy_ch := c1; sy_cmin := c2;
            1  642      sy := semicolon;
            1  643      idm_actstk := idm_cntx;
            1  644      DISPOSE( idm_tab )
     1      1  645    end
     0      1  646  end REPEAT_STATE;
            1  647  
            1  648  
            1  649  
            1  650  procedure WHILE_STATE;
            1  651  const
            1  652    mdnam = 'WHIL';
            1  653  
            1  654  var
            1  655    pr:          idm_rec;
            1  656    ir:          integer;
            1  657    c1, c2:         char;
            1  658    wex:         idm_ptr;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  13
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "while_state".

            1  659  
            1  660  begin
     1      1  661    with sy_sym, pr do
            1  662    begin
     2      1  663      wex := NEW_MACRO_EXPR;
            1  664      if sy <> dosy then SRC_ERROR( mdnam, 120, e_error );
            1  665      idm_name := nil;
            1  666      idm_parl := nil;
            1  667      idm_nxt  := nil;
            1  668      idm_prv  := nil;
            1  669      idm_run  := false;
            1  670      idm_kind := idm_list;
            1  671      idm_tab  := GEN_MACRO_LIST( endsy );
            1  672      idm_cntx := idm_actstk;
            1  673      c1 := sy_ch; c2 := sy_cmin;
            1  674      if sy <> eofsy then
            1  675        while GET_INT_VALUE( wex ) > 0 do
            1  676        begin
     3      1  677          idm_actstk := pr"address;
            1  678          idm_run    := true;
            1  679          sy_ch := ' ';
            1  680          idm_nch := 1;                           { Exec from the begining }
            1  681          STATELIST( endsy );
            1  682          INSYMBOL
     2      1  683        end
            1  684      else
            1  685        SRC_ERROR( mdnam, 303, e_severe );
       C    1  686      { Restore the previous context }
            1  687      idm_actstk := idm_cntx;
            1  688      sy_ch := c1; sy_cmin := c2;
            1  689      INSYMBOL;
            1  690      DISPOSE( idm_tab );
            1  691      PURGE_MACRO_EXPR( wex )
     1      1  692    end
     0      1  693  end WHILE_STATE;
            1  694  
            1  695  
            1  696  
            1  697  procedure FOR_STATE;
            1  698  const
            1  699    mdnam = 'FORL';
            1  700  
            1  701  var
            1  702    pr:          idm_rec;
            1  703    ir, id, ie:  integer;
            1  704    c1, c2:         char;
            1  705    ip:          ide_ptr;
            1  706  
            1  707  begin
     1      1  708    INSYMBOL;
            1  709    with sy_sym, pr do
            1  710    if sy = identsy then
            1  711    begin
     2      1  712      DISPLAY_NEW;
            1  713      ip := IDE_NEW( cla_varbl, form_valint, curr_disp );
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  14
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "for_state".

            1  714      if ip <> nil then
            1  715      with ip^ do
            1  716      begin
     3      1  717        INSYMBOL;
            1  718        if sy = becomes then INSYMBOL
            1  719                        else SRC_ERROR( mdnam, 32, e_error );
            1  720        id := GET_INTEXPR( 1 );
            1  721        case sy of
            1  722              tosy: begin  ir :=  1; INSYMBOL  end;
            1  723          downtosy: begin  ir := -1; INSYMBOL  end;
            1  724        otherwise
     4      1  725          SRC_ERROR( mdnam, 119, e_error )
     3      1  726        end;
            1  727        ie := GET_INTEXPR( id );
            1  728        if sy <> dosy then SRC_ERROR( mdnam, 120, e_error );
            1  729        if ir > 0 then ie := ie - id + 1
            1  730                  else ie := id - ie + 1;
            1  731        int := id;
            1  732  
            1  733        idm_name := nil;
            1  734        idm_parl := nil;
            1  735        idm_nxt  := nil;
            1  736        idm_prv  := nil;
            1  737        idm_run  := false;
            1  738        idm_kind := idm_list;
            1  739        idm_tab  := GEN_MACRO_LIST( endsy );
            1  740        idm_cntx := idm_actstk;
            1  741        c1 := sy_ch; c2 := sy_cmin;
            1  742        if sy <> eofsy then
            1  743        for ii := 1 to ie do
            1  744        begin
     4      1  745          idm_actstk := pr"address;
            1  746          idm_run    := true;
            1  747          sy_ch := ' ';
            1  748          idm_nch := 1;                           { Exec from the begining }
            1  749          STATELIST( endsy );
            1  750          int := int + ir
     3      1  751        end
            1  752        else
            1  753          SRC_ERROR( mdnam, 303, e_severe );
       C    1  754        { Restore the previous context }
            1  755        idm_actstk := idm_cntx;
            1  756        sy_ch := c1; sy_cmin := c2;
            1  757        INSYMBOL;
            1  758        DISPOSE( idm_tab )
     2      1  759      end
            1  760      else
            1  761      begin
     3      1  762        SKIP_SYMBOL( endsy );
            1  763        INSYMBOL
     2      1  764      end;
            1  765      DISPLAY_FREE
     1      1  766    end
            1  767    else
            1  768    begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  15
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "for_state".

     2      1  769      SRC_ERROR( mdnam, 102, e_severe );
            1  770      SKIP_SYMBOL( endsy );
            1  771      INSYMBOL
     1      1  772    end
     0      1  773  end FOR_STATE;
            1  774  
            1  775  
            1  776  
            1  777  [global]
            1  778  procedure GEN_MACRO_BODY;
       C    1  779  { Common part to create a Macro statment/function (identifier is in sy_ident) }
            1  780  const
            1  781    mdnam = 'MACB';
            1  782  
            1  783  var
            1  784    pm, pp, psv, ph, pl: idm_ptr;
            1  785    bfnc:       boolean := false;
            1  786  
            1  787  begin
     1      1  788    with sy_sym do
            1  789    begin
     2      1  790      pm := SEARCH_MACRO( idm_macro );
            1  791      if pm <> nil then
            1  792      begin { Cannot create two macros with the same name }
     3      1  793        SRC_ERROR_S( mdnam, 305, e_severe, sy_ident );
            1  794        SKIP_SYMBOL( endsy ); INSYMBOL;
            1  795        pm := nil
     2      1  796      end
            1  797      else
            1  798      begin
     3      1  799        NEW( pm );
            1  800        with pm^ do
            1  801        begin
     4      1  802          NEW( idm_name, sy_ident.length );
            1  803          idm_name^ := sy_ident;
            1  804          idm_cntx  := nil;
            1  805          idm_nxt   := nil;
            1  806          idm_prv   := idm_defstk;
            1  807          idm_run   := false;
            1  808          idm_kind  := idm_macro;
            1  809          idm_parl  := nil;
            1  810          idm_nch   := 0;
            1  811          INSYMBOL;                             { Skip in parameter list }
       C    1  812          { Mask all present macro definition }
            1  813          ph := nil;
            1  814          pl := nil;
            1  815          idm_defstk := nil;
            1  816          if sy <> semicolon then
            1  817          begin
     5      1  818            if sy = lparen then begin  INSYMBOL; bfnc := true  end;
            1  819            while sy = identsy do
            1  820            begin
     6      1  821              pp := SEARCH_MACRO( idm_parm );
            1  822              if pp = nil then
            1  823              begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  16
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "P_gen_macro_body".

     7      1  824                NEW( pp );
            1  825                if pl = nil then ph := pp
            1  826                            else pl^.idm_parl := pp;
            1  827                with pp^ do
            1  828                begin
     8      1  829                  NEW( idm_name, sy_ident.length );
            1  830                  idm_name^ := sy_ident;
            1  831                  idm_parl  := nil;
            1  832                  idm_cntx  := nil;
            1  833                  idm_nxt   := nil;
            1  834                  idm_prv   :=  pl;
            1  835                  idm_run   := false;
            1  836                  idm_kind  := idm_parm;
            1  837                  idm_nch   :=   0;
            1  838                  idm_tab   := nil
     7      1  839                end;
            1  840                pl := pp
     6      1  841              end
            1  842              else SRC_ERROR_S( mdnam, 306, e_severe, sy_ident );
            1  843              INSYMBOL;
            1  844            exit if sy <> comma;
            1  845              INSYMBOL
     5      1  846            end;
            1  847            if bfnc then
            1  848              if sy = rparen then INSYMBOL
            1  849                             else SRC_ERROR( mdnam, 34, e_error );
            1  850            if sy <> semicolon then  SRC_ERROR( mdnam, 21, e_error )
     4      1  851          end;
            1  852          idm_parl := ph;                         { Attach the parameter list to the macro bloc }
            1  853          idm_defstk := idm_prv;                  { Restore the previous macro def. context }
       C    1  854          { Get the macro text }
            1  855          idm_tab := GEN_MACRO_LIST( endmacrosy );
       C    1  856          { Set the macro in the macro def. symbol list }
            1  857          if idm_defstk <> nil then idm_defstk^.idm_nxt := pm;
            1  858          idm_defstk := pm;
            1  859          INSYMBOL
     3      1  860        end
     2      1  861      end
     1      1  862    end
     0      1  863  end GEN_MACRO_BODY;
            1  864  
            1  865  
            1  866  
            1  867  procedure MACRO_STATE;
            1  868  const
            1  869    mdnam = 'MACR';
            1  870  
            1  871  var
            1  872    pm, pp, psv, ph, pl: idm_ptr;
            1  873  
            1  874  begin
     1      1  875    with sy_sym do
            1  876    begin
     2      1  877      INSYMBOL;
            1  878      if sy <> identsy then
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  17
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "macro_state".

            1  879      begin
     3      1  880        SRC_ERROR( mdnam, 304, e_severe );
            1  881        SKIP_SYMBOL( endsy ); INSYMBOL
     2      1  882      end
            1  883      else GEN_MACRO_BODY
     1      1  884    end
     0      1  885  end MACRO_STATE;
            1  886  
            1  887  
            1  888  
            1  889  procedure MACLOAD_STATE;
       C    1  890  { Get a list of macro from the current macro lirary }
       C    1  891  { 64 macro names maximum for one call }
            1  892  const
            1  893    mdnam = 'MCAL';
            1  894  
            1  895  var
            1  896    pm:                          idm_ptr;
            1  897    p0, p1:                      stq_ptr;
            1  898    src_p:                       src_ptr;
            1  899    er, i, j, k:                 integer;
            1  900    mlst: [static] array[1..64] of ide_string;
            1  901    fnd, sv_noexec, sv_nomacrf:  boolean;
            1  902  
            1  903  begin
     1      1  904    with sy_sym do
            1  905    begin
     2      1  906      i := 0;
            1  907      sy := comma;
            1  908      while (sy = comma) and (i < 64) do          { We store all the name of the list }
            1  909      begin
     3      1  910        INSYMBOL;                                 { Gobble up MACROLIB keyword or "," }
            1  911        fnd := false;
            1  912        pm  := SEARCH_MACRO( idm_macro );         { Search this identifier in the macro list }
            1  913        if pm <> nil then                         { When this macro is already defined  ... }
            1  914          SRC_ERROR_S( mdnam, 311, e_warning, sy_ident )  { ... we emit a warning and ignore this entry }
            1  915        else
            1  916        begin                                     { Put this macro identifier in the search list }
     4      1  917          i := i + 1;
            1  918          mlst[i] := sy_ident;
            1  919          INSYMBOL                                { Skip to the separator }
     3      1  920        end
     2      1  921      end;
       C    1  922      { Check for no macro list overflow }
            1  923      if (sy = comma) and (i >= 64) then SRC_ERROR( mdnam, 312, e_error );
            1  924  
       C    1  925      { Set the status for MACRO READ INSYMBOL Call }
       C    1  926  
            1  927      sv_nomacrf     :=     sy_nomacrflg;
            1  928      sv_noexec      :=        sy_noexec;
            1  929      SAVE_SYM_CNTX( true );                              { Save the Symbol context }
            1  930  
            1  931      j := 0; 
            1  932      p1 := idm_liblifo;                                  { Start from the last Macro library specification }
            1  933      while (j < i) and (p1 <> nil) do                    { Loop on all Macro library specification until load all
                     specified macro(s) }
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  18
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "macload_state".

            1  934      begin
     3      1  935        src_p := nil;                                     { To force allocation by SRC_OPEN of a new source contro
                    l block }
            1  936        SRC_OPEN( src_p, p1^.stq_str^, false, er );       { ... during the open of file to read }
            1  937        if er <> 0 then
            1  938        begin
     4      1  939          SRC_ERROR_S( mdnam, 315, e_fatal, p1^.stq_str^ );
            1  940          exit
     3      1  941        end;
            1  942        with src_p^ do
            1  943        begin
     4      1  944          src_previous := src_control;
            1  945          src_level := src_control^.src_level + 1;
            1  946          src_lstmxlev := src_control^.src_lstmxlev;
            1  947          src_insnb := src_control^.src_insnb;
       C    1  948  (*     src_flags := src_flags +
       C    1  949            src_control^.src_flags * [src_bmacroex,src_bphys,
       C    1  950                                      src_becho,src_echerr] *)
     3      1  951        end;
            1  952        src_control := src_p;
            1  953        sy_ch     := ' ';
            1  954        sy_maclst :=  '';
            1  955        sy  :=   nothing;
            1  956        LISTING_SET_TITLE;
            1  957  
            1  958        while (j < i) and (sy <> macrosy) and (sy <> peofsy) do
            1  959        begin
       C    1  960         { Search a macro statement }
     4      1  961          while (sy <> macrosy) and (sy <> peofsy) and (sy <> eofsy) do INSYMBOL;
            1  962          if sy = macrosy then
            1  963          begin
     5      1  964            INSYMBOL;
            1  965            k := 0; fnd := false;
            1  966            while not fnd and (k < i) do
            1  967            begin
     6      1  968              k := k + 1;
            1  969              if STR_MATCH( mlst[k], sy_ident ) = 0 then fnd := true
     5      1  970            end;
            1  971            if not fnd then SKIP_SYMBOL( endmacrosy )
            1  972                       else begin  GEN_MACRO_BODY; mlst[k].length := 0; j := j + 1  end
     4      1  973          end
     3      1  974        end;
            1  975        src_control := src_p^.src_previous;
            1  976        SRC_CLOSE( src_p, true );         { Close the MACROLIB file and free the control when it is the last one }
            1  977        p1 := p1^.stq_lnk
     2      1  978      end;
            1  979  
            1  980      RESTORE_SYM_CNTX;                   { Restore the symbol context }
            1  981      sy_noexec     :=         sv_noexec; { Restore the original macro status }
            1  982      sy_nomacrflg  :=        sv_nomacrf;
            1  983      LISTING_SET_TITLE
     1      1  984   end
     0      1  985  end MACLOAD_STATE;
            1  986  
            1  987  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  19
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "mxd_dcp_exec".

            1  988  
            1  989  procedure MACLIBR_STATE;
            1  990  const
            1  991    mdnam = 'MACL';
            1  992  
            1  993  [static] var
            1  994    pq:          stq_ptr;
            1  995    fnam, fspc:  string;
            1  996    i, j:        integer;
            1  997    fnd:         boolean;
            1  998  
            1  999  begin
     1      1 1000    with sy_sym do
            1 1001    begin
     2      1 1002      INSYMBOL;                            { Gobble up the MACROLIB Keyword }
            1 1003      fnam.length := 0;
            1 1004      GET_STREXPR( fnam );                 { Get the macro library file specification }
            1 1005      if fnam.length > 0 then
            1 1006      begin
     3      1 1007        i := INDEX( fnam, '.', -1 );
            1 1008        if i > 0 then
            1 1009        begin
     4      1 1010          if INDEX( fnam, '/', -1 ) > i then i := 0;
            1 1011          if (i > 0) and (INDEX( fnam, '\', -1 ) > i) then i := 0;
            1 1012          if (i > 0) and (INDEX( fnam, ':', -1 ) > i) then i := 0
     3      1 1013        end;
            1 1014        if i = 0 then fnam := fnam||'.mxl';
            1 1015        SEARCH_FILE( mxd_search_path, fnam, 4 { Read Access }, fspc, fnd );
            1 1016        if fnd then
            1 1017        begin { When a not null string was specified }
     4      1 1018          NEW( pq );                       { Create a new macrolib specification }
            1 1019          with pq^ do
            1 1020          begin
     5      1 1021            stq_lnk := idm_liblifo;        { Push this specification in the Macro Library FiFo }
            1 1022            idm_liblifo := pq;
            1 1023            NEW( stq_str, fspc.length );   { ... and set this file specification in the new FiFo entry }
            1 1024            stq_str^ := fspc
     4      1 1025          end
     3      1 1026        end
            1 1027        else
            1 1028          SRC_ERROR_S( mdnam, 310, e_error, fnam )
     2      1 1029      end
            1 1030      else
            1 1031        if idm_liblifo <> nil then
            1 1032        begin
     3      1 1033          pq := idm_liblifo;
            1 1034          idm_liblifo := pq^.stq_lnk;
            1 1035          DISPOSE( pq )
     2      1 1036        end
     1      1 1037    end
     0      1 1038  end MACLIBR_STATE;
            1 1039  
            1 1040  
            1 1041  
            1 1042  procedure PURGE_STATE;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  20
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "purge_state".

            1 1043  const
            1 1044    mdnam = 'PRGM';
            1 1045  
            1 1046  var
            1 1047    pm, pp: idm_ptr;
            1 1048  
            1 1049  begin
     1      1 1050    with sy_sym do
            1 1051    loop
     2      1 1052      INSYMBOL;
            1 1053    exit if (sy = semicolon) or (sy = eofsy) or
            1 1054            (sy = endsy) or (sy = untilsy);
            1 1055      if sy = identsy then
            1 1056      begin
     3      1 1057        pm := SEARCH_MACRO( idm_macro );
            1 1058        if pm = nil then SRC_ERROR_S( mdnam, 307, e_error, sy_ident )
            1 1059        else
            1 1060        begin
     4      1 1061          with pm^ do
       C    1 1062          { Check of do not purge an active macro }
            1 1063          if idm_run then SRC_ERROR_S( mdnam, 308, e_severe, sy_ident )
            1 1064          else
            1 1065          begin
       C    1 1066            { Supress the macro of the macro definition list }
     5      1 1067            if idm_nxt = nil then idm_defstk := idm_prv           { Last in the macro list }
            1 1068                             else idm_nxt^.idm_prv := idm_prv;    { Not first in the macro list }
            1 1069            if idm_prv <> nil then idm_prv^.idm_nxt := idm_nxt;
            1 1070  
       C    1 1071            { Free the identifier name }
            1 1072            DISPOSE( idm_name );
            1 1073            while idm_parl <> nil do
            1 1074            begin
     6      1 1075              pp := idm_parl;
            1 1076              idm_parl := idm_parl^.idm_parl;
            1 1077              with pp^ do
            1 1078              begin
     7      1 1079                DISPOSE( idm_name );
            1 1080                if idm_tab <> nil then DISPOSE( idm_tab )
     6      1 1081              end;
            1 1082              DISPOSE( pp )
     5      1 1083            end;
       C    1 1084            { Free the code }
            1 1085            if idm_tab <> nil then DISPOSE( idm_tab )
     4      1 1086          end;
            1 1087          DISPOSE( pm )
     3      1 1088        end
     2      1 1089      end
            1 1090      else SRC_ERROR( mdnam, 309, e_error );
            1 1091      INSYMBOL;
            1 1092      if sy <> comma then SRC_ERROR( mdnam, 37, e_error )
     1      1 1093    end
     0      1 1094  end PURGE_STATE;
            1 1095  
            1 1096  
            1 1097  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  21
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "mxd_dcp_exec".

            1 1098  procedure CALL_MACRO;
            1 1099  const
            1 1100    mdnam = 'CALM';
            1 1101  
            1 1102  var
            1 1103    pm, pp, pa, pc: idm_ptr;
            1 1104    svch, svcm: char;
            1 1105  
            1 1106  begin
     1      1 1107    with sy_sym, lst_current^ do
            1 1108    begin
     2      1 1109      pm := sy_macro;
            1 1110      with pm^ do
            1 1111      begin { It is a defined macro }
       C    1 1112        { Set all formal of macro as defined with the given effective values }
     3      1 1113        pp := idm_parl;
            1 1114        pa := nil;
            1 1115        while pp <> nil do
            1 1116        with pp^ do
            1 1117        begin
       C    1 1118          { Get the effective parameter value }
     4      1 1119          GENERATE_MACRO_PARM( pp, false, ' ' );
            1 1120          if debug_macsrc then
            1 1121          with pp^do
            1 1122          begin
     5      1 1123            WRITELN( lst_file, ' Macro Parm "', idm_name^, '" :' );
            1 1124            WRITE( lst_file, ' ' );
            1 1125            if idm_tab <> nil then
            1 1126            with idm_tab^do
            1 1127              for ij := 1 to idm_use do WRITE( lst_file, idm_ctb[ij] )
            1 1128            else WRITE( lst_file, '.nil.') ;
            1 1129            WRITELN( lst_file )
     4      1 1130          end;
            1 1131          pa := pp;
            1 1132        exit if sy <> comma;
            1 1133          pp := idm_parl
     3      1 1134        end;
       C    1 1135        { Link the parameter string to the pmacro stack }
            1 1136        pp := idm_parl;
            1 1137        if pp <> nil then
            1 1138        begin
     4      1 1139          idm_defstk^.idm_nxt := pp;
            1 1140          pp^.idm_prv := idm_defstk;
            1 1141          idm_defstk  := pa
     3      1 1142        end;
            1 1143        if debug_macsrc then
            1 1144        begin
     4      1 1145          WRITELN( lst_file, ' Macro Stack include :' );
            1 1146          pc := idm_defstk;
            1 1147          while pc <> nil do
            1 1148          begin
     5      1 1149            WRITELN( lst_file, ' ::: "', pc^.idm_name^, '",' );
            1 1150            pc := pc^.idm_prv
     4      1 1151          end;
            1 1152          WRITELN( lst_file, ' Macro Code of "', idm_name^, '" :' );
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  22
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "call_macro".

            1 1153          WRITE( lst_file, ' "' );
            1 1154          with idm_tab^do
            1 1155            for ij := 1 to idm_use do WRITE( lst_file, idm_ctb[ij] );
            1 1156          WRITELN( lst_file, '"' )
     3      1 1157        end;
            1 1158  
            1 1159        ACTIVE_MACRO_CODE( pm, true );
            1 1160        STATELIST( endmacrosy );
            1 1161        RET_OF_MACRO_CODE( pm );
            1 1162  
       C    1 1163        { Unlink the macro parameters }
            1 1164        if pp <> nil then
            1 1165        with pp^ do
            1 1166        begin
     4      1 1167          idm_prv^.idm_nxt := pa^.idm_nxt;
            1 1168          if pa^.idm_nxt <> nil then pa^.idm_nxt^.idm_prv := idm_prv
            1 1169                                else idm_defstk := idm_prv
     3      1 1170        end;
            1 1171        while pp <> nil do
            1 1172        with pp^ do
            1 1173        begin
     4      1 1174          if idm_tab <> nil then begin
     5      1 1175                                   DISPOSE( idm_tab );
            1 1176                                   idm_tab := nil
     4      1 1177                                 end;
            1 1178          idm_nch  := 0;
            1 1179          pp := idm_parl
     3      1 1180        end;
     2      1 1181      end
     1      1 1182    end
     0      1 1183  end CALL_MACRO;
            1 1184  
            1 1185  
            1 1186  
            1 1187  procedure CREATE_NEW_ARR( var p: asr_ptr; var typ: typ_form; var sz: integer; td: asr_ptr := nil );
       C    1 1188  { Procedure to create array dimension structures.
       C    1 1189    It is a recursive procedure to manage all array dimension 
       C    1 1190    Description :
       C    1 1191      Allocate a new Array descriptor (p is the returned address of this descriptor).
       C    1 1192      Fill this descriptor array size with the source specified value (all array start from index 1).
       C    1 1193      When a comma is found (multi-dimension array) make a recurcsive call and compute the total dimension
       C    1 1194                            for
       C    1 1195      otherwise, for the last index,
       C    1 1196          if td is specified (an array descriptor pointer of the element type) link it with the current
       C    1 1197                             descriptor and compute the related total dimension
       C    1 1198          else it is the last index. Set the dimension of array to number of scalar elements.
       C    1 1199  }
       C    1 1200  
            1 1201  const
            1 1202    mdnam = 'ARCR';
            1 1203  
            1 1204  var
            1 1205    e_frm: typ_form := form_null;
            1 1206  
            1 1207  begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  23
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "create_new_arr".

     1      1 1208    INSYMBOL;                                     { Gobble up "," or "[" }
            1 1209    NEW( p );
            1 1210    with sy_sym, p^ do
            1 1211    begin
     2      1 1212      asr_siz := GET_INTEXPR( 0 );                { Get the required array dimension }
            1 1213      if sy = twodot then
            1 1214      begin
     3      1 1215        asr_min := asr_siz;
            1 1216        INSYMBOL;
            1 1217        asr_siz := GET_INTEXPR( 0 ) - asr_min + 1
     2      1 1218      end else asr_min := 1;
            1 1219  
            1 1220      asr_fix := (td <> nil);                     { The dimension can be changed when no new type are specified }
            1 1221      if asr_siz <= 0 then
            1 1222      begin  SRC_ERROR( mdnam, 75, e_severe ); asr_siz := 1  end;
            1 1223      if sy = comma then
            1 1224        CREATE_NEW_ARR( asr_sub, e_frm, asr_stp, td )
            1 1225      else
            1 1226      begin
     3      1 1227        asr_sub := td;
            1 1228        if td <> nil then asr_stp := td^.asr_siz*td^.asr_stp
            1 1229                     else asr_stp := 1
     2      1 1230      end;
            1 1231      sz := asr_stp*asr_siz
     1      1 1232    end;
            1 1233    case typ of
            1 1234      form_valstr: typ := form_tabstr;
            1 1235      form_valint: typ := form_tabint;
            1 1236      form_valflt: typ := form_tabflt;
            1 1237    otherwise
            1 1238    end;
            1 1239    if sy_sym.sy = rbrack then INSYMBOL
            1 1240                          else SRC_ERROR( mdnam, 26, e_error )
     0      1 1241  end CREATE_NEW_ARR;
            1 1242  
            1 1243  
            1 1244  
            1 1245  procedure DECLARE_NEW_IDENT( idet: ide_ptr; btyp: boolean := false );
       C    1 1246  { Create a new identifier when specified with the idet^ type.
       C    1 1247    When btyp, the created identifier will be a type identifier.
       C    1 1248  }
            1 1249  const
            1 1250    mdnam = 'DCLI';
            1 1251  
            1 1252  var
            1 1253    typ:                        typ_form;
            1 1254    p, p1:                       ide_ptr;
            1 1255    pdm:                         asr_ptr;
            1 1256    s:                        str_string;
            1 1257    ival, ilvl, isz, idim:       integer;
            1 1258    rval:                        mxd_flt;
            1 1259  
            1 1260  begin
     1      1 1261    typ := idet^.idet_form;
            1 1262    with sy_sym do
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  24
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "declare_new_ident".

            1 1263    begin
     2      1 1264      repeat
     3      1 1265        INSYMBOL;                                                 { Gobble up the separator or keyword }
            1 1266        if sy = intconst then
            1 1267        begin                                                     { When a target display level is specified, we u
                    se it ... }
     4      1 1268          ilvl := sy_ival;
            1 1269          if ilvl <= 0 then ilvl := 1
            1 1270                       else if ilvl > curr_disp then ilvl := curr_disp;
            1 1271          INSYMBOL
     3      1 1272        end else ilvl := curr_disp;                               { ... else we use the current display level to c
                    reate the identifier }
            1 1273  
            1 1274        if sy = identsy then
            1 1275        begin
     4      1 1276          if btyp then
            1 1277          begin
     5      1 1278            p := IDE_NEW( cla_type, typ, ilvl );  { Create the new identifier as a type }
            1 1279            INSYMBOL;                             { Gobble up the identifier }
            1 1280            with p^ do
            1 1281            begin
     6      1 1282              idet_typ    :=                idet; { Set the type identifier pointer link }
            1 1283              idet_form   :=                 typ; { Copie the internal representation model }
            1 1284              idet_flags  :=    idet^.idet_flags + [objf_lockd]; { Copy the type flags but force the locked size a
                    ttribute }
            1 1285              idet_spcact :=   idet^.idet_spcact; { Copy the specific action index }
            1 1286              if sy = lbrack then
            1 1287                CREATE_NEW_ARR( idet_asr,idet_form, isz, idet^.idet_asr ) { Create the array description records }
            1 1288              else
            1 1289              begin
     7      1 1290                idet_asr := idet^.idet_asr;
            1 1291                if idet_asr <> nil then with idet_asr^ do isz := asr_siz*asr_stp
            1 1292                                   else isz := 1  { Get the "array" size for any type }
     6      1 1293              end
     5      1 1294            end
     4      1 1295          end
            1 1296          else
            1 1297          begin
     5      1 1298            p := IDE_NEW( cla_varbl, typ, ilvl ); { Create the new identifier as a variable }
            1 1299            INSYMBOL;                             { Gobble up the identifier }
            1 1300            with p^ do
            1 1301            begin
     6      1 1302              idev_typ    :=                idet; { Set the type identifier pointer link }
            1 1303              idev_form   :=                 typ; { Copie the internal representation model }
            1 1304              idev_flags  :=    idet^.idet_flags; { Copy the type flags }
            1 1305              idev_spcact :=   idet^.idet_spcact; { Copy the specific action index }
            1 1306              if sy = lbrack then
            1 1307                CREATE_NEW_ARR( idev_asr,idev_form, isz, idet^.idet_asr ) { Create the array description records }
            1 1308              else
            1 1309              begin
     7      1 1310                idev_asr := idet^.idet_asr;
            1 1311                idev_flags := idev_flags + [objf_lockd];
            1 1312                if idev_asr <> nil then with idev_asr^ do isz := asr_siz*asr_stp
            1 1313                                   else isz := 1  { Get the "array" size for any type }
     6      1 1314              end;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  25
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "declare_new_ident".

            1 1315  
       C    1 1316              { * Allocate memory of adapted type element of array * }
            1 1317              case idev_form of
            1 1318                form_tabstr:
            1 1319                  begin
     7      1 1320                    NEW( aas, isz );
            1 1321                    with aas^ do
            1 1322                      for ii := 1 to isz do  ide_stb[ii] := nil
     6      1 1323                  end;
            1 1324                form_tabint:
            1 1325                  begin
     7      1 1326                    NEW( aai, isz );
            1 1327                    with aai^ do
            1 1328                      for ii := 1 to isz do  ide_itb[ii] :=   0
     6      1 1329                  end;
            1 1330                form_tabflt:
            1 1331                  begin
     7      1 1332                    NEW( aaf, isz );
            1 1333                    with aaf^ do
            1 1334                      for ii := 1 to isz do  ide_ftb[ii] := 0.0
     6      1 1335                  end;
            1 1336              otherwise
            1 1337              end;
            1 1338              if objf_spdef in idev_flags then
            1 1339                DEFINE_SPECIFIC( p )                              { Define a special object }
            1 1340              else
            1 1341              if sy = becomes then                                { An initial value can be specified }
            1 1342              begin
     7      1 1343                INSYMBOL;
            1 1344                case idev_form of
            1 1345                  form_valint:  int := GET_INTEXPR( 0 );
            1 1346                  form_valflt:  flt := GET_FLTEXPR( 0.0 );
            1 1347                  form_valstr:  begin 
     8      1 1348                                  GET_STREXPR( s );
            1 1349                                  if s.length > 0 then
            1 1350                                  begin  NEW( str, s.length ); str^ := s  end
            1 1351                                  else str := nil
     7      1 1352                                end;
            1 1353                  form_tabint:  with aai^ do
            1 1354                                if sy = lparen then
            1 1355                                begin
     8      1 1356                                  sy := comma;
            1 1357                                  for ii := 1 to ide_all do
            1 1358                                  begin
     9      1 1359                                    if sy = comma then INSYMBOL
            1 1360                                                  else SRC_ERROR( mdnam, 29, e_error );
            1 1361                                    ide_itb[ii] := GET_INTEXPR( 0 )
     8      1 1362                                  end;
            1 1363                                  if  sy = rparen then INSYMBOL
            1 1364                                                  else SRC_ERROR( mdnam, 23, e_error )
     7      1 1365                                end
            1 1366                                else
            1 1367                                begin
     8      1 1368                                  ival := GET_INTEXPR( 0 );
            1 1369                                  for ii := 1 to ide_all do ide_itb[ii] := ival
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  26
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "declare_new_ident".

     7      1 1370                                end;
            1 1371                  form_tabflt:  with aaf^ do
            1 1372                                if sy = lparen then
            1 1373                                begin
     8      1 1374                                  sy := comma;
            1 1375                                  for ii := 1 to ide_all do
            1 1376                                  begin
     9      1 1377                                    if sy = comma then INSYMBOL
            1 1378                                                  else SRC_ERROR( mdnam, 29, e_error );
            1 1379                                    ide_ftb[ii] := GET_FLTEXPR( 0.0 )
     8      1 1380                                  end;
            1 1381                                  if sy = rparen then INSYMBOL
            1 1382                                                 else SRC_ERROR( mdnam, 23, e_error )
     7      1 1383                                end
            1 1384                                else
            1 1385                                begin
     8      1 1386                                  rval := GET_FLTEXPR( 0.0 );
            1 1387                                  for ii := 1 to ide_all do ide_ftb[ii] := rval
     7      1 1388                                end;
            1 1389                  form_tabstr:  with aas^ do
            1 1390                                if sy = lparen then
            1 1391                                begin
     8      1 1392                                  sy := comma;
            1 1393                                  for ii := 1 to ide_all do
            1 1394                                  begin
     9      1 1395                                    if sy = comma then INSYMBOL
            1 1396                                                  else SRC_ERROR( mdnam, 29, e_error );
            1 1397                                    GET_STREXPR( s );
            1 1398                                    if s.length > 0 then
            1 1399                                    begin
    10      1 1400                                      NEW( ide_stb[ii], s.length );
            1 1401                                      ide_stb[ii]^ := s
     9      1 1402                                    end
     8      1 1403                                  end;
            1 1404                                  if  sy = rparen then INSYMBOL
            1 1405                                                  else SRC_ERROR( mdnam, 23, e_error )
     7      1 1406                                end
            1 1407                                else
            1 1408                                begin
     8      1 1409                                  GET_STREXPR( s );
            1 1410                                  if s.length > 0 then
            1 1411                                    for ii := 1 to ide_all do
            1 1412                                    begin
     9      1 1413                                      NEW( ide_stb[ii], s.length );
            1 1414                                      ide_stb[ii]^ := s
     8      1 1415                                    end
     7      1 1416                                end;
            1 1417                otherwise
            1 1418                end
     6      1 1419              end { End of Initial value managment }
     5      1 1420            end { End of "if not btyp then" }
     4      1 1421          end
     3      1 1422        end
            1 1423        else
            1 1424        begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  27
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "declare_new_ident".

     4      1 1425          SRC_ERROR( mdnam, 102, e_severe );                      { ERROR: An identifier was expected }
            1 1426          INSYMBOL
     3      1 1427        end
     2      1 1428      until sy <> comma;
     1      1 1429    end
     0      1 1430  end DECLARE_NEW_IDENT;
            1 1431  
            1 1432  
            1 1433  
            1 1434  procedure DECLARE_NEW_TYPE;
            1 1435  const
            1 1436    mdnam = 'TDCL';
            1 1437  
            1 1438  var
            1 1439    ide: ide_ptr;
            1 1440    bok: boolean;
            1 1441  
            1 1442  begin
     1      1 1443    with sy_sym do
            1 1444    begin
     2      1 1445      INSYMBOL;                                   { Gooble up the TYPE keyword }
            1 1446      bok := false;
            1 1447      if (sy = identsy) and (sy_macro = nil) then
            1 1448      begin
     3      1 1449        ide := IDE_SEARCH( false );
            1 1450        if ide <> nil then
            1 1451          if ide^.ide_class = cla_type then
            1 1452          begin  DECLARE_NEW_IDENT( ide, true ); bok := true  end
            1 1453          else SRC_ERROR_S( mdnam, 126, e_error, sy_ident )
     2      1 1454      end;
            1 1455      if not bok then
            1 1456      begin { *** Error: A type identifier was expected *** }
     3      1 1457        SRC_ERROR_S( mdnam, 104, e_severe, sy_ident );
            1 1458        SKIP_SYMBOL( semicolon )
     2      1 1459      end
     1      1 1460    end
     0      1 1461  end DECLARE_NEW_TYPE;
            1 1462  
            1 1463  
            1 1464  
            1 1465  procedure CREATE_ENTRY( idt, ide: ide_ptr; ope: dcp_oper; var frs, lst: ent_ptr );
            1 1466  const
            1 1467    mdnam = 'CENT';
            1 1468  
            1 1469  var
            1 1470    ent:                 ent_ptr; { Entry pointer }
            1 1471    snm:                 str_ptr; { Identification string }
            1 1472    idp, idq, itp:       ide_ptr; { Identifier pointer for formal (idp and idq) and for formal type }
            1 1473    body:                idm_apt; { Text pointer of macro function }
            1 1474    npa:                 integer; { Number of formal parameters }
            1 1475    berr:                boolean; { Boolean to flag any error }
            1 1476  
            1 1477    opnm: [static] array[not_op..ass_op] of string( 6 )
            1 1478          := [  'O not',   'O **',    'O *',    'O /',
            1 1479               'O idiv',  'O mod',  'O rem',    'O +',
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  28
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "create_entry".

            1 1480                  'O -',   'O ||',    'O <',   'O <=',
            1 1481                 'O >=',    'O >',   'O <>',    'O =',
            1 1482                'O and',  'O xor',   'O or',   'O :=' ];
            1 1483  
            1 1484  begin
     1      1 1485    if ope = no_op then snm := ide^.ide_name
            1 1486                   else snm := opnm[ope]"address;
            1 1487    berr  :=       false;
            1 1488    with sy_sym do
            1 1489    begin
     2      1 1490      if sy = lparen then
            1 1491      begin
     3      1 1492        DISPLAY_NEW;                                      { Create a new display for the formal list }
            1 1493        sy := semicolon;
            1 1494        while sy = semicolon do                           { Loop on all type specification }
            1 1495        begin
     4      1 1496          INSYMBOL;                                       { Gobble up the separator "(" or ";" }
            1 1497          if sy = identsy then                            { When it is an identifier ... }
            1 1498          begin
     5      1 1499            itp := IDE_SEARCH( true );                    { ... we search it ... }
            1 1500            if itp <> nil then                            { ... when it exist }
            1 1501            begin
     6      1 1502              if itp^.ide_class <> cla_type then
            1 1503              begin                                       { If it is not a type identifier ... }
     7      1 1504                SRC_ERROR_S( mdnam, 127, e_error, sy_ident );     { ... we generate an error ... }
            1 1505                itp := int_typ                            { ... and force the integer type ... }
     6      1 1506              end else INSYMBOL                           { ... else gobble up this type identifier name. }
     5      1 1507            end
     4      1 1508          end
            1 1509          else
            1 1510          begin  SKIP_SYMBOL( rparen ); berr := true  end;{ Stop the formal list read }
            1 1511        exit if berr;
            1 1512          if sy = identsy then
            1 1513          repeat                                          { Loop on all argument of same type }
     5      1 1514            idp := IDE_NEW( cla_formal, idt^.idet_form ); { Create the formal identifier }
            1 1515            with idp^ do
            1 1516            begin 
     6      1 1517              idef_typ :=   itp;                          { Set the formal type link }
            1 1518              idef_efn :=     0;                          { Initialize the cla_formal specific fields }
            1 1519              idef_def := false;                          { Default and by reference arguments are not supported h
                    ere }
            1 1520              idef_ref := false
     5      1 1521            end;
            1 1522            INSYMBOL;                                     { Gobble up the formal identifier }
            1 1523            if (sy <> comma) and (sy <> semicolon) and (sy <> rparen) then
            1 1524              SRC_ERROR( mdnam, 38, e_error );
            1 1525            if sy = comma then INSYMBOL
     4      1 1526          until sy <> identsy                             { End of loop on all argument of same type }
     3      1 1527        end;                                              { End of loop on all formal type group (end of formal li
                    st) }
            1 1528        if sy <> rparen then                              { We must find the close parenthesys }
            1 1529        begin
     4      1 1530          SRC_ERROR( mdnam, 23, e_error );
            1 1531          SKIP_SYMBOL( semicolon );
            1 1532          goto ET_ERROR
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  29
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "create_entry".

     3      1 1533        end else INSYMBOL;
            1 1534        if sy <> beginsy then
            1 1535        begin
     4      1 1536          SRC_ERROR( mdnam, 21, e_error );
            1 1537          goto ET_ERROR
     3      1 1538        end;
            1 1539        body := GEN_MACRO_LIST( endsy );                  { Get the body of macro function }
            1 1540  
            1 1541        if idt <> nil then npa := 1                       { Init the formal stack count (with room for function re
                    sult when required) }
            1 1542                      else npa := 0;
            1 1543        idp := nil;                                       { Init the reversed FIFO (=QUEUE) heder pointer }
            1 1544        with disp_tab[curr_disp] do
            1 1545        begin
     4      1 1546          while disp_lid <> nil do                        { Loop to reverse the formal list order and set the argu
                    ment stack shifts }
            1 1547          begin
     5      1 1548            idq := disp_lid;                              { Keep the address of current formal identifier }
            1 1549            with idq^ do                                  { Warning: the with pointer is a copy of idp (not idp), 
                    then ... }
            1 1550            begin
     6      1 1551              disp_lid := ide_lnk;                        { ... we can keep the next of the original FIFO }
            1 1552              idef_efn :=     npa;                        { Set the formal distance in the stack }
            1 1553              ide_lnk  :=     idp;                        { Save the previous formal address in the formal link }
            1 1554              idp      :=     idq;                        { Set the current formal address as the new first formal
                     }
            1 1555              npa := npa + 1                              { Update the formal count }
     5      1 1556            end
     4      1 1557          end;
            1 1558          if npa > 32 then SRC_ERROR_S( mdnam, 129, e_error, snm^ )
     3      1 1559        end;
            1 1560        curr_disp := curr_disp - 1                        { Go out of the formal display level }
     2      1 1561      end;
            1 1562  
            1 1563      NEW( ent, entk_fnc );                               { Create the mfunction entry }
            1 1564      with ent^ do
            1 1565      begin
     3      1 1566        ent_lnk  := disp_tab[curr_disp].disp_ent;         { Set the link with the other entry of the same display 
                    }
            1 1567        ent_prv  :=          lst;                         { Link with the previous entry for the same operator/gen
                    eric }
            1 1568        ent_typ  :=          idt;                         { Set the entry resulting type }
            1 1569        ent_knd  :=     entk_fnc;                         { Set the user macro function kind of entry }
            1 1570        ent_frl  :=          idp;                         { Set the formal list head }
            1 1571        ent_cod  :=         body;                         { Set the text of mfunction body }
            1 1572        ent_dsp  :=    curr_disp;                         { Set the entry diplay level }
            1 1573        ent_ope  :=          ope;                         { Set the related operator value } 
            1 1574        if ope = no_op then ent_ide := ide                { Set the generic identifier link ... }
            1 1575                       else ent_str := snm                { ... or the conventional string name (for operator) }
     2      1 1576      end
     1      1 1577    end;
            1 1578  ET_ERROR:
     0      1 1579  end CREATE_ENTRY;
            1 1580  
            1 1581  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  30
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "mxd_dcp_exec".

            1 1582  
            1 1583  procedure DECLARE_NEW_FUNCTION;
            1 1584  const
            1 1585    mdnam = 'DCLF';
            1 1586  
            1 1587  var
            1 1588    idt, idf:    ide_ptr;
            1 1589  
            1 1590  begin
     1      1 1591    INSYMBOL;                                     { Gobble up the FUNCTION Keyword }
            1 1592    with sy_sym do
            1 1593      case sy of
            1 1594        identsy:                                  { An identifier was expected }
            1 1595          begin
     2      1 1596            idf := IDE_SEARCH( false );           { Search for this identifier }
            1 1597            if idf <> nil then                    { When it is found }
            1 1598              if idf^.ide_class = cla_type then   { When it is a type identifier }
            1 1599              begin
     3      1 1600                idt := idf;                       { Set it as the type of function result }
            1 1601                INSYMBOL;                         { Skip to the generic name ... }
            1 1602                idf := IDE_SEARCH( false )        { ... and serach it }
     2      1 1603              end
            1 1604              else
            1 1605                with idf^ do                      { The identifier was not a type }
            1 1606                  if ide_class <> cla_generic then  { When it is not a generic ... }
            1 1607                    if ide_displ < curr_disp then idf := nil { ... when it not in our display level we ignore it .
                    .. }
            1 1608                                             else SRC_ERROR_S( mdnam, 842, e_error, idf^.ide_name^ ); { ... else i
                    t is an error }
            1 1609  
       C    1 1610          { When the generic does not exist we create it }
            1 1611          if idf = nil then idf := IDE_NEW( cla_generic, form_null );
            1 1612          if idf <> nil then
            1 1613            with idf^ do
            1 1614              CREATE_ENTRY( idt, idf, no_op, ideg_first, ideg_last )
     1      1 1615        end;
            1 1616  
            1 1617      unaop,
            1 1618      powop,    mulop,   addop,
            1 1619      relop,  lgandop,  lgorop:
            1 1620        with mop_tab[op] do
            1 1621        begin
     2      1 1622          INSYMBOL;
            1 1623          CREATE_ENTRY( idt, nil, op, mop_first, mop_last )
     1      1 1624        end;
            1 1625  
            1 1626    otherwise
     2      1 1627      SRC_ERROR( mdnam, 843, e_severe );
            1 1628      SKIP_SYMBOL( semicolon )
     1      1 1629    end
     0      1 1630  end DECLARE_NEW_FUNCTION;
            1 1631  
            1 1632  
            1 1633  
            1 1634  [global]
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  31
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "mxd_dcp_exec".

            1 1635  procedure DEFINE_SPECIFIC( ip: ide_ptr );
            1 1636  begin
     1      1 1637    if ip <> nil then
            1 1638    with ip^ do
            1 1639    case idev_spcact of
            1 1640      LSQVAR_TYPE: DCP_DEF_LSQ_VARBL( ip );
            1 1641  
            1 1642    otherwise
       C    1 1643      { Nothing to do }
            1 1644    end
     0      1 1645  end DEFINE_SPECIFIC;
            1 1646  
            1 1647  
            1 1648  
            1 1649  [global]
            1 1650  procedure ASSIGN_SPECIFIC( ip: ide_ptr );
            1 1651  begin
     1      1 1652    if ip <> nil then
            1 1653    with ip^ do
            1 1654    case idev_spcact of
            1 1655      JBNAME_VALUE: begin
     2      1 1656                      LISTING_SET_SBTTL( str );   { Set or change the job title }
            1 1657                      WRITELN( pcd, ORD( nd_jobname ):4, ' ', str^.length:3, ' ', str^ )
     1      1 1658                    end;
            1 1659  
            1 1660      JBTITL_VALUE: begin
     2      1 1661                      LISTING_SET_SBTTL( str );   { Set or change the job title }
            1 1662                      WRITELN( pcd, ORD( nd_title ):4, ' ', str^.length:3, ' ', str^ )
     1      1 1663                    end;
            1 1664  
            1 1665      JBSAVE_FNAME: begin
     2      1 1666                      LISTING_SET_SBTTL( str );   { Set or change the job title }
            1 1667                      WRITELN( pcd, ORD( nd_savfnam ):4, ' ', str^.length:3, ' ', str^ )
     1      1 1668                    end;
            1 1669  
            1 1670      LSQVAR_TYPE:  DCP_ASS_LSQ_VARBL( ip );
            1 1671  
       C    1 1672  (*
       C    1 1673    LSQEXP_TYPE   =           12;                 { Least-Squares Expression (MXD-V3 PARAM name = expr;) Specific 
                    Action Index }
       C    1 1674    LSQITR_TYPE   =           13;                 { Least-Squares item field reference }
       C    1 1675    LSQFTB_TYPE   =           14;                 { Least-Squares table Specific Action Index }
       C    1 1676    LSQPQT_TYPE   =           15;                 { Least-Squares Predefined Quantity Specific Action Index }
       C    1 1677    LSQPDQ_TYPE   =           16;                 { Least-Squares Data list Predefined Quantity Specific Action In
                    dex }
       C    1 1678  *)
       C    1 1679  
            1 1680    otherwise
       C    1 1681      { Nothing to do }
            1 1682    end
     0      1 1683  end ASSIGN_SPECIFIC;
            1 1684  
            1 1685  
            1 1686  
            1 1687  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  32
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "mxd_dcp_exec".

            1 1688  procedure ASSIGNEMENT;
            1 1689  const
            1 1690    mdnam = 'ASSI';
            1 1691  
            1 1692  var
            1 1693    st:               str_string;
            1 1694    ind, iv, iw, fr, ls: integer;
            1 1695    vl:                  mxd_flt;
            1 1696    rec:                 exp_rec;
            1 1697  
            1 1698  begin
     1      1 1699    with sy_sym do
            1 1700    begin
     2      1 1701      GET_EXP_REFER( rec );
            1 1702      with rec do
            1 1703      if (exp_ref <> nil) and (exp_form <> form_null) then
            1 1704      begin
     3      1 1705        fr := exp_shift;
            1 1706        if exp_asr <> nil then
            1 1707          with exp_asr^ do
            1 1708            ls := asr_stp*asr_siz + fr - 1
            1 1709        else ls := fr;
            1 1710  
            1 1711        if (sy = becomes) or ((sy = relop) and (op = eq_op)) then INSYMBOL
            1 1712                                                             else SRC_ERROR( mdnam, 32, e_error );
            1 1713  
            1 1714        GET_EXPRESSION;
            1 1715  
            1 1716        with exp_ref^ do
            1 1717        case exp_res.exp_form of
            1 1718          form_valstr: ;
            1 1719          form_valint: ;
            1 1720          form_valflt:
            1 1721            case exp_form of
            1 1722              form_valstr:
            1 1723            end;
            1 1724  
            1 1725          form_tabstr: ;
            1 1726          form_tabint: ;
            1 1727          form_tabflt:
            1 1728            begin
            1 1729            end;
            1 1730        otherwise
            1 1731        end; 
            1 1732  
            1 1733        with exp_ref^ do
            1 1734        case exp_form of
            1 1735          form_valint: begin
     4      1 1736                         iv := GET_INTEXPR( int );
            1 1737                         if objf_ronly in idev_flags then SRC_ERROR_S( mdnam, 131, e_error, ide_name^ )
            1 1738                                                     else int := iv
     3      1 1739                       end;
            1 1740          form_valflt: begin
     4      1 1741                         vl := GET_FLTEXPR( flt );
            1 1742                         if objf_ronly in idev_flags then SRC_ERROR_S( mdnam, 131, e_error, ide_name^ )
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  33
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "assignement".

            1 1743                                                     else flt := vl
     3      1 1744                       end;
            1 1745          form_valstr: begin
     4      1 1746                         GET_STREXPR( st );
            1 1747                         if objf_ronly in idev_flags then SRC_ERROR_S( mdnam, 131, e_error, ide_name^ )
            1 1748                         else
            1 1749                         begin
     5      1 1750                           if str <> nil then DISPOSE( str );
            1 1751                           if st.length > 0 then
            1 1752                           begin
     6      1 1753                             NEW( str, st.length );
            1 1754                             str^ := st
     5      1 1755                           end else str := nil
     4      1 1756                         end
     3      1 1757                       end;
            1 1758  
            1 1759          form_telint: if exp_aai <> nil then exp_aai^.ide_itb[exp_shift] := GET_INTEXPR( 0 );
            1 1760          form_telflt: if exp_aaf <> nil then exp_aaf^.ide_ftb[exp_shift] := GET_FLTEXPR( 0.0 );
            1 1761          form_telstr: if exp_aas <> nil then
            1 1762                         with exp_aas^ do
            1 1763                         begin
     4      1 1764                           GET_STREXPR( st );
            1 1765                           if ide_stb[exp_shift] <> nil then DISPOSE( ide_stb[exp_shift] );
            1 1766                           if st.length > 0 then
            1 1767                           begin
     5      1 1768                             NEW( ide_stb[exp_shift], st.length );
            1 1769                             ide_stb[exp_shift]^ := st
     4      1 1770                           end else ide_stb[exp_shift] := nil
     3      1 1771                         end;
            1 1772          form_tabint: begin
     4      1 1773                         GET_EXPRESSION;
            1 1774                         case exp_res.exp_form of
            1 1775                           form_valint: ARRSCA_II_OPE( ass_op, exp_res.exp_int, rec );
            1 1776                           form_valflt: ARRSCA_II_OPE( ass_op, ROUND( exp_res.exp_flt ), rec );
            1 1777                           form_tabint: ARRAY_II_OPE( ass_op, exp_res, rec );
            1 1778                           form_tabflt: ARRAY_IF_OPE( ass_op, exp_res, rec );
            1 1779                         otherwise
     5      1 1780                           SRC_ERROR( mdnam, 116, e_severe )
     4      1 1781                         end
     3      1 1782                       end;
            1 1783          form_tabflt: begin
     4      1 1784                         GET_EXPRESSION;
            1 1785                         case exp_res.exp_form of
            1 1786                           form_valint: ARRSCA_FF_OPE( ass_op, mxd_flt( exp_res.exp_int ), rec );
            1 1787                           form_valflt: ARRSCA_FF_OPE( ass_op, exp_res.exp_flt, rec );
            1 1788                           form_tabint: ARRAY_FI_OPE( ass_op, exp_res, rec );
            1 1789                           form_tabflt: ARRAY_FF_OPE( ass_op, exp_res, rec );
            1 1790                         otherwise
     5      1 1791                           SRC_ERROR( mdnam, 117, e_severe )
     4      1 1792                         end
     3      1 1793                       end;
            1 1794          form_tabstr: begin
     4      1 1795                         GET_EXPRESSION;
            1 1796                         case exp_res.exp_form of
            1 1797                           form_valstr: ARRSCA_SS_OPE( ass_op, exp_res, rec );
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  34
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "assignement".

            1 1798                           form_tabstr: ARRAY_SS_OPE( ass_op, exp_res, rec );
            1 1799                         otherwise
     5      1 1800                           SRC_ERROR( mdnam, 118, e_severe )
     4      1 1801                         end
     3      1 1802                       end;
            1 1803  
            1 1804        otherwise
     4      1 1805          SRC_ERROR_S( mdnam, 105, e_severe, sy_ident );
            1 1806          INSYMBOL
     3      1 1807        end;
            1 1808        if objf_spass in exp_ref^.idev_flags then ASSIGN_SPECIFIC( exp_ref ) { Execute specific action when requir
                    ed }
     2      1 1809      end
     1      1 1810    end
     0      1 1811  end ASSIGNEMENT;
            1 1812  
            1 1813  
            1 1814  
            1 1815  procedure OPENFILE_STATE;
       C    1 1816  { To open a text read/write file }
            1 1817  const
            1 1818    mdnam = 'OPEN';
            1 1819  
            1 1820  var
            1 1821    lun:         integer;
            1 1822    fspc:     str_string;
            1 1823    fmd:      flags_file;
            1 1824    fcd:    iocnt_opmode;
            1 1825    bok:         boolean;
            1 1826  
            1 1827  begin
     1      1 1828    bok := true;
            1 1829    fmd := [error_file,case_ena_file];
            1 1830    with sy_sym do
            1 1831    begin
     2      1 1832      if sy = colon then begin  INSYMBOL; lun := GET_INTEXPR( 1 )  end
            1 1833                    else lun := 1;
            1 1834      if (lun < 0) or (lun > max_usrlun) then
            1 1835      begin
     3      1 1836        SRC_ERROR( mdnam, 77, e_severe );
            1 1837        SKIP_SYMBOL( semicolon );
            1 1838        bok := false
     2      1 1839      end;
            1 1840      GET_STREXPR( fspc );
            1 1841      if fspc.length >= 1 then
            1 1842      case fspc[1] of
            1 1843        'R', 'r', 'I', 'i':
            1 1844           begin { Read mode   } fmd :=   [read_file,error_file,case_ena_file]; fcd :=  iocnt_input  end;
            1 1845        'W', 'w', 'O', 'o':
            1 1846           begin { Write mode  } fmd :=  [write_file,error_file,case_ena_file]; fcd := iocnt_output  end;
            1 1847        'A', 'a':
            1 1848           begin { Append mode } fmd := [append_file,error_file,case_ena_file]; fcd := iocnt_output  end;
            1 1849      otherwise
     3      1 1850        SRC_ERROR_S( mdnam, 777, e_severe, fspc );
            1 1851        SKIP_SYMBOL( semicolon );
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  35
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "openfile_state".

            1 1852        bok := false
     2      1 1853      end
            1 1854      else
            1 1855      begin  fmd := [read_file,error_file,case_ena_file]; fcd := iocnt_input  end;
            1 1856  
            1 1857      if bok then
            1 1858      with sym_iof[lun] do
            1 1859      begin
     3      1 1860        if sy = comma then INSYMBOL
            1 1861                      else SRC_ERROR( mdnam, 31, e_error );
            1 1862        GET_STREXPR( fspc );
            1 1863        if iocnt_mode <> iocnt_close then CLOSE( iocnt_file );
            1 1864        OPEN( iocnt_file, fspc, fmd );
            1 1865        if iostatus = 0 then iocnt_mode := fcd
            1 1866                        else iocnt_mode := iocnt_close;
            1 1867        io_err^.int := ORD( iostatus <> 0 )       { Error on open }
     2      1 1868      end
            1 1869      else io_err^.int := -1                      { Illegal OPEN parameter values }
     1      1 1870    end
     0      1 1871  end OPENFILE_STATE;
            1 1872  
            1 1873  
            1 1874  
            1 1875  procedure CLOSEFILE_STATE;
       C    1 1876  { to close a text read/write file }
            1 1877  var
            1 1878    lun: integer;
            1 1879  
            1 1880  begin
     1      1 1881    with sy_sym do
            1 1882    begin
     2      1 1883      INSYMBOL;
            1 1884      if sy = colon then begin  INSYMBOL; lun := GET_INTEXPR( 1 )  end
            1 1885                    else lun := 1;
            1 1886      if (lun >= 0) and (lun <= max_usrlun) then
            1 1887        with sym_iof[lun] do
            1 1888        begin
     3      1 1889          if iocnt_mode <> iocnt_close then CLOSE( sym_iof[lun].iocnt_file );
            1 1890          iocnt_mode := iocnt_close
     2      1 1891        end
            1 1892        else SRC_ERROR( 'CLOS', 77, e_severe )
     1      1 1893    end
     0      1 1894  end CLOSEFILE_STATE;
            1 1895  
            1 1896  
            1 1897  
            1 1898  procedure GET_IO_FORMAT( nb: integer; var i1, i2, i3: integer );
            1 1899  begin
     1      1 1900    with sy_sym do
            1 1901    if sy = colon then
            1 1902    begin
     2      1 1903      INSYMBOL;
            1 1904      i1 := GET_INTEXPR( i1 );
            1 1905      if (nb > 1) and (sy = colon) then
            1 1906      begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  36
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "get_io_format".

     3      1 1907        INSYMBOL;
            1 1908        i2 := GET_INTEXPR( i2 );
            1 1909        if (nb > 2) and (sy = colon) then
            1 1910        begin
     4      1 1911          INSYMBOL;
            1 1912          i3 := GET_INTEXPR( i3 )
     3      1 1913        end
     2      1 1914      end
     1      1 1915    end
     0      1 1916  end GET_IO_FORMAT;
            1 1917  
            1 1918  
            1 1919  
            1 1920  procedure READ_VALUES( sym: symbol );
       C    1 1921  { To get a variable from terminal or input file : string or number(s) }
            1 1922  const
            1 1923    mdnam = 'RPLY';
            1 1924  
            1 1925  var 
            1 1926    st:                   str_string;
            1 1927    lun, nel, fs, dc, ls: integer;
            1 1928    rec:                  exp_rec;
            1 1929    fv:                   mxd_flt;
            1 1930    iv:                   integer;
            1 1931    sv:                   str_ptr;
            1 1932  
            1 1933    function FREAD_INT( var f: text; fl: integer ): integer;
            1 1934    var
            1 1935      iv: integer;
            1 1936  
            1 1937    begin
     1      1 1938      iv := 0;
            1 1939      if EOLN( f ) and not EOF( f ) then READLN( f );
            1 1940      if not EOF( f ) then READ( f, iv:fl );
            1 1941      if EOF( f ) then
            1 1942      begin
     2      1 1943        io_eof^.int  := 1;
            1 1944        io_eoln^.int := 1
     1      1 1945      end
            1 1946      else
            1 1947      begin
     2      1 1948        io_eof^.int := 0;
            1 1949        io_eoln^.int := ORD( EOLN( f ) );
            1 1950        TTY_CLR_EOF( f )
     1      1 1951      end;
            1 1952      FREAD_INT := iv
     0      1 1953    end FREAD_INT;
            1 1954  
            1 1955  
            1 1956    function FREAD_FLT( var f: text; fl: integer ): mxd_flt;
            1 1957    var
            1 1958      fv: mxd_flt;
            1 1959  
            1 1960    begin
     1      1 1961      fv := 0.0;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  37
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "PRC_00000002".

            1 1962      if EOLN( f ) and not EOF( f ) then READLN( f );
            1 1963      if not EOF( f ) then READ( f, fv:fl );
            1 1964      if EOF( f ) then
            1 1965      begin
     2      1 1966        io_eof^.int  := 1;
            1 1967        io_eoln^.int := 1
     1      1 1968      end
            1 1969      else
            1 1970      begin
     2      1 1971        io_eof^.int := 0;
            1 1972        io_eoln^.int := ORD( EOLN( f ) );
            1 1973        TTY_CLR_EOF( f )
     1      1 1974      end;
            1 1975      FREAD_FLT := fv
     0      1 1976    end FREAD_FLT;
            1 1977  
            1 1978  
            1 1979    procedure FREAD_STR( var f: text; var sv: str_ptr; fl, dc: integer );
            1 1980    const
            1 1981      TAB = CHR( 9 );
            1 1982  
            1 1983    var
            1 1984      st: str_string;
            1 1985      il: integer;
            1 1986      beof, beoln: boolean;
            1 1987      ch: char;
            1 1988  
            1 1989    begin
     1      1 1990      st.length := 0;
            1 1991      if not UFB( f ) then
            1 1992        if EOLN( f ) and not EOF( f ) then READLN( f );
            1 1993      if not (EOLN( f ) or EOF( f )) then
            1 1994      begin
     2      1 1995        if sv <> nil then DISPOSE( sv );
            1 1996        READ( f, st:fl:(dc > 0) );
       C    1 1997        { size the string by supress any trailing space(s) }
            1 1998        for ii := st.length downto 1 do
            1 1999          if st[ii] > ' ' then
            1 2000          begin  st.length := ii; exit  end;
            1 2001        if st.length > 0 then
       C    1 2002        { Now suppress any control character except space and TAB }
            1 2003        il := 0;
            1 2004        for ii := 1 to st.length do
            1 2005          if (st[ii] >= ' ') or (st[ii] = TAB) then
            1 2006          begin  il := il + 1; st[il] := st[ii]  end;
            1 2007        st.length := il;
       C    1 2008        { Create the final string }
            1 2009        if st.length > 0 then
            1 2010        begin
     3      1 2011          NEW( sv, il );
            1 2012          sv^ := st
     2      1 2013        end else sv := nil;
     1      1 2014      end;
            1 2015      if EOF( f ) then
            1 2016      begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  38
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "PRC_00000003".

     2      1 2017        io_eof^.int  := 1;
            1 2018        io_eoln^.int := 1;
            1 2019        if TTY_FILE( f ) then TTY_CLR_EOF( f )
     1      1 2020      end
            1 2021      else
            1 2022      begin
     2      1 2023        io_eof^.int := 0;
            1 2024        io_eoln^.int := ORD( EOLN( f ) );
     1      1 2025      end
     0      1 2026   end FREAD_STR;
            1 2027  
            1 2028  
            1 2029  begin { READ_VALUES }
     1      1 2030    lun := 1;
            1 2031    INSYMBOL;
            1 2032    if sym = readsy then
            1 2033    begin
     2      1 2034      lun := GET_INTEXPR( lun );
            1 2035      if (lun < 0) or (lun > max_usrlun) then
            1 2036      begin
     3      1 2037        SRC_ERROR( mdnam, 77, e_severe );
            1 2038        lun := 1
     2      1 2039      end
            1 2040      else
            1 2041        if sym_iof[lun].iocnt_mode <> iocnt_input then
            1 2042        begin
     3      1 2043          SRC_ERROR( mdnam, 401, e_severe );
            1 2044          lun := 1
     2      1 2045        end;
            1 2046      if sy_sym.sy <> colon then SRC_ERROR( mdnam, 31, e_error )
            1 2047                            else INSYMBOL
     1      1 2048    end;
            1 2049    if lun >= 0 then
            1 2050    with sy_sym, sym_iof[lun] do
            1 2051    begin
     2      1 2052      if op <> stp_op then
            1 2053      loop
     3      1 2054        GET_EXP_REFER( rec );       { Get the reference of object to read }
            1 2055        fs := 0; dc := 0; ls := 0;
            1 2056        GET_IO_FORMAT( 2, fs, dc, ls );
            1 2057        with rec do
            1 2058        begin
     4      1 2059          nel := exp_shift;
            1 2060          ls  := exp_edim + exp_shift;
            1 2061          if exp_ref <> nil then
            1 2062          with exp_ref^ do
            1 2063          case exp_form of
            1 2064            form_valint:
            1 2065              begin
     5      1 2066                if sym = readsy then iv := FREAD_INT( iocnt_file, fs )
            1 2067                                else iv := FREAD_INT( input, fs );
            1 2068                if objf_ronly in idev_flags then SRC_ERROR_S( mdnam, 131, e_error, ide_name^ )
            1 2069                             else int := iv
     4      1 2070              end;
            1 2071            form_valflt:
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  39
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "read_values".

            1 2072              begin
     5      1 2073                if sym = readsy then fv := FREAD_FLT( iocnt_file, fs )
            1 2074                                else fv := FREAD_FLT( input, fs );
            1 2075                if objf_ronly in idev_flags then SRC_ERROR_S( mdnam, 131, e_error, ide_name^ )
            1 2076                             else flt := fv
     4      1 2077              end;
            1 2078            form_valstr:
            1 2079              if (objf_ronly in idev_flags) or (exp_ref = udc_ident) then
            1 2080              begin
     5      1 2081                sv := nil;
            1 2082                if sym = readsy then FREAD_STR( iocnt_file, sv, fs, dc )
            1 2083                                else FREAD_STR( input, sv, fs, dc );
            1 2084                if sv <> nil then DISPOSE( sv );
            1 2085                if exp_ref <> udc_ident then SRC_ERROR_S( mdnam, 131, e_error, ide_name^ )
     4      1 2086              end
            1 2087              else
            1 2088                if sym = readsy then FREAD_STR( iocnt_file, str, fs, dc )
            1 2089                                else FREAD_STR( input, str, fs, dc );
            1 2090            form_telint:
            1 2091              if exp_aai <> nil then
            1 2092              with exp_aai^ do
            1 2093              if sym = readsy then ide_itb[exp_shift] := FREAD_INT( iocnt_file, fs )
            1 2094                              else ide_itb[exp_shift] := FREAD_INT( input, fs );
            1 2095            form_telflt:
            1 2096              if exp_aaf <> nil then
            1 2097              with exp_aaf^ do
            1 2098              if sym = readsy then ide_ftb[exp_shift] := FREAD_FLT( iocnt_file, fs )
            1 2099                              else ide_ftb[exp_shift] := FREAD_FLT( input, fs );
            1 2100            form_telstr:
            1 2101              if exp_aas <> nil then
            1 2102              with exp_aas^ do
            1 2103                if sym = readsy then
            1 2104                  FREAD_STR( iocnt_file, ide_stb[exp_shift], fs, dc )
            1 2105                else
            1 2106                  FREAD_STR( input, ide_stb[exp_shift], fs, dc );
            1 2107            form_tabint:
            1 2108              if exp_aai <> nil then
            1 2109              with exp_aai^ do
            1 2110              begin
     5      1 2111                while (nel < ls) and (io_eof^.int = 0) do
            1 2112                begin
     6      1 2113                  if sym = readsy then ide_itb[nel] := FREAD_INT( iocnt_file, fs )
            1 2114                                  else ide_itb[nel] := FREAD_INT( input, fs );
            1 2115                  nel := nel + 1
     5      1 2116                end;
            1 2117                if io_eof^.int > 0 then nel := nel - 1;
            1 2118                io_count^.int := nel - 1
     4      1 2119              end;
            1 2120  
            1 2121            form_tabflt:
            1 2122              if exp_aaf <> nil then
            1 2123              with exp_aaf^ do
            1 2124              begin
     5      1 2125                while (nel < ls) and (io_eof^.int = 0) do
            1 2126                begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  40
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "read_values".

     6      1 2127                  if sym = readsy then ide_ftb[nel] := FREAD_FLT( iocnt_file, fs )
            1 2128                                  else ide_ftb[nel] := FREAD_FLT( input, fs );
            1 2129                  nel := nel + 1
     5      1 2130                end;
            1 2131                if io_eof^.int > 0 then nel := nel - 1;
            1 2132                io_count^.int := nel - 1
     4      1 2133              end;
            1 2134  
            1 2135            form_tabstr:
            1 2136              if exp_aas <> nil then
            1 2137              with exp_aas^ do
            1 2138              begin
     5      1 2139                while (nel < ls) and (io_eof^.int = 0) do
            1 2140                begin
     6      1 2141                  if sym = readsy then FREAD_STR( iocnt_file, ide_stb[nel], fs, dc )
            1 2142                                  else FREAD_STR( input, ide_stb[nel], fs, dc );
            1 2143                  nel := nel + 1
     5      1 2144                end;
            1 2145                if io_eof^.int > 0 then nel := nel - 1;
            1 2146                io_count^.int := nel - 1
     4      1 2147              end;
            1 2148          otherwise
     5      1 2149            SRC_ERROR_S( mdnam, 403, e_severe,  )
     4      1 2150          end;
            1 2151          if objf_spass in exp_ref^.idev_flags then ASSIGN_SPECIFIC( exp_ref )     { Execute specific action when 
                    required }
     3      1 2152        end;
            1 2153      exit if sy <> comma;
            1 2154        INSYMBOL
     2      1 2155      end;
            1 2156      if sym = readsy then begin  if not EOF( iocnt_file ) then READLN( iocnt_file )  end
            1 2157                      else begin  if not EOF then READLN  end
     1      1 2158    end
     0      1 2159  end READ_VALUES;
            1 2160  
            1 2161  
            1 2162  
            1 2163  procedure WRITE_VALUES( sym: symbol );
            1 2164  const
            1 2165    mdnam = 'DSPL';
            1 2166  
            1 2167  var
            1 2168    lun, iv, fs, dc, npt, ncr: integer;
            1 2169    rv:                        mxd_flt;
            1 2170    st:                        str_string;
            1 2171    bndl:                      boolean;
            1 2172    rec:                       exp_rec;
            1 2173  
            1 2174  begin  { WRITE_VALUES }
     1      1 2175    lun := 0;
            1 2176    INSYMBOL;
            1 2177    if (sym <> writemsgsy) and (sym <> displaysy) then
            1 2178    begin
     2      1 2179      lun := GET_INTEXPR( 1 );                    { Get the I/O Lun value }
            1 2180      if (lun < 0) or (lun > max_usrlun) then
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  41
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "write_values".

            1 2181      begin
     3      1 2182        SRC_ERROR( mdnam, 77, e_severe );
            1 2183        lun := -1
     2      1 2184      end
            1 2185      else
            1 2186        if sym_iof[lun].iocnt_mode <> iocnt_output then
            1 2187        begin
     3      1 2188          SRC_ERROR( mdnam, 401, e_severe );
            1 2189          lun := -1
     2      1 2190        end;
            1 2191      if sy_sym.sy <> colon then SRC_ERROR( mdnam, 31, e_error )
            1 2192                            else INSYMBOL
     1      1 2193    end;
            1 2194    if lun >= 0 then
            1 2195    with sy_sym, rec do
            1 2196    begin
     2      1 2197      if op <> stp_op then
            1 2198      loop
     3      1 2199        bndl := true;
            1 2200        GET_EXPRESSION;
            1 2201        rec := exp_res;
            1 2202        case exp_form of                          { If function of the expression type }
            1 2203          form_valint: begin
     4      1 2204                        iv := exp_int;
            1 2205                        fs := 10; dc := 0;
            1 2206                        GET_IO_FORMAT( 2, fs, dc, iv );
            1 2207                        WRITEV( st, iv:fs:dc )
     3      1 2208                      end;
            1 2209          form_valflt: begin
     4      1 2210                        rv := exp_flt;
            1 2211                        fs := 12; dc := 6;
            1 2212                        GET_IO_FORMAT( 2, fs, dc, iv );
            1 2213                        WRITEV( st, rv:fs:dc )
     3      1 2214                      end;
            1 2215          form_valstr: begin
     4      1 2216                        fs := 0; dc := 0;
            1 2217                        GET_IO_FORMAT( 2, fs, dc, iv );
            1 2218                        if exp_str <> nil then
            1 2219                        begin
     5      1 2220                          WRITEV( st, exp_str^:fs:dc );
            1 2221                          if exp_ref = nil then
            1 2222                          begin
     6      1 2223                            DISPOSE( exp_str );
            1 2224                            exp_str := nil
     5      1 2225                          end
     4      1 2226                        end
            1 2227                        else
            1 2228                          if fs > 0 then WRITEV( st, ' ':fs ) else st := ''
     3      1 2229                      end;
            1 2230          form_telint: if exp_aai <> nil then
            1 2231                      with exp_aai^ do
            1 2232                      begin
     4      1 2233                        fs := 10; dc := 0;
            1 2234                        GET_IO_FORMAT( 2, fs, dc, iv );
            1 2235                        if fs = 0 then fs := 10;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  42
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "write_values".

            1 2236                        WRITEV( st, ide_itb[exp_shift]:fs:dc )
     3      1 2237                      end;
            1 2238          form_tabint: if exp_aai <> nil then
            1 2239                      with exp_aai^ do
            1 2240                      begin
     4      1 2241                        bndl := false;
            1 2242                        iv := 4; fs := 10; dc := 0;
            1 2243                        GET_IO_FORMAT( 3, iv, fs, dc );
            1 2244                        if iv <= 0 then iv := 4;
            1 2245                        st.length := 0;
            1 2246                        with sym_iof[lun] do
            1 2247                        for ii := 1 to exp_edim do
            1 2248                        begin
     5      1 2249                          WRITEV( st:false, ide_itb[exp_shift]:fs:dc );
            1 2250                          exp_shift := exp_shift + 1;
            1 2251                          if (ii mod iv = 0) or (ii = exp_edim) then
            1 2252                          begin
     6      1 2253                            case sym of
            1 2254                              displaysy:  WRITELN( st );
            1 2255                              writemsgsy: begin
     7      1 2256                                            LST_PUT_STRING( st );
            1 2257                                            LST_EOLN
     6      1 2258                                          end;
            1 2259                              writelnsy, writesy: WRITELN( iocnt_file, st );
            1 2260                            otherwise
            1 2261                            end;
            1 2262                            st.length := 0
     5      1 2263                          end
     4      1 2264                        end
     3      1 2265                      end;
            1 2266          form_telflt: if exp_aaf <> nil then
            1 2267                      with exp_aaf^ do
            1 2268                      begin
     4      1 2269                        fs :=12; dc := 6;
            1 2270                        GET_IO_FORMAT( 2, fs, dc, iv );
            1 2271                        WRITEV( st, ide_ftb[exp_shift]:fs:dc )
     3      1 2272                      end;
            1 2273          form_tabflt: if exp_aaf <> nil then
            1 2274                      with exp_aaf^ do
            1 2275                      begin
     4      1 2276                        bndl := false;
            1 2277                        iv := 4; fs := 12; dc := 6;
            1 2278                        GET_IO_FORMAT( 3, iv, fs, dc );
            1 2279                        if iv <= 0 then iv := 4;
            1 2280                        st.length := 0;
            1 2281                        with sym_iof[lun] do
            1 2282                        for ii := 1 to exp_edim do
            1 2283                        begin
     5      1 2284                          WRITEV( st:false, ide_ftb[exp_shift]:fs:dc );
            1 2285                          exp_shift := exp_shift + 1;
            1 2286                          if (ii mod iv = 0) or (ii = exp_edim) then
            1 2287                          begin
     6      1 2288                            case sym of
            1 2289                              displaysy:  WRITELN( st );
            1 2290                              writemsgsy: begin
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  43
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "write_values".

     7      1 2291                                            LST_PUT_STRING( st );
            1 2292                                            LST_EOLN
     6      1 2293                                          end;
            1 2294                              writelnsy, writesy: WRITELN( iocnt_file, st );
            1 2295                            otherwise
            1 2296                            end;
            1 2297                            st.length := 0
     5      1 2298                          end
     4      1 2299                        end
     3      1 2300                      end;
            1 2301          form_telstr: if exp_aas <> nil then
            1 2302                      with exp_aas^ do
            1 2303                      begin
     4      1 2304                        fs := 0; dc := 0;
            1 2305                        GET_IO_FORMAT( 2, fs, dc, iv );
            1 2306                        if ide_stb[exp_shift] = nil then
            1 2307                          if fs > 0 then WRITEV( st, ' ':fs )
            1 2308                                    else st.length := 0
            1 2309                        else
            1 2310                          WRITEV( st, ide_stb[exp_shift]:fs:dc )
     3      1 2311                      end;
            1 2312          form_tabstr: if exp_aas <> nil then
            1 2313                      with exp_aas^ do
            1 2314                      begin
     4      1 2315                        bndl := false;
            1 2316                        iv := 1; fs := 0; dc := 0;
            1 2317                        GET_IO_FORMAT( 3, iv, fs, dc );
            1 2318                        if iv <= 0 then iv := 1;
            1 2319                        st.length := 0;
            1 2320                        with sym_iof[lun] do
            1 2321                        for ii := 1 to exp_edim do
            1 2322                        begin
     5      1 2323                          if ide_stb[exp_shift] = nil then
            1 2324                          begin
     6      1 2325                            if fs > 0 then WRITEV( st:false, ' ':fs )
     5      1 2326                          end
            1 2327                          else
            1 2328                            WRITEV( st:false, ide_stb[exp_shift]:fs:dc );
            1 2329                          exp_shift := exp_shift + 1;
            1 2330                          if (ii mod iv = 0) or (ii = exp_edim) then
            1 2331                          begin
     6      1 2332                            case sym of
            1 2333                              displaysy:  WRITELN( st );
            1 2334                              writemsgsy: begin
     7      1 2335                                            LST_PUT_STRING( st );
            1 2336                                            LST_EOLN
     6      1 2337                                          end;
            1 2338                              writelnsy, writesy: WRITELN( iocnt_file, st );
            1 2339                            otherwise
            1 2340                            end;
            1 2341                            st.length := 0
     5      1 2342                          end
     4      1 2343                        end
     3      1 2344                      end;
            1 2345  
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  44
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "write_values".

            1 2346        otherwise
     4      1 2347          SRC_ERROR( mdnam, 402, e_severe )
     3      1 2348        end;
            1 2349  
            1 2350        case sym of
            1 2351          displaysy:   WRITE( st );
            1 2352          writemsgsy:  LST_PUT_STRING( st );
            1 2353          writelnsy,
            1 2354          writesy:     WRITE( sym_iof[lun].iocnt_file, st );
            1 2355        otherwise
            1 2356        end;
            1 2357      exit if sy <> comma;
            1 2358        INSYMBOL
     2      1 2359      end;
            1 2360  
            1 2361      if bndl then
            1 2362      case sym of
            1 2363        displaysy: if sy = replysy then READ_VALUES( replysy )
            1 2364                                   else WRITELN;
            1 2365        writemsgsy: LST_EOLN;
            1 2366        writelnsy:  WRITELN( sym_iof[lun].iocnt_file );
            1 2367      otherwise
            1 2368      end
     1      1 2369    end
     0      1 2370  end WRITE_VALUES;
            1 2371  
            1 2372  
            1 2373  
            1 2374  procedure CASE_STATE;
            1 2375  const
            1 2376    mdnam = 'CASE';
            1 2377  
            1 2378  var
            1 2379    iv, jv, kv: integer;
            1 2380    bg, be: boolean;
            1 2381  
            1 2382  begin
     1      1 2383    with sy_sym, src_control^ do
            1 2384    begin
     2      1 2385      bg := false;
            1 2386      be := false;
            1 2387      INSYMBOL;                    { Gobble up the case keyword }
            1 2388      src_insnb := src_insnb + 1;
            1 2389      iv := GET_INTEXPR( 0 );      { Get the selector value }
            1 2390      if sy <> whensy then SRC_ERROR( mdnam, 121, e_error )
            1 2391                      else INSYMBOL;
            1 2392      loop
     3      1 2393        if sy <> othersy  then
            1 2394        begin
     4      1 2395          loop
     5      1 2396            jv := GET_INTEXPR( iv );
            1 2397            if sy = twodot then
            1 2398            begin
     6      1 2399              INSYMBOL;
            1 2400              kv := GET_INTEXPR( jv )
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  45
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "case_state".

     5      1 2401            end else kv := jv;
            1 2402            if (iv >= jv) and (iv <= kv) then bg := true;
            1 2403          exit if sy <> comma;
            1 2404            INSYMBOL
     4      1 2405          end;
            1 2406          if sy <> colon then SRC_ERROR( mdnam, 31, e_error );
            1 2407          if bg then
            1 2408          begin
     5      1 2409            STATELIST( whensy );
            1 2410            if sy <> endsy then SKIP_SYMBOL( endsy );
            1 2411            be := true
     4      1 2412          end
            1 2413          else
            1 2414          begin
     5      1 2415            src_insnb := src_insnb + 1;
            1 2416            SKIP_SYMBOL( whensy );
            1 2417            src_insnb := src_insnb - 1
     4      1 2418          end
     3      1 2419        end
            1 2420        else
            1 2421        begin { Other case }
     4      1 2422          STATELIST( othersy );
            1 2423          be := true
     3      1 2424        end;
            1 2425      exit if (sy <> whensy) or be;
            1 2426        INSYMBOL
     2      1 2427      end;
            1 2428      if sy <> endsy then
            1 2429        if be then
            1 2430          SRC_ERROR( mdnam, 108, e_error )
            1 2431        else
            1 2432        begin
     3      1 2433          src_insnb := src_insnb + 1;
            1 2434          SKIP_SYMBOL( endsy );
            1 2435          src_insnb := src_insnb - 1
     2      1 2436        end
            1 2437      else INSYMBOL;
            1 2438      src_insnb := src_insnb - 1
     1      1 2439    end
     0      1 2440  end CASE_STATE;
            1 2441  
            1 2442  
            1 2443  
            1 2444  
            1 2445  
            1 2446  
            1 2447  procedure IF_STATE;
            1 2448  const
            1 2449    mdnam = 'IFST';
            1 2450  
            1 2451  var
            1 2452    iv: integer;
            1 2453  
            1 2454  begin
     1      1 2455    with sy_sym, src_control^ do
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  46
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "if_state".

            1 2456    begin
     2      1 2457      INSYMBOL;                                   { Gobble up the if keyword }
            1 2458      iv := GET_INTEXPR( 1 );                     { Get the condition value }
            1 2459      if sy <> thensy then SRC_ERROR( mdnam, 107, e_error );
            1 2460      if iv > 0 then STATELIST( elsesy )
            1 2461                else
            1 2462                begin
     3      1 2463                  src_insnb := src_insnb + 1;
            1 2464                  SKIP_SYMBOL( elsesy );
            1 2465                  src_insnb := src_insnb - 1
     2      1 2466                end;
            1 2467      if sy = elsesy then
            1 2468      begin
     3      1 2469        if iv > 0 then
            1 2470                  begin
     4      1 2471                    src_insnb := src_insnb + 1;
            1 2472                    SKIP_SYMBOL( endsy );
            1 2473                    src_insnb := src_insnb - 1
     3      1 2474                  end
            1 2475                  else STATELIST( endsy )
     2      1 2476      end;
            1 2477      if sy = endsy then INSYMBOL
            1 2478                    else SRC_ERROR( mdnam, 108, e_error )
     1      1 2479    end
     0      1 2480  end IF_STATE;
            1 2481  
            1 2482  
            1 2483  
            1 2484  procedure BLOCK_STATE;
            1 2485  begin
     1      1 2486    DISPLAY_NEW;                                  { Create a new identifier display level }
            1 2487    STATELIST( endsy );                           { Perform the block statements }
            1 2488    DISPLAY_FREE;                                 { Destroy the display }
            1 2489    if sy_sym.sy = endsy then
            1 2490      INSYMBOL                                    { Gobble up the end keyword }
            1 2491    else
            1 2492      SRC_ERROR( 'BLOC', 108, e_severe )
     0      1 2493  end BLOCK_STATE;
            1 2494  
            1 2495  
            1 2496  
            1 2497  procedure ERROR_STATE;
            1 2498  begin
            1 2499  end ERROR_STATE;
            1 2500  
            1 2501  
            1 2502  
            1 2503  procedure STATEMENT;
       C    1 2504  { Procedure to execute one SHELL statement }
            1 2505  const
            1 2506    mdnam = 'STAT';
            1 2507  
            1 2508  var
            1 2509   stat_sy:       symbol;
            1 2510   ide:          ide_ptr;
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  47
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "statement".

            1 2511  
            1 2512  
            1 2513  begin
     1      1 2514    with sy_sym do
            1 2515    begin
     2      1 2516      stat_sy := sy;
            1 2517      case stat_sy of
            1 2518        endsy, elsesy, untilsy: ;
            1 2519  
            1 2520        chainesy, includesy:
            1 2521          INCLUDE_STATE( stat_sy = includesy );
            1 2522  
            1 2523        peofsy:        ENDFILE_STATE;
            1 2524  
            1 2525        pragmasy:      PRAGMA_STATE( src_control );
            1 2526  
            1 2527        typesy:        DECLARE_NEW_TYPE;
            1 2528  
            1 2529        functionsy:    DECLARE_NEW_FUNCTION;
            1 2530  
            1 2531        beginsy:       BLOCK_STATE;
            1 2532         casesy:       CASE_STATE;
            1 2533           ifsy:       IF_STATE;
            1 2534        whilesy:       WHILE_STATE;
            1 2535        repeatsy:      REPEAT_STATE;
            1 2536        loopsy: ;
            1 2537        forsy:         FOR_STATE;
            1 2538  
            1 2539        writesy, writelnsy, writemsgsy, displaysy:
            1 2540                       WRITE_VALUES( stat_sy );
            1 2541  
            1 2542        readsy, replysy:
            1 2543                       READ_VALUES( stat_sy );
            1 2544  
            1 2545        opensy:        OPENFILE_STATE;
            1 2546        closesy:       CLOSEFILE_STATE;
            1 2547  
            1 2548        macrosy:       MACRO_STATE;
            1 2549        purgesy:       PURGE_STATE;
            1 2550  
            1 2551        macrocallsy:   MACLOAD_STATE;
            1 2552        macrolibsy:    MACLIBR_STATE;
            1 2553  
            1 2554        errorsy:       ERROR_STATE;
            1 2555  
       C    1 2556  (*    specificsy:    MANAGE_SPECIFIC_SYMBOL( op ); *)
       C    1 2557  
            1 2558        identsy: if sy_macro = nil then
            1 2559                 begin
     3      1 2560                   ide := IDE_SEARCH( false );
            1 2561                   if ide = nil then
            1 2562                   begin
     4      1 2563                     SRC_ERROR_S( mdnam, 104, e_severe, sy_ident );
            1 2564                     SKIP_SYMBOL( semicolon );
            1 2565                     ide := udc_ident
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  48
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "statement".

     3      1 2566                   end
            1 2567                   else
            1 2568                     case ide^.ide_class of
            1 2569                       cla_generic: GET_EXPRESSION; { /// }
            1 2570  
            1 2571                       cla_type: DECLARE_NEW_IDENT( ide );
            1 2572  
            1 2573                       cla_field,
            1 2574                       cla_varbl: ASSIGNEMENT
            1 2575                     otherwise
            1 2576                     end
     2      1 2577                 end
            1 2578                 else
            1 2579                   if sy_macro^.idm_kind = idm_macro then CALL_MACRO
            1 2580                   else SRC_ERROR_S( mdnam, 109, e_severe, sy_ident );
            1 2581  
            1 2582        semicolon, nothing:  ; { Not a statement }
            1 2583  
            1 2584  
            1 2585      otherwise
     3      1 2586        SRC_ERROR( mdnam, 110, e_error );
            1 2587        SKIP_SYMBOL( semicolon )
     2      1 2588      end;
            1 2589      case sy of
            1 2590        eofsy, eomcsy, semicolon,
            1 2591        untilsy, endsy, elsesy: ;
            1 2592      otherwise
     3      1 2593        INSYMBOL
     2      1 2594      end
     1      1 2595    end
     0      1 2596  end STATEMENT;
            1 2597  
            1 2598  
            1 2599  
            1 2600  [global]
            1 2601  procedure STATELIST( stopper: symbol );
            1 2602  begin
     1      1 2603    with sy_sym do
            1 2604    begin
     2      1 2605      with src_control^ do src_insnb := src_insnb + 1;
            1 2606      INSYMBOL;
            1 2607      if stopper = othersy then
            1 2608      begin { Tolerate a colon after the other keyword in a case statement }
     3      1 2609        stopper := endsy;
            1 2610        if sy = colon then INSYMBOL
     2      1 2611      end;
            1 2612      if not (fatal_error or (sy = stopper) or
            1 2613               (sy = endsy) or (sy = eofsy)) then
            1 2614      repeat
     3      1 2615        if sy <> semicolon then STATEMENT;
            1 2616        while sy = peofsy do ENDFILE_STATE;
            1 2617      exit if fatal_error or (sy = stopper) or (sy = endsy) or (sy = eofsy);
            1 2618        if sy = semicolon then INSYMBOL
            1 2619                          else SRC_ERROR( 'STLI', 21, e_error )
     2      1 2620      until fatal_error or (sy = stopper) or
  P A S - P. WOLFERS SOFTWARE: V2.1-E OF 31-AUG-2009  RUN THE 10-DEC-2009 AT 15:15:52     PAGE  49
 The Current Source File is "/home/wolfers/Soft/cpsh_kits/MXDV4_src/mxd_dcp_comp.pas".

 The Current Compiled Module is "P_statelist".

            1 2621           (sy = endsy) or (sy = eofsy) or (sy = elsesy) or (sy = eomcsy);
            1 2622      with src_control^ do src_insnb := src_insnb - 1
     1      1 2623    end
     0      1 2624  end STATELIST;
            1 2625  
            1 2626  
            1 2627  
            1 2628  end MXD_DCP_EXEC.
            1 2629  
