


		    PNOTICE_mrpg.alm                02/14/84  0841.6r w 02/14/84  0841.5        3555


	dec	1			"version 1 structure
	dec	2			"no. of pnotices
	dec	3			"no. of STIs
	dec	156			"lgth of all pnotices + no. of pnotices
          acc       "Copyright, (C) Honeywell Information Systems Inc., 1981"
          acc       "Copyright (c) 1972 by Massachusetts Institute of
Technology and Honeywell Information Systems, Inc."

	aci	"W1RPGM0B0000"
	aci	"W2RPGM0B0000"
	aci	"W3RPGM0B0000"
	end
 



		    check_pointer_.pl1              05/20/80  1933.0r w 05/20/80  1924.4       12456


/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

check_pointer_: proc (pptr, msg);

dcl  pptr ptr,
     msg char (32);

dcl  uppt ptr based (pptr);
dcl  ch char (1);
dcl  upch char (1) unal based (uppt);
dcl  any_other condition;
dcl  code fixed bin (35);
dcl  continue_to_signal_ entry (fixed bin (35));
dcl  find_condition_info_ entry (ptr, ptr, fixed bin (35));

	msg = "";
	on condition (any_other) call handler;
	ch = upch;
quit:
	return;

packed:	entry (pptr, msg);

dcl  pch char (1) based (ppt);
dcl  ppt ptr unal based (pptr);

	msg = "";
	on condition (any_other) call handler;
	ch = pch;
	return;

handler:	proc;

dcl 1 cond_info,
%include cond_info;

	     call find_condition_info_ (null (), addr (cond_info), code);
	     if (condition_name = "quit")
	     | (condition_name = "alrm")
	     | (condition_name = "cput")
	     then do;
		call continue_to_signal_ (code);
		return;
	     end;
	     msg = condition_name;
	     goto quit;
	end;
     end;



		    macro_.pl1                      02/14/84  0905.4r w 02/14/84  0844.2      980109


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */

/**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16	       */
/**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
/**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
/**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */
				/** FUTURE &fileout name ... &filend */

macro_: proc (sl_name, segname, macname, out_ptr, out_len, arglp, argct, msg,
      refseg, ecode);

      segtype = "MACRO";
      if (sl_name = "macro")
      then who_am_i = "MACRO";
      else who_am_i = "EXPANSION";
      mac_sw = "1"b;
      segptr = null ();
      refp = refseg;
      goto start;

expand: entry (sl_name, segname, macname, out_ptr, out_len, arglp, argct, msg,
      strptr, strlen, ecode);

      if (segname = "")
      then segtype = "STRING";
      else segtype = "SEGMENT";
      myname = "source ";
      myname = myname || segtype;
      mac_sw = "0"b;
      refp = null ();
      segptr = strptr;
      segi = 1;
      sege = strlen;
      goto start;

dcl sl_name	char (32) var,	/* search  list name	       */
    segname	char (32) var,	/* name of segment to find	       */
				/* "" -> not specified	       */
    macname	char (32) var,	/* name of macro to expand	       */
				/* "" -> expanding a string	       */
    out_ptr	ptr,		/* output string (not aligned)       */
    out_len	fixed bin (24),	/* length of output produced (Out)   */
    arglp		ptr,		/* pointer to argument list	       */
    argct		fixed bin,	/* number of arguments	       */
    msg		char (1000) var,	/* error message text	       */
    refseg	ptr,		/* pointer to referencing segment    */
    strptr	ptr,		/* pointer to string to expand       */
    strlen	fixed bin (24),	/* length of string to expand	       */

    ecode		fixed bin (35);

dcl 1 argl	(24) based (arglp),
      2 p		ptr,
      2 l		fixed bin (24);
dcl arg		char (argl.l (num)) based (argl.p (num));
dcl num		fixed bin (24);
dcl refp		ptr;

start:
      if free_area_p = null ()
      then call get_area;
      local_var_ptr, int_var_ptr = null ();
      msg_etc = "";

      do num = 1 to argct;
         if (argl.l (num) < 0)
         then signal condition (argleng_less_than_zero);
         if (argl.l (num) > 500)
         then do;
	  msg = "ARG ";
	  msg = msg || ltrim (char (num));
	  msg = msg || " >500 characters.";
	  ecode = -1;
	  return;
         end;
      end;
      msg = "";
      ecode = 0;
      macro_nest = macro_nest + 1;

      save_db = db_sw;
      if (segtype = "STRING") | (segptr ^= null ())
      then goto doit;

/* name = "macro" | "foo$foo" | "foo$bar"			       */
      if mac_sw
      then do;
         c32 = segname;
         if (c32 = "")
         then do;
	  if db_sw
	  then call ioa_ (""""" ^a", macname);
	  myname = macname;
	  do maclp = macro_list_p
	     repeat (macro_list.next)
	     while (maclp ^= null ());
	     if macro_list.int_mac
	     then do;
	        if db_sw
	        then call ioa_ ("   ^a/^a", substr (macro_list.dname, 1, 1),
		      macro_list.name);
	        if (macro_list.name = macname)
	        then do;
		 segptr = macro_list.ref;
		 segi = macro_list.from;
		 sege = macro_list.to;
		 goto doit;
	        end;
	     end;
	  end;
	  c32 = macname;		/* didn't find an imbedded macro by  */
         end;			/*  this name, try for macro$macro.  */
         if db_sw
         then call ioa_ ("^a$^a", c32, macname);
         myname = c32;
         myname = myname || "$";
         myname = myname || macname;
         do maclp = macro_list_p
	  repeat (macro_list.next)
	  while (maclp ^= null ());
	  if ^macro_list.int_mac
	  then do;
	     if db_sw
	     then call ioa_ ("   ^a/^a", macro_list.ename, macro_list.name);
	     if (macro_list.ename = c32) & (macro_list.name = macname)
	     then do;
	        segptr = macro_list.ref;
	        segi = macro_list.from;
	        sege = macro_list.to;
	        goto doit;
	     end;
	  end;
         end;
      end;

      call find_macro (refp, segname, sl_name, macname);

doit:
      tr_sw = "0"b;
      if (substr (segment, segi, 7) = "&trace
")
      then do;
         segi = segi + 7;
         tr_sw = "1"b;
      end;
      if (substr (segment, segi, 7) = "&debug
")
      then do;
         segi = segi + 7;
         db_sw = "1"b;
      end;
      if db_sw | pc_sw | tr_sw | al_sw
      then do;
         call ioa_ ("^[EXPAND^s^;^a^](^i)  ^a", (who_am_i = "EXPANSION"),
	  segtype, macro_nest, macname);
         do num = 1 to argct;
	  call ioa_ ("ARG^2i:  ""^va""", num, argl.l (num), arg);
         end;
         if (argct = 0)
         then call ioa_ ("ARGs: none");
      end;
      construct_nest = 1;
      call_err = "0"b;
      call expand (segptr, segi, sege, out_ptr, out_len, "11"b);
quit:
      if db_sw | pc_sw | tr_sw | al_sw
      then call ioa_ (" ^[MEND^;EXPEND^](^i)  ^a", (who_am_i = "MACRO"),
	    macro_nest, macname);

      if (segi < sege)
      then do;
misplaced:
         msg = "Misplaced """;
         msg = msg || c32;
         msg = msg || """. ";

add_identification:
         ecode = error_table_$badsyntax;
add_id:
         if call_err
         then msg = msg || "
	from";
         if segtype = "MACRO"
         then do;
	  msg = msg || " ";
	  msg = msg || who_am_i;
         end;
         msg = msg || " """;
         msg = msg || myname;
         msg = msg || """, line ";
         msg = msg || lineno (segi);
         if ^call_err
         then do;
	  msg = "
ERROR SEVERITY 4. " || msg;
	  if (msg_etc ^= "")
	  then do;
	     msg = msg || NL;
	     msg = msg || msg_etc;
	  end;
         end;
      end;
exit:
      macro_nest = macro_nest - 1;
      tptr = local_var_ptr;
      call free_um ("loc");
      if (err_ct (3) ^= 0) & (err_ct (4) = 0)
      then ecode = error_table_$translation_failed;
      db_sw = save_db;
      return;


syntax_err:
      msg = "Syntax error in " || msg;
      msg = msg || ". ";
      goto add_identification; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* add a macro to the list of known macros			       */

addmacro: proc (dname, segname, macname, int_mac, segp, segi, sege);

dcl dname		char (168),
    segname	char (32) var,
    macname	char (32) var,
    int_mac	bit (1),		/* 1- is &macro/&define	       */
    segp		ptr,
    segi		fixed bin (24),
    sege		fixed bin (24);

      if db_sw
      then call ioa_ ("addmacro ^a > ^a (^p) ^a^[ INTERNAL^]",
	    dname, segname, segp, macname, int_mac);
      do maclp = macro_list_p
         repeat (macro_list.next)
         while (maclp ^= null ());
         if (macro_list.ename = segname) & (macro_list.name = macname)
	  & (macro_list.int_mac = int_mac)
         then do;
	  if (segptr = macro_list.ref)
	     & (segi = macro_list.from)
	     & (sege = macro_list.to)
	  then do;
	     if db_sw
	     then call ioa_ ("   already there");
	     return;
	  end;
	  msg = who_am_i;
	  msg = msg || " already defined.";
	  goto add_identification;
         end;
      end;
      allocate macro_list in (free_area);
      if al_sw
      then call ioa_ ("A macro_list ^i ^p", size (macro_list), maclp);
      macro_list.name = macname;
      macro_list.ref = segp;
      macro_list.dname = dname;
      macro_list.ename = segname;
      macro_list.from = segi;
      macro_list.to = sege;
      macro_list.int_mac = int_mac;
      macro_list.next = macro_list_p;
      macro_list_p = maclp;
      if db_sw then call ioa_ ("addmac ^16a ^p ^i:^i^/^-^a > ^a",
	    macro_list.name, macro_list.ref, macro_list.from, macro_list.to,
	    macro_list.dname, macro_list.ename);

   end addmacro; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* An ampersand has been found, handle it.			       */

ampersand: proc (ifp, ifi, ife, ofp, ofe, TF, err_sw) recursive;

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2),
    err_sw	bit (1);		/* 0- misplaced are error	       */
				/* 1- misplaced no sweat	       */
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);


      begl = ifi;
      if db_sw then call dumper ("ampr", ifp, ifi, ife, ofp, ofe, TF);
      if (ifi >= ife)
      then do;
         msg = "Orphan &.";
         goto add_identification;
      end;
      i = index ("0123456789", inputa (ifi + 1));
      if (i ^= 0)
      then do;
         num = i - 1;
         i = index ("0123456789", inputa (ifi + 2));
         if (i ^= 0)
         then do;
	  num = num * 10 + i - 1;
	  ifi = ifi + 1;
         end;
         ifi = ifi + 2;
         if (num <= argct)
         then call putout(ofp, ofe, arg);
      end;
      else do;
         ch_2nd = inputa (ifi + 1);
         if (ch_2nd = "{")
         then call arg_range (ifp, ifi, ife, ofp, ofe, TF);

         else if (ch_2nd = "*")
         then do;
	  ifi = ifi + 2;
	  call putout (ofp, ofe, ltrim (char (argct)));
         end;

         else if (ch_2nd = ".")	/* &. null separator	       */
         then ifi = ifi + 2;

         else if (ch_2nd = "+")	/* &+ null separator,	       */
         then call strip2 (ifp, ifi, ife); /*  grabs trailing space	       */

         else if (ch_2nd = "[")
         then call macro_af (ifp, ifi, ife, ofp, ofe, TF);

         else if (ch_2nd = "(")
         then call arithmetic (ifp, ifi, ife, ofp, ofe, TF);

         else if (ch_2nd = """")
         then call protected (ifp, ifi, ife, ofp, ofe);

         else if (ch_2nd = ";")
         then do;
	  c32 = "&;";
	  return;
         end;

         else if (ch_2nd = "&")
         then do;
	  ifi = ifi + 2;
	  call putout (ofp, out_len, "&");
         end;
         else do;
variable:
	  i = verify (substr (input, ifi + 1), token_chars);

	  if (i = 0)
	  then i = ife - ifi + 1;
	  if (i > 1)
	  then do;
	     if (i > 26)
	     then do;
	        msg = who_am_i;
	        msg = msg || " name > 26 chars.";
	        goto add_identification;
	     end;
	     c32 = substr (input, ifi + 1, i - 1);
	     c32x = "";

	     if (inputa (ifi + i) = "$")
	     then do;
	        ifi = ifi + i;
	        ii = verify (substr (input, ifi + 1), token_chars);
	        if (ii = 0)
	        then i = 0;		/* error			       */
	        else if (inputa (ifi + ii) = "(")
	        then do;
		 i = ii;
		 c32x = c32;
		 c32 = substr (input, ifi + 1, i - 1);
	        end;
	     end;

	     if (inputa (ifi + i) = "(") & (ife > ifi + i)
	     then do;
	        ifi = ifi + i + 1;
	        call macro_call (ifp, ifi, ife, ofp, ofe, TF);
	     end;

	     else if (inputa (ifi + i) = "{") & (ife > ifi + i)
	     then do;
	        ifi = ifi + i + 1;
	        call var_range (ifp, ifi, ife, ofp, ofe, TF);
	     end;

/* arg */
	     else if (c32 = "lbound")
	     then call var_bound (ifp, ifi, ife, ofp, ofe, TF);
	     else if (c32 = "hbound")
	     then call var_bound (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "empty")
	     then call macro_empty (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "error")
	     then call macro_error (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "comment")
	     then do;
	        i = index (substr (input, ifi), "&;");
	        if (i = 0)
	        then do;
		 msg = "&;";
		 call error_missing ("comment", begl, ife);
	        end;
	        ifi = ifi + i + 1;
	        return;
	     end;

	     else if (c32 = "usage")
	     then call macro_usage (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "quote")
	     then call macro_quote (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "unquote")
	     then call macro_unquote (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "return")
	     then do;
	        segi = sege + 1;
	        goto quit;
	     end;

	     else if (c32 = "scan")
	     then call macro_scan (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "define")
	     then call macro_define (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "substr")
	     then call macro_substr (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "length")
	     then call macro_length (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "let")
	     then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 0);

	     else if (c32 = "ext")
	     then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 1);

	     else if (c32 = "int")
	     then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 2);

	     else if (c32 = "loc")
	     then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 3);

	     else if (c32 = "do")
	     then call macro_do (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "if")
	     then call macro_if (ifp, ifi, ife, ofp, ofe, TF);

	     else if (c32 = "od")
		   | (c32 = "fi")
		   | (c32 = "then")
		   | (c32 = "else")
		   | (c32 = "elseif")
		   | (c32 = "while")
	     then do;
	        c32 = "&" || c32;
	        if ^err_sw
	        then goto misplaced;
	        return;
	     end;

	     else if (c32 = "expand")
	     then do;
	        start_sym = "expand";
	        end_sym = "expend";
	        goto macdef;
	     end;
	     else if (c32 = "macro")
	     then do;
	        start_sym = "macro";
	        end_sym = "mend";
macdef:
	        if construct_nest > 1
	        then do;
macnest_err:
		 msg = "&";
		 msg = msg || start_sym;
		 msg = msg || " may not be nested in any other construct.";
		 goto add_id;
	        end;
	        ifi = ifi + i;
	        if (substr (input, ifi, 1) ^= " ")
	        then do;
macdef_err:
		 call error_syntax ((start_sym), begl, ifi);
	        end;
	        ifi = ifi + 1;
	        i = verify (substr (input, ifi),
		 "abcdefghijklmnopqrstuvwxyz" ||
		 "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789");
	        if (i = 0)
	        then goto macdef_err;
	        if (i < 2)
	        then do;
		 msg = "name";
		 call error_missing ((start_sym), begl, ifi);
	        end;
	        i = i - 1;
	        c32 = substr (input, ifi, i);
	        ifi = ifi + i;
	        if (inputa (ifi) ^= NL)
	        then goto macdef_err;
	        ifi = ifi + 1;
	        i = index (substr (input, ifi), "&" || end_sym || NL);
	        if (i = 0)
	        then do;
no_mend:
		 msg = "&";
		 msg = msg || end_sym;
		 msg = msg || "<NL>";
		 call error_missing ((start_sym), begl, ife);
	        end;
	        if (index (substr (input, ifi, i - 1), "&macro ") ^= 0)
		 | (index (substr (input, ifi, i - 1), "&expand ") ^= 0)
	        then goto no_mend;
	        call hcs_$fs_get_path_name (ifp, dname, 0, ename, 0);
	        call addmacro ("  &" || start_sym || " in " || myname, "",
		 c32, "1"b, ifp, ifi, ifi + i - 2);
	        ifi = ifi + i + length (end_sym) + 1;
	     end;
	     else do;
	        call var_ref (ifp, ifi, ife, ofp, ofe, TF);
	        ifi = ifi + i;
	     end;
	  end;
	  else do;
	     msg = "Unrecognized &control """;
	     msg = msg || c32;
	     msg = msg || """. ";
	     goto add_identification;
	  end;
         end;
      end;
   end ampersand; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* parse an argument range specification.			       */

arg_range: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl separator	char (150) var;

/* &{ ARITH }			yields argument ARITH	       */
/* &{ ARITH : ARITH } 		yields arguments ARITH thru ARITH    */
/*                                          separated by a SP	       */
/* &{ ARITH : ARITH , STRING }	yields arguments ARITH thru ARITH    */
/*                                          separated by STRING	       */

      begl = ifi;
      ii = ofe;
      i = 1;
      j = argct;
      call get_range (ifp, ifi, ife, ofp, ofe, TF, i, j);
      separator = " ";
      if (inputa (ifi) = ",")
      then do;
         ifi = ifi + 1;
         do while ("1"b);
	  jj = search (substr (input, ifi), "&}");
	  if (jj = 0)
	  then do;
	     msg = "}";
	     call error_missing ("{", begl, ife);
	  end;
	  if (jj > 1)
	  then do;
	     jj = jj - 1;
	     call putout (ofp, ofe, substr (input, ifi, jj));
	     ifi = ifi + jj;
	  end;
	  if (inputa (ifi) = "}")
	  then do;
	     separator = substr (output, ii + 1, ofe - ii);
	     ofe = ii;
	     goto end_range;
	  end;
	  call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
         end;
      end;
      if (inputa (ifi) = "}")
      then do;
end_range:
         ifi = ifi + 1;
         if (TF = "00"b)
         then return;
         j = min (j, argct);
         do num = i to j;
	  call putout (ofp, ofe, arg);
	  if (num ^= j)
	  then call putout (ofp, ofe, (separator));
         end;
      end;
      else do;
         call error_syntax ("{", begl, ifi);
      end;
   end arg_range; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* process an arithmetic expression.				       */

arithmetic: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl level		fixed bin (24);
dcl (vl, sl)	fixed bin (24);
dcl val		(20) fixed dec (59, 9);
dcl stk		(20) fixed bin (24);
dcl pic60		pic "(49)-9v.(9)9";
dcl v		fixed dec (59, 9);

      ifi, begl = ifi + 2;
      if db_sw then call dumper ("arth", ifp, ifi, ife, ofp, ofe, TF);
      ii = ofe;
      call putout (ofp, ofe, "(");
      level = 1;
      construct_nest = construct_nest + 1;
loop:
      i = search (substr (input, ifi), "&(),:}");
      if (i = 0)
      then do;
         msg = "Missing arithmetic terminator. ";
         goto add_identification;
      end;
      if (i > 1)
      then do;
         i = i - 1;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      goto type (index ("&(),:}", inputa (ifi)));

type (1):				/* & */ /* */
      if (substr (input, ifi, 2) = "&;")
      then goto type (4);		/* It stops scan, but is not used up */
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      goto loop;

type (2):				/* ( */ /* */
      call putout (ofp, ofe, "(");
      level = level + 1;
      ifi = ifi + 1;
      goto loop;

type (4):				/* , */ /* */
type (5):				/* : */ /* */
type (6):				/* } */ /* */
      if (level > 1)
      then goto arith_err;
      ifi = ifi - 1;		/* don't want to use up this char    */
type (3):				/* ) */ /* */
      call putout (ofp, ofe, ")");
      ifi = ifi + 1;
      level = level - 1;
      if (level > 0)
      then goto loop;
      construct_nest = construct_nest - 1;

      if (TF = "00"b)
      then do;
         ofe = ii;
         return;
      end;

      sl = 1;
      vl = 0;
      stk (1) = 16;

      if db_sw | tr_sw
      then do;
         call ioa_$nnl ("#^a:^a^-arith ", lineno (begl), lineno (ifi - 1));
         call show_string (substr (output, ii + 1), NL);
      end;
      do i = ii + 1 to ofe;
				/* format: off */
/*                                       "---------1111111111222222	22 2   */
/*                                       "---------0123456789012345	67 8   */
dcl arithchar char (28) int static init ("0123456789(=^=<=>=+-*/) 	.""
"); /* format: on */
         j = index (arithchar, substr (output, i, 1));
         if (j = 0)
         then do;
	  jj = verify (substr (output, i),
	     "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789");
	  if (jj = 0)
	  then jj = ife - ifi + 1;
	  if (jj = 1)
	  then goto arith_err;
	  goto arith_err;
         end;
retry:
         if lg_sw
         then if db_sw
	    then do;
	       call ioa_ ("^3i :^1a:", i, substr (output, i, 1));
	       do jj = 1 to sl;
		call ioa_$nnl (" ^1a",
		   substr (arithchar, stk (jj), 1));
	       end;
	       call ioa_ (".");
	       do jj = 1 to vl;
		call ioa_$nnl (" ^f", val (jj));
	       end;
	       call ioa_ ("#");
	    end;
         if (j > 10)
         then goto type (j);

type (26):			/* decimal point */
         jj = verify (substr (output, i), ".0123456789") - 1;
         if (jj < 0)
         then jj = ofe - i + 1;
         vl = vl + 1;
         val (vl) = convert (val (1), substr (output, i, jj));
         sl = sl + 1;
         stk (sl) = 10;
         i = i + jj - 1;
         goto endloop;

type (23):			/* ) */ /* */
         if (stk (sl) ^= 10)
         then goto arith_err;
         goto calc (stk (sl - 1));

type (13):			/* ^ */ /* */
type (15):			/* < */ /* */
type (17):			/* > */ /* */
         if (substr (output, i + 1, 1) = "=")
         then do;
	  i = i + 1;
	  j = j + 1;
         end;
         if (j = 13)
         then goto type (11);
type (14):			/* ^= */ /* */
type (16):			/* <= */ /* */
type (18):			/* >= */ /* */
type (12):			/* = */ /* */
type (21):			/* * */ /* */
type (22):			/* / */ /* */
         if (stk (sl) ^= 10)
         then do;
type (27):			/* quoted string not handled yet     */
arith_err:
	  msg = "Arithmetic syntax error. ";
	  msg = msg || substr (arithchar, stk (sl), 1);
	  msg = msg || substr (arithchar, j, 1);
	  msg = msg || " """;
	  msg = msg || substr (output, ii + 1, i - ii);
	  msg = msg || """ ";
	  goto add_identification;
         end;

type (19):			/* + */ /* */
type (20):			/* - */ /* */
         if (stk (sl) = 21)
         then goto arith_err;
         if (stk (sl) = 22)
         then goto arith_err;
         if (stk (sl) > 10)
         then do;
	  vl = vl + 1;
	  val (vl) = 0;
	  sl = sl + 1;
	  stk (sl) = 10;
         end;
         if (stk (sl - 1) >= j)
         then goto calc (stk (sl - 1));
         sl = sl + 1;
         stk (sl) = j;
         goto endloop;

type (11):			/* ( */ /* */
         if (stk (sl) = 10)
         then goto arith_err;
         sl = sl + 1;
         stk (sl) = j;
         goto endloop;

calc (12):			/* =  */ /* */
         if (val (vl - 1) = val (vl))
         then v = 1;
         else v = 0;
         goto calc_common;


calc (13):			/* ^  */ /* */
         if (val (vl) = 0)
         then val (vl) = 1;
         else val (vl) = 0;
         sl = sl - 1;
         stk (sl) = 10;
         goto retry;


calc (14):			/* ^= */ /* */
         if (val (vl - 1) ^= val (vl))
         then v = 1;
         else v = 0;
         goto calc_common;


calc (15):			/* <  */ /* */
         if (val (vl - 1) < val (vl))
         then v = 1;
         else v = 0;
         goto calc_common;


calc (16):			/* <= */ /* */
         if (val (vl - 1) <= val (vl))
         then v = 1;
         else v = 0;
         goto calc_common;


calc (17):			/* >  */ /* */
         if (val (vl - 1) > val (vl))
         then v = 1;
         else v = 0;
         goto calc_common;


calc (18):			/* >= */ /* */
         if (val (vl - 1) >= val (vl))
         then v = 1;
         else v = 0;
         goto calc_common;


calc (19):			/* + */ /* */
         v = val (vl - 1) + val (vl);
         goto calc_common;

calc (20):			/* - */ /* */
         v = val (vl - 1) - val (vl);
         goto calc_common;

calc (21):			/* * */ /* */
         v = val (vl - 1) * val (vl);
         goto calc_common;

calc (22):			/* / */ /* */
         v = val (vl - 1) / val (vl);
calc_common:
         vl = vl - 1;
         val (vl) = v;
         sl = sl - 2;
         stk (sl) = 10;
         goto retry;


calc (11):			/* ( */ /* */
         if (j = 23)
         then do;
	  sl = sl - 1;
	  stk (sl) = 10;
	  goto endloop;
         end;
         goto arith_err;

type (24):			/* SP */ /* */
type (25):			/* HT */ /* */
type (28):			/* NL */ /* */
endloop:
      end;
      ofe = ii;
      call putout (ofp, ofe,
         ltrim (rtrim (rtrim (convert (pic60, val (1)), "0"), ".")));
   end arithmetic; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* convert a text string for debug display.			       */

cvt: proc (ifp, ifi, ife) returns (char (32) var);

dcl res		char (32) var;
dcl ifp		ptr;
dcl (ifi, ife)	fixed bin (24);
dcl i		fixed bin (24);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl ch		char (1);

      res = """";
      do i = ifi to min (ifi + 15, ife);
         ch = inputa (i);
         if (ch < " ")
         then ch = "~";
         res = res || ch;
      end;
      res = res || """";
      return (res);

   end cvt; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* show a bunch of debugging information.			       */

dumper: proc (text, ifp, ifi, ife, ofp, ofe, TF);

dcl text		char (4),
    ifp		ptr,
    (ifi, ife)	fixed bin (24),
    ofp		ptr,
    ofe		fixed bin (24),
    TF		bit (2);

      call ioa_ ("^2i.^2i ^4a TF^.1b ^i:^i ^i^-^a - ^a", macro_nest,
         construct_nest, text, TF, ifi, ife, ofe,
         cvt (ifp, ifi, ife), cvt (ofp, max (1, ofe - 15), ofe));

   end dumper; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* ERROR MESSAGE procs					       */

error_missing: proc (who, begl, endl);

dcl who		char (*),
    begl		fixed bin (24),
    endl		fixed bin (24);

dcl hold		char (1000) var;
dcl (cline, eline)	char (6) var;

      hold = "Missing ";
      hold = hold || msg;
      goto common;

error_syntax: entry (who, begl, endl);

      hold = "Syntax error";
      goto common;

error_misplaced: entry (who, begl, endl);

      hold = "Misplaced ";
      hold = hold || msg;
      goto common;

error_gen: entry (who, begl, endl);

      hold = msg;
      goto common;

error_attempt: entry (who, begl, endl);

      hold = "Attempt to ";
      hold = hold || msg;
      goto common;

common:
      hold = hold || " in """;
      cline = lineno (begl);
      eline = lineno (endl);

      msg = "
ERROR SEVERITY 4. ";
      msg = msg || who_am_i;
      msg = msg || " """;
      msg = msg || myname;
      msg = msg || """, line ";
      msg = msg || eline;
      msg = msg || ".
      ";
      msg = msg || hold;
      msg = msg || "&";
      msg = msg || who;
      msg = msg || """";
      if (eline ^= cline)
      then do;
         msg = msg || " (on line ";
         msg = msg || cline;
         msg = msg || ")";
      end;
      msg = msg || ".";
      ecode = error_table_$badsyntax;
      goto exit;

   end error_missing; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* expand a specified string					       */

expand: proc (ifp, ifi, ife, ofp, ofe, tf);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    tf		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);


      if db_sw then call dumper ("expn", ifp, ifi, ife, ofp, ofe, tf);
      do while (ifi <= ife);
         i = index (substr (input, ifi), "&");
         if (i = 0)
         then i = ife - ifi + 1;
         else i = i - 1;
         if (i > 0)
         then do;
	  call putout (ofp, out_len, substr (input, ifi, i));
	  ifi = ifi + i;
         end;
         if (ifi > ife)
         then return;
         ii = ifi;
         call ampersand (ifp, ifi, ife, ofp, ofe, tf, "1"b);
         if (ii = ifi)
         then return;
      end;
   end expand; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* search for the macro specified				       */

find_macro: proc (refp, segname, suffix, macname);
dcl refp		ptr,
    segname	char (32) var,
    suffix	char (32) var,
    macname	char (32) var;

dcl initiate_file_	entry (char(*), char(*), bit(*), ptr, fixed bin(24),
		fixed bin(35));
dcl search_paths_$find_dir entry (char (*), ptr, char (*), char (*), char (*),
		fixed bin (35));
dcl search_for	char (35) var;

      if (segname = "")
      then search_for = macname;
      else search_for = segname;
      search_for = search_for || "." || suffix;

      if (refp = null ())
      then ref_path = "";
      else call hcs_$fs_get_path_name (refp, ref_path, 0, "", 0);
      if db_sw
      then call ioa_ ("find_macro ^a ^a (^a)", search_for, macname, ref_path);
      call search_paths_$find_dir ((suffix), null (), (search_for), ref_path,
         dname, ecode);
      if (ecode = error_table_$no_search_list)
      then do;
dcl hcs_$make_ptr	entry (ptr, char (*), char (*), ptr, fixed bin (35));
here:    call hcs_$make_ptr (codeptr (here), suffix || ".search",
	  suffix || ".search", segptr, ecode); /* fudge a little */
         if (segptr = null ())
         then call com_err_ (0, (suffix),
	       "Default search segment not in same directory as object segment.");
         else call search_paths_$find_dir ((suffix), null (), (search_for),
	       ref_path, dname, ecode);
      end;
      if (ecode = 0)
      then call initiate_file_ (dname, (search_for), "100"b, segptr, bc,
         ecode);
      if (ecode ^= 0)
      then do;
         msg = "No definition segment found. ";
         msg = msg || search_for;
         msg = msg || "$";
         msg = msg || macname;
         ecode = -1;
         goto exit;
      end;
      segi = 1;
      sege = divide (bc, 9, 24, 0);
      if mac_sw
      then do;
         if (suffix = "macro")
         then i = index (seg, "&macro " || macname || NL);
         else i = index (seg, "&expand " || macname || NL);
         if (i = 0)
         then do;
	  msg = "No definition found for """;
bad_mac:
	  msg = msg || macname;
	  msg = msg || """ ";
	  msg = msg || "in ";
	  msg = msg || rtrim (dname);
	  msg = msg || ">";
	  msg = msg || search_for;
	  ecode = -1;
	  goto exit;
         end;
         segi = i + length (macname) + 8;
         if (suffix = "macro")
         then i = index (substr (seg, segi), "&mend
");
         else do;
	  segi = segi + 1;		/* &expand 1 char>than &macro	       */
	  i = index (substr (seg, segi), "&expend
");
         end;
         if (i = 0)
         then do;
	  if (suffix = "macro")
	  then msg = "&mend";
	  else msg = "&expand";
	  msg = msg || " missing on """;
	  goto bad_mac;
         end;

         sege = segi + i - 2;
         call addmacro (dname, before (search_for, "."), (macname), "0"b,
	  segptr, segi, sege);
         if (segname = "")
         then do;

/* now all that is fine and dandy, but we don't want to let &b() find an     */
/* external b$b because nothing has been internally defined and then later   */
/* have the same thing find a different macro because there now has been an  */
/* internal macro/define encountered. So we dummy up a pseudo-internal entry */
/* to nip such a thing in the bud.				       */

	  call addmacro ("", before (search_for, "."), (macname), "1"b,
	     segptr, segi, sege);
         end;
      end;

   end find_macro; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* free all the storage used					       */

free_um: proc (which);

dcl which		char (3);

      do while (tptr ^= null ());
         var_ptr = tptr;
         tptr = var.next;
         if (var.type = 0)
         then do;
	  if db_sw
	  then do;
	     call ioa_ ("^p	^a ^a", var_ptr, which, var.name);
	     if var.ref ^= null ()
	     then call ioa_ ("  ^p	""^a""", var.ref,
		   vartext);
	  end;
	  if (var.ref ^= null ())
	  then do;
	     if al_sw then call ioa_ ("F ^p ""^a""", var.ref,
		   vartext);
	     free vartext in (free_area);
	  end;
         end;
         if (var.type >= 1) & (var.type <= 5)
         then do;
	  arr_ptr = var.ref;
	  if db_sw
	  then call ioa_ ("^p	^a ^a{^i:^i}", var_ptr, which,
		var.name, array.lower, array.lower + var.len - 1);
	  do arr_elem = 1 to var.len;
	     if (array.ref (arr_elem) ^= null ())
	     then do;
	        if al_sw
	        then call ioa_ ("^p	{^i} ""^a""",
		      array.ref (arr_elem),
		      -array.lower + arr_elem - 1, arrtext);
	        free arrtext in (free_area);
	     end;
	  end;
         end;
         if al_sw then call ioa_ ("F var-^a ^p", var.name, var_ptr);
         free var in (free_area);
      end;

   end free_um; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* set up an area						       */

get_area: proc;

      ai.version = area_info_version_1;
      string (ai.control) = "0"b;
      ai.extend = "1"b;
      ai.owner = sl_name;
      ai.size = 2000;
      ai.areap = null ();
      call define_area_ (addr (ai), ecode);
      free_area_p = ai.areap;

%include area_info;
dcl 1 ai		like area_info;

   end get_area; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* parse an array range specification.				       */

get_range: proc (ifp, ifi, ife, ofp, ofe, TF, i, j);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);

      if (inputa (ifi + 2) = "}")
         | (inputa (ifi + 2) = ",")
      then do;
         ifi = ifi + 2;
         return;
      end;
      ii = ofe;
      call arithmetic (ifp, ifi, ife, ofp, ofe, TF);
      i, j = fixed (substr (output, ii + 1, ofe - ii));
      ofe = ii;
      if (inputa (ifi) = ":")
      then do;
         ifi = ifi - 1;
         call arithmetic (ifp, ifi, ife, ofp, ofe, TF);
         j = fixed (substr (output, ii + 1, ofe - ii));
         ofe = ii;
      end;

   end get_range; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* parse the next input token					       */

get_token: proc (ifp, ifi, ife);

dcl ifp		ptr,
    ifi		fixed bin (24),
    ife		fixed bin (24);
dcl input		char (ife) based (ifp);

      call strip (ifp, ifi, ife);
      if (substr (input, ifi, 1) ^= "&")
      then do;
         c32 = "";
         return;
      end;
      i = verify (substr (input, ifi + 1), "abcdefghijklmnopqrstuvwxyz");
      if (i = 0)
      then i = ife - ifi + 1;
      else if (i = 1)
      then i = 2;
      c32 = substr (input, ifi, i);

   end get_token; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* determine and format the line number of a given point in a segment	       */

lineno: proc (segi) returns (char (6) var);

dcl segi		fixed bin (24);

dcl c6		pic "zzzzz9";
dcl cv6		char (6) var;
dcl j		fixed bin (24);
dcl line		fixed bin (24);
dcl e		fixed bin (24);

      line = 0;
      i = 1;
      e = min (segi, sege);
      do while (i <= segi);
         line = line + 1;
         j = index (substr (seg, i), NL);
         if (j = 0)
         then i = sege + 1;
         else i = i + j;
      end;
      cv6 = ltrim (char (line));
      return (cv6);

   end lineno; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* process a logical expression				       */

logical: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj, kk) fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl sep_ct	fixed bin (24);
dcl argstrl	fixed bin (24);
dcl rel		fixed bin (24);

      jj = ofe;
      construct_nest = construct_nest + 1;
      call strip (ifp, ifi, ife);
      begl = ifi;
loop:
      i = search (substr (input, ifi), "&=^<>");
      if (i = 0)
      then do;
log_err:
         msg = "Missing termination of logical expression. ";
         goto add_identification;
      end;
      if (i > 1)
      then do;
         i = i - 1;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      rel = index ("&=^=<^>=", inputa (ifi));
      goto type (rel);

type (1):				/* & */ /* & */
      if (substr (input, ifi, 5) = "&then")
         | (substr (input, ifi, 2) = "&;")
      then do;
         kk = ofe;
         if db_sw | tr_sw
         then do;
	  call ioa_$nnl ("#^a:^a^-log-^.1b (", lineno (begl), lineno (ifi - 1),
	     TF);
	  call show_string (substr (output, jj + 1, kk - jj), ")
");
         end;
         ofe = jj;
         if (TF = "00"b)
         then return;
         c32 = translate (substr (output, jj + 1, kk - jj),
	  "  ABCDEFGHIJKLMNOPQRSTUVWXYZ", "
	abcdefghijklmnopqrstuvwxyz");
         if (c32 = "0")
	  | (c32 = "FALSE")
	  | (c32 = "F")
	  | (c32 = "NO")
         then TF = "01"b;
         else TF = "10"b;
         return;
      end;
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      goto loop;
type (3):				/* ^ */ /* ^ */
type (5):				/* < */ /* < */
type (7):				/* > */ /* > */
      if (inputa (ifi + 1) = "=")
      then do;
         rel = rel + 1;
         ifi = ifi + 1;
      end;
      else if (rel = 3)
      then do;
         ifi = ifi + 1;
         call putout (ofp, ofe, "^");
         goto loop;
      end;
type (2):				/* = */ /* = */
				/* 2 = 	4 ^=		       */
				/* 5 <    6 <=		       */
				/* 7 >	8 >=		       */
      ifi = ifi + 1;
      ii = ofe;
loop1:
      call strip (ifp, ifi, ife);
      j = index (substr (input, ifi), "&") -1;
      if (j < 0)
      then goto log_err;
      if (j > 0)
      then do;
         call putout (ofp, ofe, substr (input, ifi, j));
         ifi = ifi + j;
      end;
      if (substr (input, ifi, 5) = "&then")
         | (substr (input, ifi, 2) = "&;")
      then do;
         construct_nest = construct_nest - 1;
         kk = ofe;
         if db_sw | tr_sw
         then do;
	  call ioa_$nnl ("#^a:^a^-log-^.1b (", lineno (begl),
	     lineno (ifi - 1), TF);
	  call show_string (substr (output, jj + 1, ii - jj), "");
	  call ioa_$nnl (")^a(", relat (rel));
	  call show_string (substr (output, ii + 1, kk - ii), ")
");
         end;
         ofe = jj;
         if (TF = "00"b)
         then return;
dcl relat		(2:8) char (2) int static
		init ("=", "!!", "^=", "<", "<=", ">", ">=");
         goto comp (rel);
      end;
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      goto loop1;

comp (2):
      if (substr (output, jj + 1, ii - jj) = substr (output, ii + 1, kk - ii))
      then TF = "10"b;
      else TF = "01"b;
      return;

comp (4):
      if (substr (output, jj + 1, ii - jj) ^= substr (output, ii + 1, kk - ii))
      then TF = "10"b;
      else TF = "01"b;
      return;

comp (5):
      if (substr (output, jj + 1, ii - jj) < substr (output, ii + 1, kk - ii))
      then TF = "10"b;
      else TF = "01"b;
      return;

comp (6):
      if (substr (output, jj + 1, ii - jj) <= substr (output, ii + 1, kk - ii))
      then TF = "10"b;
      else TF = "01"b;
      return;

comp (7):
      if (substr (output, jj + 1, ii - jj) > substr (output, ii + 1, kk - ii))
      then TF = "10"b;
      else TF = "01"b;
      return;

comp (8):
      if (substr (output, jj + 1, ii - jj) >= substr (output, ii + 1, kk - ii))
      then TF = "10"b;
      else TF = "01"b;
      return;

   end logical; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* look up a specified name in the variable lists			       */

lookup: proc (vname) returns (fixed bin) recursive;

dcl vname		char (32) var;

/* first look up local variables				       */

      var_ptr = local_var_ptr;
      do while (var_ptr ^= null ());
         if (var.name = vname)
         then return (3);
         var_ptr = var.next;
      end;

/* then look up internal static variables			       */

      if (int_var_ptr = null ())
      then do;
         int_var_ptr = int_vars_base;
         do while (int_var_ptr ^= null ());
	  if (macname = int_vars.macro)
	  then goto found;
	  else int_var_ptr = int_vars.next;
         end;
         allocate int_vars in (free_area);
         if al_sw
         then call ioa_ ("A int_vars ^a^i ^p", macname, size (int_vars),
	       int_var_ptr);
         int_vars.next = int_vars_base;
         int_vars.ref = null ();
         int_vars.macro = macname;
         int_vars_base = int_var_ptr;
      end;

found:
      var_ptr = int_vars.ref;
      do while (var_ptr ^= null ());
         if (var.name = vname)
         then return (2);
         var_ptr = var.next;
      end;

/* then look up external static variables */

      var_ptr = ext_var_ptr;
      do while (var_ptr ^= null ());
         if (var.name = vname)
         then return (1);
         var_ptr = var.next;
      end;

      return (0);
   end lookup; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* handle the active function call				       */

macro_af: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl level		fixed bin (24);

/* &[ ... ] */

      begl = ifi;
      ifi = ifi + 2;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("af..", ifp, ifi, ife, ofp, ofe, TF);
      ii = ofe;
      level = 1;
      construct_nest = construct_nest + 1;
loop:
      i = search (substr (input, ifi), "&[]");
      if (i = 0)
      then do;
         msg = "]";
         call error_missing ("[", begl, ife);
      end;
      if (i > 1)
      then do;
         i = i - 1;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      goto type (index ("&[]", inputa (ifi)));

type (1):				/* & */ /* */
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      if (c32 = "&;")
      then goto misplaced;
      goto loop;

type (2):				/* [ */ /* */
      call putout (ofp, ofe, "[");
      ifi = ifi + 1;
      level = level + 1;
      goto loop;

type (3):				/* ] */ /* */
      call putout (ofp, ofe, "]");
      ifi = ifi + 1;
      level = level - 1;
      if (level > 0)
      then goto loop;

      construct_nest = construct_nest - 1;
      ofe = ofe - 1;
      if (TF = "00"b)
      then do;
         ofe = ii;
         return;
      end;
      varlen = 500;
dcl varlen	fixed bin;
      begin;
dcl rval		char (varlen) var;
         rval = "";
dcl cu_$evaluate_active_string entry (ptr, char(*), fixed bin, char(*) var,
		fixed bin(35));
%include cp_active_string_types;
         call cu_$evaluate_active_string (null (),
	  substr (output, ii + 1, ofe - ii),
	  ATOMIC_ACTIVE_STRING, rval, ecode);
         if (ecode ^= 0)
         then do;
	  err_ct = 0;
	  msg = "Processing active functtion. ";
	  msg_etc = substr (output, ii + 1, ofe - ii);
	  goto add_id;
         end;
         ofe = ii;
         call putout (ofp, ofe, (rval));
      end;
      return;

   end macro_af; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* handle a macro call					       */

macro_call: proc (ifp, ifi, ife, ofp, ofe, TF) recursive;

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(100) fixed bin (24);
dcl (sep_ct, level) fixed bin (24);
dcl argstrl	fixed bin (24);
dcl callseg	char (32) var;
dcl callmac	char (32) var;

/*    &xxx( ... , ... , ...) */
/* &xxx$yy( ... , ... , ...) */

      begl = ifi;
      callseg = c32x;
      callmac = c32;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("call", ifp, ifi, ife, ofp, ofe, TF);
      ii = ofe;
      call putout (ofp, ofe, "(");
      loc (1) = ofe;
      sep_ct = 1;
      level = 1;
      construct_nest = construct_nest + 1;
loop:
      i = search (substr (input, ifi), "&(),");
      if (i = 0)
      then do;
         msg = ")";
         call error_missing (callmac || "(", begl, ife);
      end;
      if (i > 1)
      then do;
         i = i - 1;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      goto type (index ("&(),", inputa (ifi)));

type (1):				/* & */ /* */
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      if (c32 = "&;")
      then do;
         msg = "&;";
         call error_misplaced ("call", begl, ife);
      end;
      goto loop;

type (2):				/* ( */ /* */
      call putout (ofp, ofe, "(");
      ifi = ifi + 1;
      level = level + 1;
      goto loop;

type (3):				/* ) */ /* */
      call putout (ofp, ofe, ")");
      ifi = ifi + 1;
      level = level - 1;
      if (level > 0)
      then goto loop;

      construct_nest = construct_nest - 1;
      loc (sep_ct + 1) = ofe;
      argstrl = ofe - loc (1) + 1;
      if (argstrl > 16384)
      then do;
         msg = "&call arg-string > 16384 chrs.";
         goto add_identification;
      end;
      begin;
dcl 1 args	(sep_ct) like argl;
dcl argstr	(argstrl) char (1) unal;
         if db_sw | tr_sw
         then do;
	  call ioa_$nnl ("#^a:^a^-call ^a$^a ", lineno (begl),
	     lineno (ifi - 1), callseg, callmac);
	  call show_string (substr (output, loc (1), argstrl), NL);
         end;
         string (argstr) = substr (output, loc (1), argstrl);
         ofe = loc (1) - 1;
         if (argstrl = 2)
         then sep_ct = 0;
         do i = 1 to sep_ct;
	  args.l (i) = loc (i + 1) - loc (i) - 1;
	  j = loc (i) - ofe + 1;
	  args.p (i) = addr (argstr (j));
         end;
         call macro_ (sl_name, callseg, callmac,
	  ofp, ofe, addr (args), (sep_ct), msg, ifp, ecode);
         if (ecode = -1)
         then call error_gen ("call", begl, ifi);
         if (ecode ^= 0)
         then do;
	  ifi = begl;
	  call_err = "1"b;
	  goto add_id;
         end;
      end;
      return;

type (4):				/* , */ /* */
      call putout (ofp, ofe, ",");
      ifi = ifi + 1;
      if (level = 1)
      then do;
         if (sep_ct >= 100)
         then do;
	  msg = "Cannot handle over 100 ";
	  msg = msg || who_am_i;
	  msg = msg || " arguments.";
	  goto add_identification;
         end;
         sep_ct = sep_ct + 1;
         loc (sep_ct) = ofe;
         call strip (ifp, ifi, ife);
      end;
      goto loop;
   end macro_call; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* dynamically define a macro					       */

macro_define: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl sep_ct	fixed bin (24);
dcl argstrl	fixed bin (24);

/* &define ... &dend */

      begl = ifi;
      ifi = ifi + 7;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("defi", ifp, ifi, ife, ofp, ofe, TF);
      ii = ofe;
      construct_nest = construct_nest + 1;
loop:
      i = index (substr (input, ifi), "&");
      if (i = 0)
      then do;
         msg = "&dend";
         call error_missing ("define", begl, ife);
      end;
      if (i > 1)
      then do;
         i = i - 1;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      if (substr (input, ifi, 5) = "&dend")
      then do;
         ifi = ifi + 5;
         call strip (ifp, ifi, ife);
         if (TF & "10"b)
         then do;
	  i = ii + 1;
	  i = i + verify (substr (output, i, ofe - i + 1), space) - 1;
	  j = verify (substr (output, i, ofe - i + 1),
	     "abcdefghijklmnopqrstuvwxyz" ||
	     "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789");
	  if (j = 0)
	  then do;
def_err:
	     call error_syntax ("define", begl, ifi);
	  end;
	  if (j < 2)
	  then do;
	     msg = "macroname";
	     call error_missing ("define", begl, ifi);
	  end;
	  j = j - 1;
	  c32 = substr (output, i, j);
	  i = i + j;
	  if (substr (output, i, 1) ^= NL)
	  then goto def_err;
	  macro_holder_l = ofe - i;
	  allocate macro_holder in (free_area);
	  macro_holder = substr (output, i + 1, macro_holder_l);
	  if db_sw | tr_sw
	  then do;
	     call ioa_$nnl ("#^a:^a^-&define ^a^/^-", lineno (begl),
	        lineno (ifi - 1), c32);
	     call show_string (macro_holder, "&dend
");
	  end;
	  call addmacro ("  &define'ed in " || myname || "  ", "", c32, "1"b,
	     macro_holder_p, 1, macro_holder_l);
         end;
         ofe = ii;
         construct_nest = construct_nest - 1;
         return;
      end;
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      goto loop;
   end macro_define; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* handle the iteration construct				       */

macro_do: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl tf		bit (2);

/* &do EXPAND &while LOGICAL &; EXPAND &od */
/* LOGICAL ::= arithmetic | compare */

      begl = ifi;
      ifi = ifi + 3;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("do..", ifp, ifi, ife, ofp, ofe, TF);
      if (TF = "00"b)
      then goto skip;
      ii = ifi;
      jj = 0;
      construct_nest = construct_nest + 1;
loop:
      call expand (ifp, ifi, ife, ofp, ofe, (TF));
      if (c32 = "&while")
      then do;
         ifi = ifi + length (c32);
         jj = 1;
         tf = TF;
         call logical (ifp, ifi, ife, ofp, ofe, tf);
         call get_token (ifp, ifi, ife);
         if (c32 ^= "&;")
         then do;
	  msg = "&;";
	  call error_missing ("while", begl, ifi);
         end;
         ifi = ifi + length (c32);
         call strip (ifp, ifi, ife);
         if (tf = "01"b)
         then do;
skip:
	  i = index (substr (input, ifi), "&");
	  if (i = 0)
	  then do;
	     msg = "&od";
	     call error_missing ("do", begl, ife);
	  end;
	  ifi = ifi + i - 1;
	  call get_token (ifp, ifi, ife);
	  if (c32 = "&do")
	  then call macro_do (ifp, ifi, ife, ofp, ofe, "00"b);
	  else if (c32 = "&""")
	  then call protected (ifp, ifi, ife, ofp, (ofe));
	  else if (c32 = "&od")
	  then do;
	     jj = 0;
	     goto od;
	  end;
	  else ifi = ifi + 1;
	  goto skip;
         end;
         goto loop;
      end;
      if (c32 = "&od")
      then do;
od:
         ifi = ifi + length (c32);
         call strip (ifp, ifi, ife);
         if (jj = 0)
         then do;
	  construct_nest = construct_nest - 1;
	  return;
         end;
         ifi = ii;
         goto loop;
      end;
      msg = c32;
      call error_misplaced ("do", begl, ifi);
   end macro_do; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* make a list or array var be empty again			       */

macro_empty: proc (ifp, ifi, ife, ofp, ofe, TF);
dcl ifp		ptr,
    ifi		fixed bin (24),
    ife		fixed bin (24),
    ofp		ptr,
    ofe		fixed bin (24),
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl tf		bit (2);
dcl vname		char (32) var;

/* &empty name &; */

      begl = ifi;
      ifi = ifi + 6;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("empt", ifp, ifi, ife, ofp, ofe, TF);
      i = verify (substr (input, ifi),
         "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789");
      if (i = 0)
      then i = ife - ifi + 1;
      if (i = 1)
      then do;
         msg = "array name";
         call error_missing ("empty", begl, ifi);
      end;
      vname = substr (input, ifi, i - 1);
      if (length (vname) > 16)
      then do;
         msg = """";
         msg = msg || vname;
         msg = msg || """ > 16 characters.";
         call error_gen ("empty", begl, ifi);
      end;
      ifi = ifi + length (vname);
      call strip (ifp, ifi, ife);
      if (substr (input, ifi, 2) ^= "&;")
      then do;
         msg = "&;";
         call error_missing ("empty", begl, ifi);
      end;
      call strip2 (ifp, ifi, ife);
      i = lookup (vname);
      if (i = 0)
      then do;
         msg = """";
         msg = msg || vname;
         msg = msg || """ undefined.";
         call error_gen ("empty", begl, ifi);
      end;
      if (var.type = 0)
      then do;
         msg = """";
         msg = msg || vname;
         msg = msg || """ is a scalar.";
         call error_gen ("empty", begl, ifi);
      end;
      arr_ptr = var.ref;
				/* free any allocated strings */
      if (var.type = 2)
      then do;
         array.h_bound = array.lower - 1;
         array.l_bound = array.lower + var.len;
      end;
      if (var.type = 3)
      then do;
         array.l_bound = 1;
         array.h_bound = 0;
      end;
   end macro_empty; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* print a user specified error message				       */

macro_error: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl sep_ct	fixed bin (24);
dcl argstrl	fixed bin (24);
dcl ch8		pic "-------9";

/* &error ARITH , ... &; */

      begl = ifi;
      ifi = ifi + 6;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("err.", ifp, ifi, ife, ofp, ofe, TF);
      ii = ofe;
      msg = "";
      construct_nest = construct_nest + 1;
      ifi = ifi - 2;
      call arithmetic (ifp, ifi, ife, ofp, ofe, TF);

      if (ofe ^= ii + 1)
         | (substr (output, ofe, 1) < "0")
         | (substr (output, ofe, 1) > "4")
      then do;
         ofe = ii;
         call putout (ofp, ofe, "4(Invalid &error severity, 4 assumed.) ");
      end;
      call strip (ifp, ifi, ife);
      if (inputa (ifi) ^= ",")
      then call putout (ofp, ofe, "(Missing comma after &error severity.) ");
      else ifi = ifi + 1;
loop:
      i = index (substr (input, ifi), "&") -1;
      if (i < 0)
      then do;
         msg = "&;";
         call error_missing ("error", begl, ife);
      end;
      if (i > 0)
      then do;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      if (substr (input, ifi, 2) = "&;")
      then do;
         call strip2 (ifp, ifi, ife);
         i = index ("01234", substr (output, ii + 1, 1)) - 1;
         err_ct (i) = err_ct (i) + 1;
         msg = NL;
         if (i = 0)
         then msg = msg || "NOTE: ";
         else if (i = 1)
         then msg = msg || "WARNING. ";
         else do;
	  msg = msg || "ERROR SEVERITY ";
	  msg = msg || substr (output, ii + 1, 1);
	  msg = msg || ". ";
         end;
         msg = msg || who_am_i;
         msg = msg || " """;
         msg = msg || macname;
         msg = msg || """, line ";
         msg = msg || lineno (ifi);
         msg = msg || NL;
         call iox_$put_chars (iox_$error_output, addrel (addr (msg), 1),
	  length (msg), 0);
         msg = "";
         substr (output, ofe + 1, 1) = NL;
         call iox_$put_chars (iox_$error_output,
	  addr (substr (output, ii + 2, 1)), ofe - ii, 0);
         if (i = 4)
         then do;
	  msg = "Error detected by ";
	  msg = msg || who_am_i;
	  msg = msg || " """;
	  msg = msg || macname;
	  msg = msg || """.";
	  ecode = error_table_$translation_aborted;
	  goto exit;
         end;
         ofe = ii;
         construct_nest = construct_nest - 1;
         return;
      end;
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      goto loop;

dcl iox_$error_output ptr ext static;
dcl iox_$put_chars	entry (ptr, ptr, fixed bin (21), fixed bin (35));
   end macro_error; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* handle the "if then [elseif] ... [else] fi" construct		       */

macro_if: proc (ifp, ifi, ife, ofp, ofe, tf);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    tf		bit (2);		/* 1x- process true		       */
				/* x1- process false	       */
				/* value not returned (modified)     */
dcl begl		fixed bin (24);
dcl beglt		fixed bin (24);
dcl skip_sw	bit (1);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl TF		bit (2);
dcl if_lineno	char (6) var;
dcl elseif	bit (1);


/* &if LOGICAL &then EXPAND {&elseif EXPAND} ... {&else EXPAND} &fi */

      begl, beglt = ifi;
      ifi = ifi + 3;
      call strip (ifp, ifi, ife);
      TF = tf;
      if db_sw then call dumper ("if..", ifp, ifi, ife, ofp, ofe, TF);
      elseif = "0"b;
      if_lineno = lineno (begl);

nother_logical:
      call logical (ifp, ifi, ife, ofp, ofe, TF);
      if (tf = "00"b)
      then TF = "00"b;
      if db_sw | tr_sw
      then call ioa_ ("#^a:^a^-&^[else^]if (^a) ^[skip^;F^;T^;TF^]",
	    lineno (beglt), lineno (ifi - 1), elseif, if_lineno,
	    fixed (TF) + 1);
      call get_token (ifp, ifi, ife);
      if (c32 ^= "&then")
      then do;
         msg = "&then";
         call error_missing ("if", begl, ifi);
      end;
      beglt = ifi;
      ifi = ifi + length (c32);
      call strip (ifp, ifi, ife);
      construct_nest = construct_nest + 1;
      if (TF & "10"b)
      then call expand (ifp, ifi, ife, ofp, ofe, (TF));
      else call skipper;
      if db_sw | tr_sw
      then call ioa_ ("#^a:^a^-&then (^a) ^[done^;skip^]", lineno (beglt),
	    lineno (ifi - 1), if_lineno, (TF & "10"b));
skip_again:
      beglt = ifi;
      if (c32 = "&elseif")
      then do;
         ifi = ifi + length (c32);
         call strip (ifp, ifi, ife);
         if (TF & "01"b)
         then do;
	  construct_nest = construct_nest - 1;
	  elseif = "1"b;
	  goto nother_logical;
         end;
         call skipper;
         if db_sw | tr_sw
         then call ioa_ ("#^a:^a^-&elseif (^a) skip",
	       lineno (beglt), lineno (ifi - 1), if_lineno);
         goto skip_again;
      end;
      if (c32 = "&else")
      then do;
         ifi = ifi + length (c32);
         call strip (ifp, ifi, ife);
         if (TF & "01"b)
         then call expand (ifp, ifi, ife, ofp, ofe, (TF));
         else call skipper;
         if db_sw | tr_sw
         then call ioa_ ("#^a:^a^-&else (^a) ^[done^;skip^]",
	       lineno (beglt), lineno (ifi - 1), if_lineno, TF & "01"b);
         beglt = ifi;
      end;
      if (c32 ^= "&fi")
      then do;
         msg = "&fi";
         call error_missing ("if", begl, ifi);
      end;
      construct_nest = construct_nest - 1;
      ifi = ifi + length (c32);
      call strip (ifp, ifi, ife);
      if db_sw | tr_sw
      then call ioa_ ("#^a:^a^-&fi (^a)",
	    lineno (beglt), lineno (ifi - 1), if_lineno);
      return;

skipper: proc;

      do while ("1"b);
         i = index (substr (input, ifi), "&");
         if (i = 0)
         then do;
	  c32 = "";
	  return;
         end;
         ifi = ifi + i - 1;
         call get_token (ifp, ifi, ife);
         if (c32 = "&if")
         then call macro_if (ifp, ifi, ife, ofp, ofe, "00"b);
         else if (c32 = "&fi")
         then return;
         else if (c32 = "&else")
         then return;
         else if (c32 = "&elseif")
         then return;
         else if (c32 = "&""")
         then call protected (ifp, ifi, ife, ofp, (ofe));
         else ifi = ifi + 1;
      end;

   end;

   end macro_if; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* return the length of a string				       */

macro_length: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl sep_ct	fixed bin (24);
dcl argstrl	fixed bin (24);

/* &length ... &; */

      begl = ifi;
      ifi = ifi + 7;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("leng", ifp, ifi, ife, ofp, ofe, TF);
      ii = ofe;
      construct_nest = construct_nest + 1;
loop:
      i = index (substr (input, ifi), "&") -1;
      if (i < 0)
      then do;
         msg = "&;";
         call error_missing ("length", begl, ife);
      end;
      if (i > 0)
      then do;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      if (substr (input, ifi, 2) = "&;")
      then do;
         call strip2 (ifp, ifi, ife);
         i = ofe - ii;
         ofe = ii;
         call putout (ofp, ofe, ltrim (char (i)));
         construct_nest = construct_nest - 1;
         return;
      end;
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      goto loop;
   end macro_length; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* process loc/int/ext/let statements (they look very much alike	       */

macro_let: proc (ifp, ifi, ife, ofp, ofe, TF, which) recursive;

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2),
    which		fixed bin (24);	/* 0-let, 1-ext, 2-int, 3-loc */
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl vname		char (32) var;
dcl vptr		ptr;
dcl found		fixed bin (24);
dcl (lower, higher) fixed bin (24);

/* &let var = EXPR &;
   &ext var = EXPR &;
   &ext var &;
   &int var = EXPR &;
   &int var &;
   &loc var = EXPR &;
   &loc var &; */
/* EXPR ::= arithmetic | string */

      begl = ifi;
      ifi = ifi + 4;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper (cmd (which), ifp, ifi, ife, ofp, ofe, TF);
      i = verify (substr (input, ifi, 1),
         "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ");
      if (i ^= 0)
      then do;
         msg = "Variable name must begin with alphabetic char. ";
         call error_gen (cmd (which), begl, ifi);
      end;
      i = verify (substr (input, ifi),
         "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789");
      if (i = 0)
      then i = ife - ifi + 1;
      else i = i - 1;
      vname = substr (input, ifi, i);
      if (i > 16)
      then do;
         msg = "Data name > 16 characters. ";
         goto add_identification;
      end;
      ifi = ifi + i;
dcl reserved	(29) char (8) int static init (
		"arg",
		"comment",
		"define",
		"dend",
		"do",
		"else",
		"elseif",
		"empty",
		"error",
		"expand",
		"expend",
		"ext",
		"fi",
		"hbound",
		"if",
		"int",
		"let",
		"lbound",
		"length",
		"loc",
		"macro",
		"mend",
		"quote",
		"return",
		"scan",
		"substr",
		"unquote",
		"usage",
		"while");
      do i = 1 to hbound (reserved, 1);
         if (vname = reserved (i))
         then do;
	  msg = "Attempt to use reserved word """;
	  msg = msg || vname;
	  msg = msg || """ as variable. ";
	  goto add_identification;
         end;
      end;
      found = lookup (vname);
      if (found < which)
      then do;
         allocate var in (free_area) set (var_ptr);
         if al_sw
         then call ioa_ ("A var-^a ^i ^p", vname, size (var), var_ptr);
         var.name = vname;
         var.ref = null ();
         var.type = 0;
         var.len = 0;
         if (which = 1)
         then do;
	  var.next = ext_var_ptr;
	  ext_var_ptr = var_ptr;
	  if db_sw
	  then call ioa_ ("^p	ext ""^a""", var_ptr, var.name);
         end;
         else if (which = 2)
         then do;
	  var.next = int_vars.ref;
	  int_vars.ref = var_ptr;
	  if db_sw
	  then call ioa_ ("^p	int.^a ""^a""", var_ptr, macname,
		var.name);
         end;
         else do;
	  var.next = local_var_ptr;
	  local_var_ptr = var_ptr;
	  if db_sw
	  then call ioa_ ("^p	loc ""^a""", var_ptr, var.name);
         end;
      end;
      else if (found = 0)
      then do;
         msg = "Attempt to set undeclared variable """;
         msg = msg || vname;
         msg = msg || """. ";
         goto add_identification;
      end;
      vptr = var_ptr;
      call strip (ifp, ifi, ife);
      if (which > 0)
      then if (substr (input, ifi, 2) = "&;")
	 then do;
	    call strip2 (ifp, ifi, ife);
	    return;
	 end;
      if (inputa (ifi) = "{")
      then do;
         ifi = ifi - 1;
         if (var.type = 0)
         then do;
	  lower, higher = -9999;
         end;
         else do;
	  arr_ptr = var.ref;
	  lower = array.l_bound;
	  higher = array.h_bound;
         end;
         call get_range (ifp, ifi, ife, ofp, ofe, TF, lower, higher);
         if (inputa (ifi) ^= "}")
         then do;
	  msg = "}";
	  call error_missing (cmd (which), begl, ifi);
         end;
         ifi = ifi + 1;
         call strip (ifp, ifi, ife);
         var_ptr = vptr;
         if (which > 0)		/*  not let */
         then do;
	  if (lower = higher)
	  then do;
	     if (lower < 1)
	     then do;
	        msg = "Improper dimension. ";
	        goto add_identification;
	     end;
	     lower = 1;
	  end;
	  if (found ^= which)
	  then do;
	     var.type = 1;
	     var.len = higher - lower + 1;
	     allocate array in (free_area) set (arr_ptr);
	     var.ref = arr_ptr;
	     if al_sw
	     then call ioa_ ("A^a{^i:^i} ^i ^p", vname, lower,
		   higher, size (array), var.ref);
	     do arr_elem = 1 to var.len;
	        array.ref (arr_elem) = null ();
	        array.len (arr_elem) = 0;
	     end;
	     array.lower = lower;
	  end;
	  if (substr (input, ifi, 3) = "var")
	  then do;
	     ifi = ifi + 3;
	     if (found = which)
	     then do;
	        if (var.type ^= 2)
		 | (array.lower ^= lower)
		 | (var.len ^= higher - lower + 1)
	        then do;
dcl_err:
		 msg = "Data declaration does not match prior declaration for """;
		 msg = msg || vname;
		 msg = msg || """. ";
		 goto add_identification;
	        end;
	     end;
	     else do;
	        var.type = 2;
	        array.l_bound = higher + 1;
	        array.h_bound = lower - 1;
	     end;
	  end;
	  else if (substr (input, ifi, 4) = "list")
	  then do;
	     ifi = ifi + 4;
	     if (found = which)
	     then do;
	        if (var.type ^= 3)
		 | (var.len ^= higher)
	        then goto dcl_err;
	     end;
	     else do;
	        var.type = 3;
	        array.l_bound = 1;
	        array.h_bound = 0;
	     end;
	  end;
	  else if (substr (input, ifi, 4) = "fifo")
	  then do;
	     ifi = ifi + 4;
	     if (found = which)
	     then do;
	        if (var.type ^= 4)
		 | (array.l_bound ^= lower)
		 | (array.h_bound ^= higher)
	        then goto dcl_err;
	     end;
	     else do;
	        var.type = 4;
	        array.l_bound = 1;
	        array.h_bound = 0;
	     end;
	  end;
	  else if (substr (input, ifi, 4) = "lifo")
	  then do;
	     ifi = ifi + 4;
	     if (found = which)
	     then do;
	        if (var.type ^= 5)
		 | (array.l_bound ^= lower)
		 | (array.h_bound ^= higher)
	        then goto dcl_err;
	     end;
	     else do;
	        var.type = 5;
	        array.l_bound = 1;
	        array.h_bound = 0;
	     end;
	  end;
	  else do;
	     if (found = which)
	     then do;
	        if (var.type ^= 1)
		 | (array.l_bound ^= lower)
		 | (array.h_bound ^= higher)
	        then goto dcl_err;
	     end;
	     else do;
	        array.l_bound = lower;
	        array.h_bound = higher;
	     end;
	  end;
	  call strip (ifp, ifi, ife);
         end;
         else do;
	  if (var.type ^= 1) & (var.type ^= 2)
	  then do;
	     msg = "Attempt to do array assignment to non-array variable. ";
	     goto add_identification;
	  end;
	  arr_ptr = var.ref;
	  if (lower < array.lower)
	  then do;
	     msg = "Attempt to set below lower bound. ";
	     goto add_identification;
	  end;
	  if (higher > array.lower + var.len - 1)
	  then do;
	     msg = "Attempt to set above upper bound. ";
	     goto add_identification;
	  end;
         end;
         call strip (ifp, ifi, ife);
         if (which > 0)
         then if (substr (input, ifi, 2) = "&;")
	    then do;
	       call strip2 (ifp, ifi, ife);
	       return;
	    end;
      end;
      else do;
         if (var.type = 1)
	  | (var.type = 2)
         then do;
	  msg = "Attempt to do scalar assignment to array variable. ";
	  goto add_identification;
         end;
         if (var.type = 4)		/*  fifo */
         then do;
	  arr_ptr = var.ref;
	  if (array.l_bound + var.len - 1 > array.h_bound)
	  then do;
	     msg = "Out-of-bounds on fifo """;
	     msg = msg || vname;
	     msg = msg || """. ";
	     goto add_identification;
	  end;
	  if (array.l_bound + var.len - 1 = array.h_bound)
	  then do;
	     msg = "Attempt to stack too many elements. ";
	     goto add_identification;
	  end;
	  array.h_bound = array.h_bound + 1;
	  lower, higher = mod (array.h_bound, var.len) + 1;
         end;
         if (var.type = 5)
         then do;
	  arr_ptr = var.ref;
	  if (var.len < array.h_bound)
	  then do;
	     msg = "Out-of-bounds on lifo """;
	     msg = msg || vname;
	     msg = msg || """. ";
	     goto add_identification;
	  end;
	  if (var.len = array.h_bound)
	  then do;
	     msg = "Attempt to stack too many elements. ";
	     goto add_identification;
	  end;
	  array.h_bound, lower, higher = array.h_bound + 1;
         end;
      end;
      if (inputa (ifi) ^= "=")
      then do;
         msg = "=";
         call error_missing (cmd (which), begl, ifi);
dcl cmd		(0:3) char (4) int static init ("let ", "ext ", "int ", "loc ");
      end;
      ifi = ifi + 1;
      call strip (ifp, ifi, ife);
      jj = ofe;
      if (inputa (ifi) = "(")
      then do;
         msg = "Vector assignment not available yet.";
         call error_gen (cmd (which), begl, ifi);
      end;
      if (substr (input, ifi, 2) = "&(")
      then do;
         call arithmetic (ifp, ifi, ife, ofp, ofe, TF);
         call strip (ifp, ifi, ife);
      end;
      else do;
         construct_nest = construct_nest + 1;
loop:
         i = index (substr (input, ifi), "&") -1;
         if (i < 0)
         then do;
	  msg = "&;";
	  call error_missing (cmd (which), begl, ife);
         end;
         if (i > 0)
         then do;
	  call putout (ofp, ofe, substr (input, ifi, i));
	  ifi = ifi + i;
         end;
         if (substr (input, ifi, 2) ^= "&;")
         then do;
	  call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
	  goto loop;
         end;
         construct_nest = construct_nest - 1;
      end;
      if (substr (input, ifi, 2) ^= "&;")
      then do;
         msg = "&;";
         call error_missing (cmd (which), begl, ife);
      end;
      call strip2 (ifp, ifi, ife);
      if (found = 0)
         | (which = 0)
      then do;
         j = ofe - jj;
         var_ptr = vptr;
         if (var.type = 0)
         then do;
	  if (var.len ^= j)
	  then do;
	     if (var.len > 0)
	     then do;
	        if al_sw
	        then call ioa_ ("F ^a ^i ^p", vname, var.len,
		      var.ref);
	        free vartext in (free_area);
	     end;
	     var.len = j;
	     allocate vartext in (free_area) set (var.ref);
	     if al_sw
	     then call ioa_ ("A ^a ^i ^p", vname, size (vartext),
		   var.ref);
	  end;
	  vartext = substr (output, jj + 1, j);
	  if db_sw | tr_sw
	  then do;
	     call ioa_$nnl ("#^a:^a^-&^a ^a =", lineno (begl),
	        lineno (ifi - 1), cmd (which), var.name);
	     call show_string (vartext, "&;
");
	  end;
         end;
         else do;
	  arr_ptr = var.ref;
	  if (var.type = 2)
	  then do;
	     array.l_bound = min (array.l_bound, lower);
	     array.h_bound = max (array.h_bound, higher);
	  end;
	  if (var.type = 3)
	  then do;
	     do arr_elem = array.l_bound to array.h_bound;
	        if (arrtext = substr (output, jj + 1, j))
	        then do;
		 ofe = jj;
		 return;
	        end;
	     end;
	     if (array.h_bound = var.len)
	     then do;
	        msg = "Attempt to add too many elements to list. ";
	        goto add_identification;
	     end;
	     array.h_bound, lower, higher = array.h_bound + 1;
	  end;
	  do arr_elem = lower - array.lower + 1 to higher - array.lower + 1;
	     if (array.len (arr_elem) ^= j)
	     then do;
	        if (array.ref (arr_elem) ^= null ())
	        then do;
		 if al_sw
		 then call ioa_ ("F ^a{^i} ^i ^p", vname,
		         arr_elem, array.len (arr_elem),
		         array.ref (arr_elem));
		 free arrtext in (free_area);
	        end;
	        array.len (arr_elem) = j;
	        allocate arrtext in (free_area) set (array.ref (arr_elem));
	        if al_sw
	        then call ioa_ ("A ^a{^i} ^i ^p", vname,
		      arr_elem, size (arrtext),
		      array.ref (arr_elem));
	     end;
	     arrtext = substr (output, jj + 1, j);
	  end;
	  if db_sw | tr_sw
	  then do;
	     call ioa_$nnl ("#^a:^a^-&^a ^a{^i:^i} =", lineno (begl),
	        lineno (ifi - 1), cmd (which), var.name, lower, higher);
	     call show_string (substr (output, jj + 1, j), "&;
");
	  end;
         end;
      end;
      ofe = jj;
   end macro_let; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* double any quotes in a string				       */

macro_quote: proc (ifp, ifi, ife, ofp, ofe, tf);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    tf		bit (2);		/* 1x- process true		       */
				/* x1- process false	       */
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl inside	bit (1);
dcl ch		char (1);

/* &quote ... &; */

      begl = ifi;
      ifi = ifi + 6;
      call strip (ifp, ifi, ife);
      ii = ofe;
      construct_nest = construct_nest + 1;
loop:
      i = index (substr (input, ifi), "&") -1;
      if (i < 0)
      then do;
         msg = "&;";
         call error_missing ("quote", begl, ife);
      end;
      if (i > 0)
      then do;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + 1;
      end;
      if (substr (input, ifi, 2) ^= "&;")
      then do;
         call ampersand (ifp, ifi, ife, ofp, ofe, tf, "0"b);
         goto loop;
      end;
      call strip2 (ifp, ifi, ife);
      i = ofe - ii;
      if (i > 16384)
      then do;
         msg = "Sorry, not yet handling &quote strings > 16384 chrs.";
         goto add_identification;
      end;
      construct_nest = construct_nest - 1;
      if (index (substr (output, ii + 1, i), """") = 0)
      then do;
         return;
      end;
      begin;
dcl argstr	char (i);
         argstr = substr (output, ii + 1, i);
         ofe = ii;
         j = 1;
loop:
         ii = index (substr (argstr, j), """");
         if (ii = 0)
         then ii = i - j + 1;
         call putout (ofp, ofe, substr (argstr, j, ii));
         j = j + ii;
         if (substr (output, ofe, 1) = """")
         then call putout (ofp, ofe, """");
         if (j > i)
         then return;
         goto loop;
      end;
   end macro_quote; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* rescan a result of macro expansion				       */

macro_scan: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl sep_ct	fixed bin (24);
dcl argstrl	fixed bin (24);

/* &scan ... &; */

      begl = ifi;
      ifi = ifi + 5;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("scan", ifp, ifi, ife, ofp, ofe, TF);
      ii = ofe;
      construct_nest = construct_nest + 1;
loop:
      i = index (substr (input, ifi), "&") -1;
      if (i < 0)
      then do;
         msg = "&;";
         call error_missing ("scan", begl, ife);
      end;
      if (i > 0)
      then do;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      if (substr (input, ifi, 2) = "&;")
      then do;
         call strip2 (ifp, ifi, ife);
         argstrl = ofe - ii;
         if (argstrl > 16384)
         then do;
	  msg = "&scan string > 16384 chars.";
	  goto add_identification;
         end;
         begin;
dcl argstr	char (argstrl);
	  if db_sw | tr_sw
	  then do;
	     call ioa_$nnl ("#^a:^a^-&scan ", lineno (begl), lineno (ifi - 1));
	     call show_string (substr (output, ii + 1, argstrl), "&;
");
	  end;
	  string (argstr) = substr (output, ii + 1, argstrl);
	  ofe = ii;
	  call expand (addr (argstr), 1, argstrl, ofp, ofe, (TF));
	  construct_nest = construct_nest - 1;
	  return;
         end;
      end;
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      goto loop;
   end macro_scan; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* return part of a string with needed padding			       */

macro_substr: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl sep_ct	fixed bin (24);
dcl argstrl	fixed bin (24);

/* &substr ... , ARITH , ARITH &;
   &substr ... , ARITH &;
   &substr ... , ARITH : ARITH &; */

      begl = ifi;
      ifi = ifi + 7;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("subs", ifp, ifi, ife, ofp, ofe, TF);
      ii = ofe;
      construct_nest = construct_nest + 1;
loop:
      i = search (substr (input, ifi), "&,") -1;
      if (i < 0)
      then do;
         msg = "&;";
         call error_missing ("substr", begl, ife);
      end;
      if (i > 0)
      then do;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      if (inputa (ifi) = "&")
      then do;
         call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
         goto loop;
      end;
      argstrl = ofe - ii;
      if (argstrl > 16384)
      then do;
         msg = "&substr string > 16384 chrs.";
         goto add_identification;
      end;
      begin;
dcl argstr	char (argstrl);
dcl sepch		char (1);
         argstr = substr (output, ii + 1, argstrl);
         ofe = ii;
         ifi = ifi - 1;
         call arithmetic (ifp, ifi, ife, ofp, ofe, TF);
         i = fixed (substr (output, ii + 1, ofe - ii));
         sepch = " ";
         ofe = ii;
         if (inputa (ifi) = ",")
	  | (inputa (ifi) = ":")
         then do;
	  sepch = inputa (ifi);
	  ifi = ifi - 1;
	  call arithmetic (ifp, ifi, ife, ofp, ofe, TF);
	  j = fixed (substr (output, ii + 1, ofe - ii));
	  ofe = ii;
         end;
         if (substr (input, ifi, 2) ^= "&;")
         then goto misplaced;
         call strip2 (ifp, ifi, ife);
         if (TF ^= "00"b)
         then do;
	  if (i < 0)
	  then i = argstrl + i + 1;
	  if (sepch = " ")
	  then j = argstrl - i + 1;
	  if (sepch = ":")
	  then do;
	     if (j < 1)
	     then do;
	        msg = "Substr end location <0. ";
	        goto add_identification;
	     end;
	     if (j < i)
	     then do;
	        msg = "Substr end before begin. ";
	        goto add_identification;
	     end;
	     j = j - i + 1;
	  end;
	  if (j < 0)
	  then do;
	     jj = (argstrl - i + 1) + j;
	     if (jj < 0)
	     then do;
	        substr (output, ofe + 1, -jj) = " ";
	        ofe = ofe - jj;
	        j = -j + jj;
	     end;
	     else j = -j;
	  end;
	  if (i < 1)
	  then do;
	     msg = "Substr before string begin. ";
	     goto add_identification;
	  end;
	  if (i > argstrl)
	  then do;
	     msg = "Substr after string end. ";
	     msg_etc = ltrim (char (i));
	     msg_etc = msg_etc || ",";
	     msg_etc = msg_etc || ltrim (char (j));
	     msg_etc = msg_etc || " of ";
	     msg_etc = msg_etc || ltrim (char (argstrl));
	     msg_etc = msg_etc || """";
	     msg_etc = msg_etc || argstr;
	     msg_etc = msg_etc || """";
	     goto add_identification;
	  end;
	  jj = min (argstrl-i+1, j);
	  call putout (ofp, ofe, substr (argstr, i, jj));
	  if (j > jj)
	  then call putout (ofp, ofe, copy (" ",j-jj));
         end;
      end;
      construct_nest = construct_nest - 1;
   end macro_substr; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* remove doubled quotes and surrounding quotes (if any) from a string       */

macro_unquote: proc (ifp, ifi, ife, ofp, ofe, tf);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    tf		bit (2);		/* 1x- process true		       */
				/* x1- process false	       */
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl inside	bit (1);
dcl ch		char (1);

/* &unquote ... &; */

      begl = ifi;
      ifi = ifi + 8;
      call strip (ifp, ifi, ife);
      ii = ofe;
      construct_nest = construct_nest + 1;
loop:
      i = index (substr (input, ifi), "&") -1;
      if (i < 0)
      then do;
         msg = "&;";
         call error_missing ("unquote", begl, ife);
      end;
      if (i > 0)
      then do;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + 1;
      end;
      if (substr (input, ifi, 2) ^= "&;")
      then do;
         call ampersand (ifp, ifi, ife, ofp, ofe, tf, "0"b);
         goto loop;
      end;
      call strip2 (ifp, ifi, ife);
      construct_nest = construct_nest - 1;
      i = ii;
      inside = "0"b;
      do ii = ii + 1 to ofe;
         ch = substr (output, ii, 1);
         if (ch = """")
         then do;
	  if inside
	  then do;
	     if (substr (output, ii + 1, 1) = """")
	     then do;
	        ii = ii + 1;
	        goto use_char;
	     end;
	     else inside = "0"b;
	  end;
	  else inside = "1"b;
         end;
         else do;
use_char:
	  i = i + 1;
	  substr (output, i, 1) = ch;
         end;
      end;
      ofe = i;

   end macro_unquote; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* show the macros used up to this point			       */

macro_usage: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl sep_ct	fixed bin (24);
dcl argstrl	fixed bin (24);
dcl ctl		char (100) var;
dcl ret_str	char (256);
dcl ret_len	fixed bin (24);
dcl ioa_$rsnpnnl	entry options (variable);

/* &usage string &; */

      begl = ifi;
      ifi = ifi + 6;
      call strip (ifp, ifi, ife);
      if db_sw then call dumper ("usag", ifp, ifi, ife, ofp, ofe, TF);
      ii = ofe;
      construct_nest = construct_nest + 1;
loop:
      i = index (substr (input, ifi), "&") -1;
      if (i < 0)
      then do;
         msg = "&;";
         call error_missing ("usage", begl, ife);
      end;
      if (i > 0)
      then do;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      if (substr (input, ifi, 2) = "&;")
      then do;
         call strip2 (ifp, ifi, ife);
         ctl = substr (output, ii + 1, ofe - ii);
         ofe = ii;
         do maclp = macro_list_p
	  repeat (macro_list.next)
	  while (maclp ^= null ());
	  call ioa_$rsnpnnl (ctl, ret_str, ret_len,
	     macro_list.dname, macro_list.ename,
	     macro_list.name);
	  call putout (ofp, ofe, substr (ret_str, 1, ret_len));
         end;
         construct_nest = construct_nest - 1;
         return;
      end;
      call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
      goto loop;
   end macro_usage; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* put a string into the output, making sure the length is updated before    */
/*  placing the data therein.					       */

putout: proc (ofp, ofe, str);

dcl ofp		ptr,		/* points to receiver	  (IN) */
    ofe		fixed bin (24),	/* length of receiver          (OUT) */
    str		char (*);		/* string to insert             (IN) */

dcl output	char (ofe) based (ofp);
dcl tofe		fixed bin (24);

      tofe = ofe + 1;
      ofe = ofe + length (str);
      substr (output, tofe, length (str)) = str;
      if dt_sw & db_sw
      then call ioa_ ("^i,^i `^va'", tofe, length (str), length (str), str);

end putout;

/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* process a protected string					       */

protected: proc (ifp, ifi, ife, ofp, ofe);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24);	/* last char of output used	       */
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl sep_ct	fixed bin (24);
dcl argstrl	fixed bin (24);

/* &" ... {&"&"} ... &" */

      begl = ifi;
      ifi = ifi + 2;
      do while ("1"b);
         i = index (substr (input, ifi), "&""") -1;
         if (i < 0)
         then do;
	  msg = "&""";
	  call error_missing ("""", begl, ife);
         end;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i + 2;
         if (substr (input, ifi, 2) ^= "&""")
         then return;
         call putout (ofp, ofe, "&""");
         ifi = ifi + 2;
      end;
   end protected; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* scan a string and print it indenting 1 HT.			       */

show_string: proc (str1, str2);

dcl (str1, str2)	char (*);
dcl (i, j, k)	fixed bin (24);
dcl HT_sw		bit (1);

      i = 1;
      do while (i <= length (str1));
         j = index (substr (str1, i), NL);
         if (j = 0)
         then do;
	  j = length (str1) - i + 1;
	  HT_sw = "0"b;
         end;
         else HT_sw = "1"b;
         k = i + j;
         call ioa_$nnl ("^a^[^-^]", substr (str1, i, j), HT_sw);
         i = k;
      end;
      call ioa_$nnl ("^a", str2);

   end show_string; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* skip over whitespace. strip2 moves ahead 2 first		       */

strip2: proc (ifp, ifi, ife);

      ifi = ifi + 2;

strip: entry (ifp, ifi, ife);

dcl ifp		ptr,
    ifi		fixed bin (24),
    ife		fixed bin (24);
dcl input		char (ife) based (ifp);

dcl i		fixed bin (24);

loop:
      i = verify (substr (input, ifi), space);
      if (i = 0)
      then ifi = ife + 1;
      else ifi = ifi + i - 1;
      if (substr (input, ifi, 1) ^= "&")
      then return;
      i = verify (substr (input, ifi + 1), token_chars);
      if (substr (input, ifi + 1, i) ^= "comment")
      then return;
      i = index (substr (input, ifi), "&;");
      if (i = 0)
      then do;
         msg = "&;";
         call error_missing ("comment", ifi, ifi + 8);
      end;
      ifi = ifi + i + 1;
      goto loop;			/* keep on stripping	       */

   end strip2; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* return the lbound/hbound of an array				       */

var_bound: proc (ifp, ifi, ife, ofp, ofe, TF) recursive;

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl (sep_ct, level) fixed bin (24);
dcl argstrl	fixed bin (24);
dcl vname		char (32) var;

/* &lbound xxx&;
   &hbound xxx&; */
      ii = ofe;
      call strip (ifp, ifi, ife);
loop:
      i = index (substr (input, ifi), "&") -1;
      if (i < 0)
      then do;
         msg = "Missing terminator on &";
         msg = msg || c32;
         msg = msg || ". ";
         goto add_identification;
      end;
      if (i > 0)
      then do;
         call putout (ofp, ofe, substr (input, ifi, i));
         ifi = ifi + i;
      end;
      if (substr (input, ifi, 2) ^= "&;")
      then do;
         call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
         goto loop;
      end;
      vname = substr (output, ii + 1, ofe - ii);
      ofe = ii;
      j = lookup (vname);
      if (j = 0)
      then do;
         msg = "Attempt to reference undeclared variable """;
         msg = msg || vname;
         msg = msg || """. ";
         goto add_identification;
      end;
      if (var.type = 0)
      then do;
         msg = "Attempt to get ";
         msg = msg || c32;
         msg = msg || " of a scalar. ";
         goto add_identification;
      end;
      arr_ptr = var.ref;
      if (var.type = 1)		/* array			       */
         | (var.type = 2)		/* array var		       */
         | (var.type = 3)		/* list			       */
      then do;
         if (c32 = "lbound")
         then i = array.l_bound;
         else i = array.h_bound;
      end;
      if (var.type = 4)		/* fifo			       */
         | (var.type = 5)		/* lifo			       */
      then do;
         msg = "Cannot get ";
         msg = msg || c32;
         msg = msg || " of ";
         if (var.type = 5)
         then msg = msg || "l";
         else msg = msg || "f";
         msg = msg || "ifo.";
         goto add_identification;
      end;
   end var_bound; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/*							       */

var_range: proc (ifp, ifi, ife, ofp, ofe, TF);

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl separator	char (150) var;
dcl vptr		ptr;
dcl limit		fixed bin;

/* &var{ ARITH }			yields argument ARITH	       */
/* &var{ ARITH : ARITH } 		yields arguments ARITH thru ARITH    */
/* 				      separated by a SP	       */
/* &var{ ARITH : ARITH , STRING }	yields arguments ARITH thru ARITH    */
/* 				      separated by STRING	       */

      begl = ifi;
      ii = ofe;
      i = lookup (c32);
      if (i = 0)
      then do;
         msg = "Attempt to reference undeclared array. ";
         goto add_identification;
      end;
      if (var.type = 0)
      then do;
         msg = "Attempt to make non-scalar ref to scalar variable """;
         msg = msg || c32;
         msg = msg || """. ";
         goto add_identification;
      end;
      vptr = var_ptr;
      arr_ptr = var.ref;
      i = array.l_bound;
      j = array.h_bound;
      ifi = ifi - 2;
      call get_range (ifp, ifi, ife, ofp, ofe, TF, i, j);
      var_ptr = vptr;
      arr_ptr = var.ref;
      if (TF ^= "00"b)
      then do;
         if (var.type = 4)
	  | (var.type = 5)
         then do;
	  if (i ^= j)
	  then do;
	     msg = "Attempt to make multiple ref to stack """;
	     msg = msg || c32;
	     msg = msg || """. ";
	     goto add_identification;
	  end;
	  if (i > 0)
	  then do;
	     msg = "Attempt to ref positive stack element """;
	     msg = msg || c32;
	     msg = msg || """. ";
	     goto add_identification;
	  end;
	  if (var.type = 4)
	  then do;
	     i, j = array.l_bound - i;
	     if (i > array.h_bound)
	     then do;
	        msg = "Attempt to ref non-existant stack element in """;
	        msg = msg || c32;
	        msg = msg || """. ";
	        goto add_identification;
	     end;
	  end;
	  else do;
	     i, j = array.h_bound + i;
	     if (i < array.l_bound)
	     then do;
	        msg = "Attempt to ref non-existant stack element in """;
	        msg = msg || c32;
	        msg = msg || """. ";
	        goto add_identification;
	     end;
	  end;
         end;
         else do;
	  if (i < array.l_bound)
	  then do;
	     msg = "Attempt to reference below lower bound. ";
	     goto add_identification;
	  end;
	  if (j > array.h_bound)
	  then do;
	     msg = "Attempt to reference above upper bound. ";
	     goto add_identification;
	  end;
         end;
      end;
      separator = " ";
      if (inputa (ifi) = ",")
      then do;
         ifi = ifi + 1;
         do while ("1"b);
	  jj = search (substr (input, ifi), "&}") -1;
	  if (jj < 0)
	  then do;
	     msg = "}";
	     call error_missing ("xxx{", begl, ife);
	  end;
	  if (jj > 0)
	  then do;
	     call putout (ofp, ofe, substr (input, ifi, jj));
	     ifi = ifi + jj;
	  end;
	  if (inputa (ifi) = "}")
	  then do;
	     separator = substr (output, ii + 1, ofe - ii);
	     ofe = ii;
	     goto end_range;
	  end;
	  call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b);
         end;
      end;
      if (inputa (ifi) = "}")
      then do;
end_range:
         ifi = ifi + 1;
         if (TF = "00"b)
         then return;
         var_ptr = vptr;
         arr_ptr = var.ref;
         limit = j - array.lower + 1;
         do arr_elem = i - array.lower + 1 to limit;
	  call putout (ofp, ofe, arrtext);
	  if (arr_elem ^= limit)
	  then call putout (ofp, ofe, (separator));
         end;
      end;
      else do;
         msg = "&var{ ... }";
         goto syntax_err;
      end;
   end var_range; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* reference a variable					       */

var_ref: proc (ifp, ifi, ife, ofp, ofe, TF) recursive;

dcl ifp		ptr,		/* pointer to input		       */
    ifi		fixed bin (24),	/* first char of input to use	       */
    ife		fixed bin (24),	/* last char of input to use	       */
    ofp		ptr,		/* pointer to output	       */
    ofe		fixed bin (24),	/* last char of output used	       */
    TF		bit (2);
dcl begl		fixed bin (24);
dcl inputa	(ife) char (1) based (ifp);
dcl input		char (ife) based (ifp);
dcl output	char (ofe) based (ofp);
dcl (i, j, ii, jj)	fixed bin (24);
dcl loc		(24) fixed bin (24);
dcl (sep_ct, level) fixed bin (24);
dcl argstrl	fixed bin (24);

/* &xxx */ /* xxx can be SCALAR, FIFI, or LIFO */
      if (TF = "00"b)
      then return;
      begl = ifi;
      j = lookup (c32);
      if (j = 0)
      then do;
         msg = "Attempt to reference undeclared variable """;
         msg = msg || c32;
         msg = msg || """. ";
         goto add_identification;
      end;
      if (var.type = 0)
      then do;
         if (c32 = watchword)
         then call ioa_ ("^a ^i ""^va""", watchword, var.len, var.len,
	       vartext);
         call putout (ofp, out_len, vartext);
      end;
      else do;
         arr_ptr = var.ref;
         if (var.type = 4)
         then do;
	  if (array.l_bound > array.h_bound)
	  then do;
	     msg = "Attempt to reference empty fifo """;
	     msg = msg || c32;
	     msg = msg || """. ";
	     goto add_identification;
	  end;
	  arr_elem = mod (array.l_bound, var.len) + 1;
	  if (c32 = watchword)
	  then call ioa_ ("^a{^i} ^i ""^va""", watchword, arr_elem,
		array.len (arr_elem), array.len (arr_elem), arrtext);
	  call putout (ofp, out_len, arrtext);
	  array.l_bound = array.l_bound + 1;
	  if al_sw
	  then call ioa_ ("F ^a{^i} ^i ^p", c32, arr_elem,
		array.len (arr_elem), array.ref (arr_elem));
	  free arrtext in (free_area);
         end;
         else if (var.type = 5)
         then do;
	  if (array.l_bound > array.h_bound)
	  then do;
	     msg = "Attempt to reference empty lifo """;
	     msg = msg || c32;
	     msg = msg || """. ";
	     goto add_identification;
	  end;
	  arr_elem = array.h_bound;
	  if (c32 = watchword)
	  then call ioa_ ("^a{^i} ^i ""^va""", watchword, arr_elem,
		array.len (arr_elem), array.len (arr_elem), arrtext);
	  call putout (ofp, out_len, arrtext);
	  array.h_bound = array.h_bound - 1;
	  if al_sw
	  then call ioa_ ("F ^a{^i} ^i ^p", c32, arr_elem,
		array.len (arr_elem), array.ref (arr_elem));
	  free arrtext in (free_area);
         end;
         else do;
	  msg = "Attempt to make scalar reference to non-scalar """;
	  msg = msg || c32;
	  msg = msg || """. ";
	  goto add_identification;
         end;
      end;
   end var_ref; %page;
/*  -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+-  */
/*							       */
/* EXTERNAL entry to cleanup the processing environment		       */

dcl ref_path	char (168);
free: entry (pr_sw);

dcl pr_sw		bit (1);

dcl define_area_	entry (ptr, fixed bin (35));
dcl release_area_	entry (ptr);

      if free_area_p ^= null ()
      then do;
         tptr = ext_var_ptr;
         call free_um ("ext");
         ext_var_ptr = null ();
         do while (int_vars_base ^= null ());
	  int_var_ptr = int_vars_base;
	  if db_sw
	  then call ioa_ ("^p^-macro ^a", int_var_ptr, int_vars.macro);
	  int_vars_base = int_vars.next;
	  tptr = int_vars.ref;
	  call free_um ("int");
	  if al_sw then call ioa_ ("F int_vars ^p", int_var_ptr);
	  free int_vars in (free_area);
         end;
         tptr = macro_list_p;
         if (tptr ^= null ()) & pr_sw
         then call ioa_ ("^aS USED:", who_am_i);
         do while (tptr ^= null ());
	  maclp = tptr;
	  if pr_sw & (macro_list.dname ^= "")
	  then do;
	     call ioa_ ("^i:^i ^a>^a -- (^a.macro)", macro_list.from,
	        macro_list.to, macro_list.dname,
	        macro_list.ename, macro_list.name);
	  end;
	  tptr = macro_list.next;
	  macro_holder_p = macro_list.ref;
	  if (substr (macro_list.dname, 1, 4) = "   &")
	  then do;
	     macro_holder_l = macro_list.to;
	     if al_sw
	     then call ioa_ ("F macro_holder ^p", macro_holder_p);
	     free macro_holder in (free_area);
	  end;
	  if al_sw then call ioa_ ("F macro_list ^p", maclp);
	  free macro_list in (free_area);
         end;
         call release_area_ (free_area_p);
         free_area_p = null ();
      end;
      macro_list_p = null ();
      err_ct (*) = 0;
      macro_nest = 0;
      return;

dcl dname		char (168);
dcl ename		char (32);
dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin (24), char (*), fixed bin (35));


/* * * * * * * * * * * * * * INTERNAL STATIC DATA  * * * * * * * * * * * * * */

dcl al_sw		bit (1) int static init ("0"b);
dcl db_sw		bit (1) int static init ("0"b);
dcl dt_sw		bit (1) int static init ("0"b);
dcl end_sym	char (8) var;
dcl err_ct	(0:4) fixed bin int static init ((5) 0);
dcl ext_var_ptr	ptr int static init (null ());
dcl free_area_p	ptr int static init (null ());
dcl int_vars_base	ptr int static init (null ());
dcl lg_sw		bit (1) int static init ("0"b);
dcl macro_list_p	ptr int static init (null ());
dcl macro_nest	fixed bin int static init (0);
dcl pc_sw		bit (1) int static init ("0"b);
dcl watchword	char (32) int static init ("");
dcl who_am_i	char (12) var int static;

/* * * * * * * * * * * * * * * *  CONSTANTS  * * * * * * * * * * * * * * * * */

dcl NL		char (1) int static options (constant) init ("
");
dcl space		char (5) int static options (constant) init (" 	
");

/* * * * * * * * * * * * * * * *  STRUCTURES * * * * * * * * * * * * * * * * */

dcl var_ptr	ptr;
dcl 1 var		based (var_ptr),
      2 next	ptr,		/* next variable in list	       */
      2 name	char (16),
      2 type	fixed bin,	/* 0-scalar  1-array   2-array var   */
				/* 3-list    4-fifo    5-lifo	       */
      2 len	fixed bin,	/* length of data string	       */
      2 ref	ptr;		/* points to data string	       */
dcl vartext	char (var.len) based (var.ref);


dcl arr_ptr	ptr;
dcl 1 array	based (arr_ptr),
      2 lower	fixed bin,
      2 l_bound	fixed bin,	/* defined lower bound	       */
      2 h_bound	fixed bin,	/* defined higher bound	       */
      2 elem	(var.len),
        3 len	fixed bin,	/* length of data string	       */
        3 ref	ptr unal;		/* points to data string	       */
dcl arrtext	char (array.len (arr_elem)) based (array.ref (arr_elem));
dcl arr_elem	fixed bin (24);

dcl int_var_ptr	ptr;
dcl 1 int_vars	based (int_var_ptr),
      2 next	ptr unal,
      2 ref	ptr unal,		/* points to variable definition     */
      2 macro	char (32);	/* name of macro owning it	       */

dcl maclp		ptr;
dcl 1 macro_list	based (maclp),
      2 next	ptr,
      2 ref	ptr,
      2 dname	char (168),
      2 ename	char (32),
      2 from	fixed bin (24),
      2 to	fixed bin (24),
      2 name	char (32),
      2 int_mac	bit (1);		/* 1- &macro/&define'ed	       */

/* * * * * * * * * * * * * LOOSE ARRAYS and SCALARS  * * * * * * * * * * * * */

dcl argleng_less_than_zero condition;
dcl bc		fixed bin (24);
dcl c32		char (32) var;
dcl c32x		char (32) var;
dcl call_err	bit (1);
dcl ch_2nd	char (1);
dcl construct_nest	fixed bin (24);
dcl free_area	area based (free_area_p);
dcl i		fixed bin (24);
dcl jaf		fixed bin (24);
dcl local_var_ptr	ptr;
dcl macro_holder	char (macro_holder_l) based (macro_holder_p);
dcl macro_holder_l	fixed bin (24);
dcl macro_holder_p	ptr;
dcl msg_etc	char (1000) var;
dcl myname	char (32) var;
dcl output	char (ofe) based (out_ptr);
dcl save_db	bit (1);
dcl seg		char (sege) based (segptr);
dcl sega		(sege) char (1) based (segptr);
dcl sege		fixed bin (24);
dcl segi		fixed bin (24);
dcl segii		fixed bin (24);
dcl segment	char (sege) based (segptr);
dcl segptr	ptr;
dcl segtype	char (8) var;
dcl start_sym	char (8) var;
dcl tptr		ptr;
dcl token_chars	char (63) int static options (constant) init (
		"abcdefghijklmnopqrstuvwxyz" ||
		"ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789");
dcl tr_sw		bit (1);

dcl error_table_$action_not_performed fixed bin (35) ext static;
dcl error_table_$archive_fmt_err fixed bin (35) ext static;
dcl error_table_$badsyntax fixed bin (35) ext static;
dcl error_table_$new_search_list fixed bin (35) ext static;
dcl error_table_$no_search_list fixed bin (35) ext static;
dcl error_table_$translation_aborted fixed bin (35) ext static;
dcl error_table_$translation_failed fixed bin (35) ext static;

dcl ioa_		entry options (variable);
dcl com_err_	entry options (variable);
dcl archive_util_$first_element entry (ptr, fixed bin (35));
dcl archive_util_$search entry (ptr, ptr, char (32), fixed bin (35));
dcl ioa_$nnl	entry options (variable);
dcl hcs_$make_ptr	entry (ptr, char (*), char (*), ptr, fixed bin (35));
dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35));
dcl hcs_$fs_get_seg_ptr entry (char (*), ptr, fixed bin (35));
dcl get_seg_ptr_	entry (char (*), bit (6), fixed bin (24), ptr, fixed bin (35));
dcl mac_sw	bit (1);

dcl (addr, addrel, char, convert, divide, fixed, hbound, index, length, ltrim,
    max, min, mod, null, reverse, rtrim, search, size, string, substr,
    translate, verify) builtin;
dbn: entry; db_sw = "1"b; return;
dtn: entry; dt_sw = "1"b; return;
aln: entry; al_sw = "1"b; return;
pcn: entry; pc_sw = "1"b; return;
lgn: entry; lg_sw = "1"b; return;
lgf: entry; lg_sw = "0"b; return;
pcf: entry; pc_sw = "0"b; return;
alf: entry; al_sw = "0"b; return;
dtf: entry; dt_sw = "0"b; return;
dbf: entry; db_sw = "0"b; return;

watch: entry (watchfor);
dcl watchfor	char (*);

      watchword = watchfor;
      return;

   end;
   



		    mrpg.pl1                        02/14/84  0905.4r w 02/14/84  0844.1       54153


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16	       */
/**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
/**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
/**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */

mrpg: proc;

dcl MRPG_version	char (8) int static init ("1.1b");

/* report generator language					       */

      code = 0;
      ifp = null ();
      call cu_$arg_ptr (1, argp, argl, code);
      if (code = 0)
      then do;
         if (substr (arg, 1, 1) ^= "-")
         then do;
	  if (ifp ^= null ())
	  then do;
	     call com_err_ (0, command_name, "Multiple input segments not allowed.");
	     return;
	  end;
	  call expand_pathname_$add_suffix (arg, "mrpg", dname, ename, code);
	  if (code ^= 0)
	  then do;
	     call com_err_ (code, command_name, "^a", arg);
	     return;
	  end;
	  if (verify (before (ename, ".mrpg"), chars) ^= 0)
	     | (index ("_0123456789", substr (ename, 1, 1)) ^= 0)
	  then do;
	     call com_err_ (0, "mrpg", "Syntax error in report name.");
	     return;
	  end;
	  call hcs_$initiate_count (dname, ename, "", bc, 0, ifp, code);
	  if (ifp = null ())

	  then do;
	     call com_err_ (code, command_name, "^a>^a", dname, ename);
	     return;
	  end;
	  if (bc = 0)
	  then do;
	     call com_err_ (error_table_$zero_length_seg, command_name, "^a>^a", dname, ename);
	     return;
	  end;
	  ife = divide (bc, 9, 24, 0);
	  arg = before (ename, ".mrpg");
         end;
         else do;
	  call com_err_ (error_table_$badopt, command_name, "^a", arg);
	  return;
         end;
      end;
      else do;
         call com_err_ (code, command_name || MRPG_version, "
Usage:	mrpg pathname {PL/I options}");
         return;
      end;
      if (ifp = null ())
      then do;
         call com_err_ (error_table_$noarg, command_name, "Input segment.");
         return;
      end;
      call ioa_ ("MRPG ^a", MRPG_version);
      ai.version = area_info_version_1;
      ai.zero_on_alloc = "1"b;
      ai.zero_on_free = "0"b;
      ai.dont_free = "0"b;
      ai.no_freeing = "1"b;
      ai.owner = command_name;
      ai.size = sys_info$max_seg_size;
      if hold_sw
      then do;
         ai.extend = "0"b;
         call hcs_$make_seg (get_wdir_ (), "mrpg.area", "mrpg.area", 01010b, ai.areap, code);
         if (ai.areap = null ())
         then do;
	  call com_err_ (code, "mrpg", "Getting work area");
	  return;
         end;
      end;
      else do;
         ai.areap = null ();
         ai.extend = "1"b;
      end;
      call define_area_ (addr (ai), code);
      if (code ^= 0)
      then do;
         call com_err_ (code, command_name, "define_area_");
         return;
      end;
      on condition (cleanup) begin;
	  if ^hold_sw
	  then call release_area_ (ai.areap);
         end;
      on condition (mrpg_fatal) goto done;
      call mrpg_error_$init;
      call mrpg_parse_ (ifp, ife, ai.areap, code);
      if mrpg_error_$stat ()
      then goto done;
      call mrpg_generate_ (ai.areap, ename, ifp, code);
      if (code ^= 0)
      then goto done;
      if ^hold_sw then
	 call release_area_ (ai.areap);
      ai.areap = null ();
      call hcs_$make_ptr (null (), "pl1", "pl1", pl1p, code);
      call cu_$arg_list_ptr (arglp);
      call cu_$gen_call (pl1p, arglp);
done:
      if ^hold_sw & (ai.areap ^= null ()) then
	 call release_area_ (ai.areap);
      return;

dcl 1 ai		like area_info;
%include area_info;
dcl arg		char (argl) based (argp); /* current argument	       */
dcl argl		fixed bin (24);	/* length of current argument	       */
dcl arglp		ptr;
dcl argp		ptr;		/* pointer to current argument       */
dcl bc		fixed bin (24);
dcl chars		char (63) int static
  init ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789");
dcl cleanup	condition;
dcl code		fixed bin (35);
dcl com_err_	entry options (variable);
dcl command_name	char (4) int static init ("mrpg");
dcl cu_$arg_list_ptr entry (ptr);
dcl cu_$arg_ptr	entry (fixed bin (24), ptr, fixed bin (24), fixed bin (35));
dcl cu_$gen_call	entry (ptr, ptr);
dcl define_area_	entry (ptr, fixed bin (35));
dcl dname		char (168);	/* directory portion of input name   */
dcl ename		char (32);	/* entry portion of input name       */
dcl error_table_$zero_length_seg fixed bin (35) ext static;
dcl error_table_$badopt fixed bin (35) ext static;
dcl error_table_$noarg fixed bin (35) ext static;
dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
dcl get_wdir_	entry returns (char (168));
dcl hcs_$initiate_count entry options (variable);
dcl hcs_$make_ptr	entry (ptr, char (*), char (*), ptr, fixed bin (35));
dcl hcs_$make_seg	entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl i		fixed bin (24);
dcl ife		fixed bin (24);	/* length of input segment	       */
dcl ifp		ptr;		/* pointer to input sgment	       */
dcl ioa_		entry options (variable);
dcl mrpg_error_$init entry;
dcl mrpg_error_$stat entry returns (bit (1));
dcl mrpg_fatal	condition;
dcl mrpg_generate_	entry (ptr, char (32), ptr, fixed bin (35));
dcl mrpg_parse_	entry (ptr, fixed bin (24), ptr, fixed bin (35));
dcl pl1p		ptr;
dcl release_area_	entry (ptr);
dcl sys_info$max_seg_size fixed bin (24) ext static;

dcl (addr, before, codeptr, divide, index, null, substr, verify) builtin;

dcl hold_sw	bit (1) int static init ("0"b);
holdn: entry; hold_sw = "1"b; return;
holdf: entry; hold_sw = "0"b; return;
   end;
   



		    mrpg_date_.pl1                  02/14/84  0905.4r w 02/14/84  0844.2       22599


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16	       */
/**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
/**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
/**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */

mrpg_date_: proc (DAY, HHMMSS, MMDDYY, MONTH, YYDDD);

dcl DAY		char (12) var,
    HHMMSS	char (8),
    MMDDYY	char (8),
    MONTH		char (12) var,
    YYDDD		char (5);

dcl clock_	entry returns (fixed bin (71));
dcl month		fixed bin;
dcl day		fixed bin;
dcl year		fixed bin;
dcl hour		fixed bin;
dcl minute	fixed bin;
dcl second	fixed bin;
dcl dow		fixed bin;
dcl dayr		fixed bin;

dcl datebin_$dayr_clk entry (fixed bin (71), fixed bin);
dcl datebin_	entry (fixed bin (71), fixed bin, fixed bin, fixed bin,
		fixed bin, fixed bin, fixed bin, fixed bin, fixed bin,
		fixed bin);
dcl clock		fixed bin (71);

      clock = clock_ ();
      call datebin_ (clock, 0,
         month, day, year,
         hour, minute, second,
         dow, 0);
      call datebin_$dayr_clk (clock, dayr);

      DAY = DAYn (dow);
dcl DAYn		(7) char (12) var int static init (
		"Monday",
		"Tuesday",
		"Wednesday",
		"Thursday",
		"Friday",
		"Saturday",
		"Sunday");

dcl 1 tri,
      2 p1	pic "99",
      2 f1	char (1),
      2 p2	pic "99",
      2 f2	char (1),
      2 p3	pic "99";
      tri.f1, tri.f2 = ":";
      tri.p1 = hour;
      tri.p2 = minute;
      tri.p3 = second;
      HHMMSS = string (tri);

      tri.f1, tri.f2 = "/";
      tri.p1 = month;
      tri.p2 = day;
      tri.p3 = year - 1900;
      MMDDYY = string (tri);

      MONTH = MONTHn (month);
dcl MONTHn	(12) char (12) var int static init (
		"January",
		"February",
		"March",
		"April",
		"May",
		"June",
		"July",
		"August",
		"September",
		"October",
		"November",
		"December");

dcl 1 dbl,
      2 p1	pic "99",
      2 p2	pic "999";

      dbl.p1 = year - 1900;
      dbl.p2 = dayr;
      YYDDD = string (dbl);


   end;
 



		    mrpg_dump_.pl1                  02/14/84  0905.4r w 02/14/84  0844.1      132768


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16	       */
/**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
/**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
/**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */

/**** a utility for generating debug output for mrpg.		       */

mrpg_dump_:
dump: proc (exptr, indent);		/* dump an element		       */
      next_sw, all_sw = "0"b;
      goto start;

all: entry (exptr, indent);		/* dump the whole thing	       */
      next_sw, all_sw = "1"b;
      goto start;

list: entry (exptr, indent);		/* dump a list of elements	       */
      next_sw = "1"b;
      all_sw = "0"b;
      goto start;


dcl (exptr, xptr)	ptr unal;
dcl jptr		ptr;
dcl indent	fixed bin;

dcl mssg		char (32);
dcl check_pointer_$packed entry (ptr, char (32));
				/* hcs_$get_uid can probably be used */
				/*  in place of check_pointer_       */

start:
      xptr = exptr;
      text = "xptr";
loop:
      call check_pointer_$packed (addr (xptr), mssg);
      if (mssg ^= "")
      then do;
         call ioa_ ("^a is ^p  ""^12.3b""o (^a)", text, xptr, unspec (xptr), mssg);
         return;
      end;
      text = "next";

      if (xptr -> symtab.type = "ID")
         | (xptr -> symtab.type = "NU")
         | (xptr -> symtab.type = "ST")
      then do;
         call stmt_hdr ("symtab", xptr, "0"b);
         call ioa_ ("  ^3i ""^a""", xptr -> symtab.leng, xptr -> symtab.data);
         call ioa_ ("	^vxuse ^p   ^p", indent,
	  xptr -> symtab.use.b, xptr -> symtab.use.e);
         if next_sw & ^all_sw & (xptr -> symtab.type = "ID") then do;
	  indent = indent + 5;
	  do jptr = xptr -> symtab.use.b
	     repeat (jptr -> datum.usage)
	     while (jptr ^= null ());
	     call stmt_hdr ("----", (jptr), "0"b);
	     call ioa_ ("  sym  ^p", jptr -> datum.sym);
	     if (jptr -> datum.type ^= "SY")
	     then do;
	        call stmt_hdr ("    ----", jptr -> datum.sym, "0"b);
	        call ioa_ ("  sym  ^p", jptr -> datum.sym -> datum.sym);
	     end;
	  end;
	  indent = indent - 5;
         end;
         return;
      end;
      if (xptr -> datum.type = "DC")
         | (xptr -> datum.type = "IN")
      then do;
         call stmt_hdr ("datum", xptr, "0"b);
         call ioa_ ("  sym  ^p", xptr -> datum.sym);
         if all_sw & (xptr -> datum.sym ^= null ())
         then call mrpg_dump_$all ((xptr -> datum.sym), indent + 5);
         call ioa_ ("	^vxkind ^a ^i", indent,
	  kind_char (min (xptr -> datum.kind, hbound (kind_char, 1))),
	  xptr -> datum.kind);
         call ioa_ ("	^vxleng ^i", indent, xptr -> datum.leng);
         call ioa_ ("	^vxpos ^i", indent, xptr -> datum.pos);
         call ioa_ ("	^vxcheck ^p	^p", indent,
	  xptr -> datum.check.b, xptr -> datum.check.e);
         if all_sw & (xptr -> datum.check.b ^= null ())
         then call mrpg_dump_$all ((xptr -> datum.check.b), indent + 5);
         call ioa_ ("	^vxdatal ^p	^p", indent,
	  xptr -> datum.datal.b, xptr -> datum.datal.e);
         if all_sw & (xptr -> datum.datal.b ^= null ())
         then call mrpg_dump_$all ((xptr -> datum.datal.b), indent + 5);
         if next_sw
         then do;
	  xptr = xptr -> datum.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> symref.type = "SY")
      then do;
         call stmt_hdr ("symref", xptr, "0"b);
         call ioa_ ("  sym  ^p", xptr -> symref.sym);
         call ioa_ ("	^vxkind ^a ^i", indent,
	  kind_char (xptr -> symref.kind), xptr -> symref.kind);
         if all_sw & (xptr -> symref.sym ^= null ())
         then call mrpg_dump_$all ((xptr -> symref.sym), indent + 5);
         call ioa_ ("	^vxusage ^p", indent, xptr -> symref.usage);
         if next_sw
         then do;
	  xptr = xptr -> symref.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> opn.type = "OP")
      then do;
         call stmt_hdr ("opn", xptr, "1"b);
         call ioa_ ("	^vxop ^a ^i", indent,
	  op_char (min (xptr -> opn.op, hbound (op_char, 1))),
	  xptr -> opn.op);
         call ioa_ ("	^vxkind ^a ^i", indent,
	  kind_char (xptr -> opn.kind), xptr -> opn.kind);
         call ioa_ ("	^vxop1 ^p", indent, xptr -> opn.op1);
         if all_sw & (xptr -> opn.op1 ^= null ())
         then call mrpg_dump_$all ((xptr -> opn.op1), indent + 5);
         call ioa_ ("	^vxop2 ^p", indent, xptr -> opn.op2);
         if all_sw & (xptr -> opn.op2 ^= null ())
         then call mrpg_dump_$all ((xptr -> opn.op2), indent + 5);
         call ioa_ ("	^vxop3 ^p", indent, xptr -> opn.op3);
         if all_sw & (xptr -> opn.op3 ^= null ())
         then call mrpg_dump_$all ((xptr -> opn.op3), indent + 5);
         if next_sw
         then do;
	  xptr = xptr -> opn.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> report.type = "RP")
      then do;
         call stmt_hdr ("report", xptr, "0"b);
         call ioa_ ("  sym  ^p", xptr -> report.sym);
         if all_sw & (xptr -> report.sym ^= null ())
         then call mrpg_dump_$all ((xptr -> report.sym), indent + 5);
         call ioa_ ("	^vxpw ^i", indent, xptr -> report.pw);
         call ioa_ ("	^vxpl ^i", indent, xptr -> report.pl);
         call ioa_ ("	^vxminl ^i", indent, xptr -> report.minl);
         call ioa_ ("	^vxmaxl ^i", indent, xptr -> report.maxl);
         call ioa_ ("	^vxonlist	^p   ^p", indent,
	  xptr -> report.onlist.b, xptr -> report.onlist.e);
         if all_sw & (xptr -> report.onlist.b ^= null ())
         then call mrpg_dump_$all ((xptr -> report.onlist.b), indent + 5);
         call ioa_ ("	^vxbrlist	^p   ^p", indent,
	  xptr -> report.brlist.b, xptr -> report.brlist.e);
         if all_sw & (xptr -> report.brlist.b ^= null ())
         then call mrpg_dump_$all ((xptr -> report.brlist.b), indent + 5);
         call ioa_ ("	^vxpart	^p   ^p", indent,
	  xptr -> report.part.b, xptr -> report.part.e);
         if xptr -> tree.mmddyy then call ioa_ ("    ^vxmmddyy", indent);
         if xptr -> tree.yyddd then call ioa_ ("    ^vxyyddd", indent);
         if xptr -> tree.month then call ioa_ ("    ^vxmonth", indent);
         if xptr -> tree.day then call ioa_ ("    ^vxday", indent);
         if xptr -> tree.hhmmss then call ioa_ ("    ^vxhhmmss", indent);
         if all_sw & (xptr -> report.part.b ^= null ())
         then call mrpg_dump_$all ((xptr -> report.part.b), indent + 5);
         if next_sw
         then do;
	  xptr = xptr -> report.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> part.type = "RH")
         | (xptr -> part.type = "PH")
         | (xptr -> part.type = "DH")
         | (xptr -> part.type = "DT")
         | (xptr -> part.type = "DF")
         | (xptr -> part.type = "PF")
         | (xptr -> part.type = "RF")
      then do;
         call stmt_hdr ("part", xptr, "0"b);
         call ioa_ ("  sym  ^p", xptr -> part.sym);
         if all_sw & (xptr -> part.sym ^= null ())
         then call mrpg_dump_$all ((xptr -> part.sym), indent + 5);
         call ioa_ ("	^vxmaxl  ^i", indent, xptr -> part.maxl);
         call ioa_ ("	^vxctl	^p", indent, xptr -> part.ctl);
         if all_sw & (xptr -> part.ctl ^= null ())
         then call mrpg_dump_$all ((xptr -> part.ctl), indent + 5);
         call ioa_ ("	^vxlines	^p   ^p", indent,
	  xptr -> part.lines.b, xptr -> part.lines.e);
         if all_sw & (xptr -> part.lines.b ^= null ())
         then call mrpg_dump_$all ((xptr -> part.lines.b), indent + 5);
         if next_sw
         then do;
	  xptr = xptr -> part.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> lines.type = "LN")
      then do;
         call stmt_hdr ("lines", xptr, "0"b);
         call ioa_ ("  number ^i", xptr -> lines.number);
         call ioa_ ("	^vxctl ^p", indent, xptr -> lines.ctl);
         if all_sw & (xptr -> lines.ctl ^= null ())
         then call mrpg_dump_$all ((xptr -> lines.ctl), indent + 5);
         call ioa_ ("	^vxfield	^p   ^p", indent,
	  xptr -> lines.field.b, xptr -> lines.field.e);
         if all_sw & (xptr -> lines.field.b ^= null ())
         then call mrpg_dump_$all ((xptr -> lines.field.b), indent + 5);
         if next_sw
         then do;
	  xptr = xptr -> lines.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> field.type = "FD")
      then do;
         call stmt_hdr ("field", xptr, "1"b);
         call ioa_ ("	^vxvalue	^p   ^p", indent,
	  xptr -> field.value.b, xptr -> field.value.e);
         if all_sw & (xptr -> field.value.b ^= null ())
         then call mrpg_dump_$all ((xptr -> field.value.b), indent + 5);
         call ioa_ ("	^vxlet	^p   ^p", indent,
	  xptr -> field.let.b, xptr -> field.let.e);
         if all_sw & (xptr -> field.let.b ^= null ())
         then call mrpg_dump_$all ((xptr -> field.let.b), indent + 5);
         call ioa_ ("	^vxkind ^a ^i", indent,
	  kind_char (min (xptr -> field.kind, hbound (kind_char, 1))),
	  xptr -> field.kind);
         call ioa_ ("	^vxalign ^a ^i", indent,
	  kind_char (min (xptr -> field.align, hbound (kind_char, 1))),
	  xptr -> field.align);
         call ioa_ ("	^vxalch ""^1a""", indent, xptr -> field.alch);
         call ioa_ ("	^vxbsp ""^1.1b""", indent, xptr -> field.bsp);
         call ioa_ ("	^vxfill ^i-^i", indent, xptr -> field.fill);
         call ioa_ ("	^vxcol ^i", indent, xptr -> field.col);
         call ioa_ ("	^vxleng ^i", indent, xptr -> field.leng);
         call ioa_ ("	^vxdata ^p", indent, xptr -> field.data);
         if all_sw & (xptr -> field.data ^= null ())
         then call mrpg_dump_$all ((xptr -> field.data), indent + 5);
         if next_sw
         then do;
	  xptr = xptr -> field.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> value.type = "VL")
         | (xptr -> value.type = "FL")
         | (xptr -> value.type = "SW")
         | (xptr -> value.type = "AT")
      then do;
         call stmt_hdr ("value", xptr, "0"b);
         call ioa_ ("  sym  ^p", xptr -> value.sym);
         if all_sw & (xptr -> value.sym ^= null ())
         then call mrpg_dump_$all ((xptr -> value.sym), indent + 5);
         call ioa_ ("	^vxnumb ^i", indent, xptr -> value.numb);
         call ioa_ ("	^vxctl ^p", indent, xptr -> value.ctl);
         if all_sw & (xptr -> value.ctl ^= null ())
         then call mrpg_dump_$all ((xptr -> value.ctl), indent + 5);
         if next_sw
         then do;
	  xptr = xptr -> value.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> attr.type = "DV")
         | (xptr -> attr.type = "KY")
      then do;
         call stmt_hdr ("attr", xptr, "0"b);
         call ioa_ ("  sym  ^p", xptr -> attr.sym);
         if all_sw & (xptr -> attr.sym ^= null ())
         then call mrpg_dump_$all ((xptr -> attr.sym), indent + 5);
         call ioa_ ("	^vxAD ^.1b^.1b", indent,
	  xptr -> attr.asc, xptr -> attr.des);
         if next_sw
         then do;
	  xptr = xptr -> attr.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> param.type = "PM")
      then do;
         call stmt_hdr ("param", xptr, "0"b);
         call ioa_ ("  sym  ^p", xptr -> param.sym);
         if all_sw & (xptr -> param.sym ^= null ())
         then call mrpg_dump_$all ((xptr -> param.sym), indent + 5);
         call ioa_ ("	^vxkind ^a ^i", indent,
	  kind_char (min (xptr -> param.kind, hbound (kind_char, 1))),
	  xptr -> param.kind);
         call ioa_ ("	^vxattr	^p   ^p", indent,
	  xptr -> param.attr.b, xptr -> param.attr.e);
         if all_sw & (xptr -> param.attr.b ^= null ())
         then call mrpg_dump_$all ((xptr -> param.attr.b), indent + 5);
         call ioa_ ("	^vxcheck ^p	^p", indent,
	  xptr -> param.check.b, xptr -> param.check.e);
         if all_sw & (xptr -> param.check.b ^= null ())
         then call mrpg_dump_$all ((xptr -> param.check.b), indent + 5);
         call ioa_ ("	^vxleng ^i", indent, xptr -> param.leng);
         if next_sw
         then do;
	  xptr = xptr -> param.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      if (xptr -> stmt.type = "IF")
         | (xptr -> stmt.type = ":=")
         | (xptr -> stmt.type = "=:")
         | (xptr -> stmt.type = "BG")
         | (xptr -> stmt.type = "PR")
         | (xptr -> stmt.type = "SR")
         | (xptr -> stmt.type = "HD")
         | (xptr -> stmt.type = "SU")
         | (xptr -> stmt.type = "cP")
         | (xptr -> stmt.type = "cE")
      then do;
         call stmt_hdr ("stmt", xptr, "1"b);
         call ioa_ ("	^vxref1	^p   ^p", indent,
	  xptr -> stmt.ref1.b, xptr -> stmt.ref1.e);
         if all_sw & (xptr -> stmt.ref1.b ^= null ())
         then call mrpg_dump_$all ((xptr -> stmt.ref1.b), indent + 5);
         call ioa_ ("	^vxref2	^p   ^p", indent,
	  xptr -> stmt.ref2.b, xptr -> stmt.ref2.e);
         if all_sw & (xptr -> stmt.ref2.b ^= null ())
         then call mrpg_dump_$all ((xptr -> stmt.ref2.b), indent + 5);
         call ioa_ ("	^vxref3	^p   ^p", indent,
	  xptr -> stmt.ref3.b, xptr -> stmt.ref3.e);
         if all_sw & (xptr -> stmt.ref3.b ^= null ())
         then call mrpg_dump_$all ((xptr -> stmt.ref3.b), indent + 5);
         if next_sw
         then do;
	  xptr = xptr -> stmt.next;
	  if (xptr ^= null ())
	  then goto loop;
         end;
         return;
      end;

      call stmt_hdr ("****", xptr, "1"b);

stmt_hdr: proc (name, xptr, sw);

dcl name		char (*),
    xptr		ptr unal,
    sw		bit (1);

      call ioa_$nnl ("^p	^vx^8a ""^2a"" ^3i ^i:^i  ^p^[^/^]", xptr,
         indent, name,
         xptr -> stmt.type,
         xptr -> stmt.line,
         xptr -> stmt.bchar,
         xptr -> stmt.echar,
         xptr -> stmt.next, sw);

   end;

dcl text		char (4);
dcl (next_sw, all_sw) bit (1);
dcl ioa_		entry options (variable);
dcl ioa_$nnl	entry options (variable);
%include mrpg_tree;
dcl mrpg_dump_$all	entry (ptr unal, fixed bin);
   end;



		    mrpg_error_.pl1                 02/14/84  0905.4r w 02/14/84  0844.1       24048


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16	       */
/**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
/**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
/**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */

mrpg_error_: proc (severity, line) options (variable);

dcl (severity, line) fixed bin;

      LINE = "LINE";
      SEP = ".";
      call cu_$arg_list_ptr (alp);
      lineno = line;
      call ioa_$general_rs (alp, 3, 4, ret, retl, "1"b, "1"b);
      SEV = LEVEL (severity);
      if (line = 0)
      then LINE, SEP = "";
      i = 1;
      do while (i ^= 0);
         i = index (ret, ",_");
         if (i > 0)
         then substr (ret, i, 2) = " ,";
      end;
      call iox_$put_chars (iox_$user_output, addr (reta), retl + 19, 0);
      errct (severity) = errct (severity) + 1;
      if severity = 3
      then signal condition (mrpg_fatal);
      return;

dcl ioa_$general_rs entry (ptr, fixed bin (24), fixed bin (24), char (*),
		fixed bin (24), bit (1) aligned, bit (1) aligned);
dcl alp		ptr;
dcl LEVEL		(0:3) char (8) int static
		init ("", "*WARN:", "ERROR:", "FATAL:");
dcl errct		(0:3) fixed bin (24) int static;
dcl 1 reta,
      2 SEV	char (8),
      2 LINE	char (4),
      2 lineno	pic "zzzzz",
      2 SEP	char (2),
      2 ret	char (150);
dcl retl		fixed bin (24);
dcl com_err_	entry options (variable);
dcl iox_$user_output ptr ext static;
dcl iox_$put_chars	entry (ptr, ptr, fixed bin (24), fixed bin (24));
dcl cu_$arg_list_ptr entry (ptr);
dcl retv		bit (1);
dcl i		fixed bin;
dcl mrpg_fatal	condition;
dcl error_table_$translation_failed fixed bin (35) ext static;
dcl code		fixed bin (35);

init: entry;
      errct = 0;
      return;

stat: entry returns (bit (1));

      retv = errct (2) > 0;
      if (errct (1) + errct (2) > 0)
      then do;
         if retv
         then code = error_table_$translation_failed;
         else code = 0;
         call com_err_ (code, "mrpg", "^/^-Summary: ^i WARN, ^i ERROR",
	  errct (1), errct (2));
      end;
      errct = 0;
      return (retv);

%include arg_list;

   end;



		    mrpg_generate_.pl1              02/14/84  0905.4r w 02/14/84  0844.1      352341


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16	       */
/**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
/**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
/**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */

mrpg_generate_: proc (atreeptr, ename, aifp, code);

dcl atreeptr	ptr,
    ename		char (32),
    aifp		ptr,		/* pointer to source segment	       */
    code		fixed bin (35);

      P_skip, P_stop, P_bool_char, P_bool_dec, P_char_bool, P_char_dec,
         P_dec_bool, P_dec_char, P_int, P_if = "0"b;
      failed = 0;
      tree_ptr = atreeptr;
      if stop_sw then signal condition (stop_mrpg);
      if db_sw then do;
         call ioa_ ("table	^p	^p", table.b, table.e);
         optr = table.b;
         do while (optr ^= null ());
	  call mrpg_dump_$list ((optr), 3);
	  optr = optr -> symtab.next;
         end;
         call ioa_ ("^/parm_pos	^p	^p	^i",
	  parm_pos.b, parm_pos.e, ppos_ct);
         if (parm_pos.b ^= null ())
         then call mrpg_dump_$all (parm_pos.b, 0);
         call ioa_ ("^/parm_key	^p	^p	^i",
	  parm_key.b, parm_key.e, pkey_ct);
         if (parm_key.b ^= null ())
         then call mrpg_dump_$all (parm_key.b, 0);
         call ioa_ ("^/parm_check	^p	^p",
	  parm_check.b, parm_check.e);
         if (parm_check.b ^= null ())
         then call mrpg_dump_$all (parm_check.b, 0);
         call ioa_ ("^/input	^p	^p", input.b, input.e);
         if (input.b ^= null ())
         then call mrpg_dump_$all (input.b, 0);
         call ioa_ ("^/input_check	^p	^p",
	  input_check.b, input_check.e);
         if (input_check.b ^= null ())
         then call mrpg_dump_$all (input_check.b, 0);
         call ioa_ ("^/rec_str,res_siz	^i   ^i", rec_str, res_siz);
         call ioa_ ("^/from	^p", from);
         if (from ^= null ())
         then call mrpg_dump_$all (from, 0);
         call ioa_ ("^/local	^p	^p", local.b, local.e);
         if (local.b ^= null ())
         then call mrpg_dump_$all (local.b, 0);
         call ioa_ ("^/report	^p	^p", tree.report.b, tree.report.e);
         if (tree.report.b ^= null ())
         then call mrpg_dump_$all (tree.report.b, 0);
         call ioa_ ("^/exec	^p	^p", exec.b, exec.e);
         if (exec.b ^= null ())
         then call mrpg_dump_$all (exec.b, 0);
      end; %skip (5);
      err_sw = "0"b;

      do symtabptr = table.b
         repeat (symtabptr -> symtab.next)
         while (symtabptr ^= null ());
         daptr = symtab.use.b;
         if (symtab.type = "ID")
         then if (datum.type = "SY")
	    then do;
	       call mrpg_error_ (3, (datum.line),
		"Undeclared variable ""^a"".", symtab.data);
	       err_sw = "1"b;
	    end;
      end;

      if err_sw
      then do;
         code = 1;
         return;
      end; %skip (5);
      macname = "macro";

/*	call macro_$library (macname, mrpg, code);		       */
      if (code ^= 0)
      then return;
      name = before (ename, ".mrpg");
      call get_seg_ptr_ (name || ".pl1", "010101"b, bc, optr, code);
      on condition (cleanup) begin;
	  call macro_$free (db_sw);
	  call release_seg_ptr_ (optr, 0, code);
         end;
      ose = 0;
dcl err_sw	bit (1);
dcl version	char (32) int static options (constant)
		init ("mrpg 1.1b of Oct 26, 1983");
dcl dname		char (168);
dcl dnamel	fixed bin;
dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*),
		fixed bin (35));

      call hcs_$fs_get_path_name (aifp, dname, dnamel, "      ", 0);

      argl.p (1) = addr (version);
      argl.l (1) = length (version);

      argl.p (2) = addr (dname);
      argl.l (2) = dnamel;

      argl.p (3) = addrel (addr (name), 1);
      argl.l (3) = length (name);

      vtemp = "";
      if (from ^= null ())
      then call regen (from);
      argl.p (4) = addrel (addr (vtemp), 1);
      argl.l (4) = length (vtemp);

      argct = 5;
      ds (5) = rec_str;
      call number;

      argct = 6;
      ds (6) = res_siz;
      call number;

      argct = 7;
      argl.l (7) = 1;
      if db_sw | lg_sw
      then argl.p (7) = addr (digit (1));
      else argl.p (7) = addr (digit (0));

      argct = 8;
      ds (argct) = ppos_ct + pkey_ct;
      call number;

      macname = "proc";
      call macro;

/* process parameters					       */

      if (ppos_ct > 0)
         | (pkey_ct > 0)
      then do;
         ds (1) = ppos_ct;
         ds (2) = pkey_ct;

         argct = 1;
         call number;

         argct = 2;
         call number;

         macname = "parm_begin";
         argct = 2;
         call macro;

         macname = "parm_check";

         max_name = 0;
         dflt_sw = "0"b;
         paptr = parm_key.b;
         do i = ppos_ct + 1 to ppos_ct + pkey_ct, -1, 1 to ppos_ct;
	  if (i = -1)
	  then do;
	     argct = 0;
	     paptr = parm_pos.b;
	  end;
	  else do;
	     srefptr = param.sym;
	     symtabptr = symref.sym;
	     argl.p (1) = addr (symtab.data);
	     argl.l (1) = symtab.leng;
	     max_name = max (max_name, symtab.leng);

	     argct = 2;
	     ds (argct) = i;
	     call number;

	     argct = 3;
	     if (param.kind = Bool)
	     then ds (argct) = -1;
	     else ds (argct) = param.leng;
	     call number;

	     atptr = param.attr.b;
	     do while (atptr ^= null ());
	        if (attr.type = "KY")
	        then do;
		 argct = argct + 1;
		 srefptr = attr.sym;
		 symtabptr = symref.sym;
		 argl.p (argct) = addr (symtab.data);
		 argl.l (argct) = symtab.leng;
	        end;
	        else dflt_sw = "1"b;
	        atptr = attr.next;
	     end;
	     paptr = param.next;
	  end;

	  call macro;
         end;

         if dflt_sw
         then do;
	  macname = "parm_default";
	  paptr = parm_key.b;
	  do i = ppos_ct + 1 to ppos_ct + pkey_ct, -1, 1 to ppos_ct;
	     if (i = -1)
	     then do;
	        paptr = parm_pos.b;
	     end;
	     else do;
	        srefptr = param.sym;
	        symtabptr = symref.sym;
	        argl.p (1) = addr (symtab.data);
	        argl.l (1) = symtab.leng;

	        argct = 2;
	        ds (argct) = i;
	        call number;

	        argct = 3;
	        if (param.kind = Bool)
	        then ds (argct) = -1;
	        else ds (argct) = param.leng;
	        call number;

	        atptr = param.attr.b;
	        do while (atptr ^= null ());
		 if (attr.type = "DV")
		 then do;
		    argct = 4;
		    call expr (attr.sym, argl.p (4), argl.l (4));
		    call macro;
		    atptr = null ();
		 end;
		 else atptr = attr.next;
	        end;
	        paptr = param.next;
	     end;
	  end;
         end;

         argct = 1;
         ds (argct) = max_name;
         call number;
         argct = 1;
         macname = "parm_end";
         call macro;
      end;

%page;
/* process local declaration					       */
      macname = "local";
      do daptr = tree.local.b
         repeat (datum.next)
         while (daptr ^= null ());

         LINE = datum.line;
         argl.l (1) = 4;
         argl.p (1) = addr (LINE);
dcl LINE		pic "zzz9";
         srefptr = datum.sym;
         symtabptr = symref.sym;
         if (index (symtab.data, ".") = 0)
         then do;
	  argl.p (2) = addr (symtab.data);
	  argl.l (2) = symtab.leng;

	  if (datum.kind = Set)
	     | (datum.kind = Table)
	     | (datum.kind = Tablev)
	  then do;
	     if (symtab.use.b = symtab.use.e)
	     then call mrpg_error_ (1, (datum.line),
	        """^a"" is not referenced.", symtab.data);
	     else do;
	        if (datum.datal.b -> opn.op = n_n)
	        then do;
		 argl.p (3), argl.p (4) = addr (t_n);
		 argl.l (3), argl.l (4) = length (t_n);
	        end;
	        else if (datum.datal.b -> opn.op = n_s)
	        then do;
		 argl.p (3) = addr (t_n);
		 argl.l (3) = length (t_n);
		 argl.p (4) = addr (t_c);
		 argl.l (4) = length (t_c) - 3;
	        end;
	        else if (datum.datal.b -> opn.op = s_n)
	        then do;
		 argl.p (3) = addr (t_c);
		 argl.l (3) = length (t_c) - 3;
		 argl.p (4) = addr (t_n);
		 argl.l (4) = length (t_n);
	        end;
	        else do;
		 argl.p (3), argl.p (4) = addr (t_c);
		 argl.l (3), argl.l (4) = length (t_c) - 3;
	        end;
	        if (datum.kind = Set)
	        then argct = 3;
	        else argct = 4;
	        if (datum.kind = Tablev)
	        then argl.l (4) = argl.l (4) + 3;
	        macname = "table";

	        call macro;

	        argct = 1;
	        do opptr = datum.datal.b
		 repeat (opn.next)
		 while (opptr ^= null ());
		 symtabptr = opn.op1 -> symref.sym;
		 argl.p (1) = addr (symtab.data);
		 argl.l (1) = symtab.leng;
		 if (opn.op2 ^= null ())
		 then do;
		    argct = 2;
		    symtabptr = opn.op2 -> symref.sym;
		    argl.p (2) = addr (symtab.data);
		    argl.l (2) = symtab.leng;
		 end;
		 call macro;
	        end;
	        argct = 0;
	        call macro;
	        macname = "local";
	     end;
	  end;
	  else do;
	     argct = 3;
	     ds (argct) = datum.pos;
	     call number;

	     argl.p (4) = addrel (addr (kind_char (datum.kind)), 1);
	     argl.l (4) = length (kind_char (datum.kind));

	     argct = 5;
	     ds (argct) = datum.leng;
	     call number;

	     call expr (datum.datal.b, argl.p (6), argl.l (6));

	     argct = 6;
	     call macro;
	  end;
         end;
      end;
%page;
/* process report specifications				       */
dcl digit		(0:9) char (1) int static init (
		"0", "1", "2", "3", "4", "5", "6", "7", "8", "9");

      do repptr = tree.report.b
         repeat (report.next)
         while (repptr ^= null ());
         do pt = "PF1", "PH1", "ON0", "BR0", "DFn", "RF1", "RH1", "DHn", "DTn";
	  rc = substr (pt, 3, 1);
	  substr (pt, 3, 1) = " ";
	  macname = "report";
	  argl.p (1) = addr (pt);
	  argl.l (1) = 2;
	  if (pt = "PF")
	  then do;
	     srefptr = report.sym;
	     symtabptr = symref.sym;
	     argl.p (2) = addr (symtab.data);
	     argl.l (2) = symtab.leng;

	     argct = 3;
	     ds (argct) = report.pw;
	     call number;

	     argct = 4;
	     ds (argct) = report.pl;
	     call number;

	     argct = 5;
	     ds (argct) = report.minl;
	     call number;

	     argct = 6;
	     ds (argct) = report.maxl;
	     call number;
	  end;
	  if (rc ^= "n")		/* PF, PH, ON, BR, RF, RH	       */
	  then call macro;

	  if (rc ^= "0")		/* PF, PH, DF, RF, RH, DH, DT	       */
	  then do partptr = report.part.b
	        repeat (part.next)
	        while (partptr ^= null ());
	     if (part.type = pt)
	     then do;
	        if (rc = "n")	/* DF, DH, DT		       */
	        then do;
		 srefptr = part.sym;
		 symtabptr = symref.sym;
		 argct = 2;
		 if (pt = "DT")
		 then do;
		    argl.p (2) = addr (symtab.data);
		    argl.l (2) = symtab.leng;

		    argct = 3;
		    ds (argct) = part.maxl;
		    call number;
		 end;
		 else do;
		    i = 0;
		    do srefptr = report.brlist.b
		       repeat (symref.next)
		       while (srefptr ^= null ());
		       i = i + 1;
		       if (symref.sym = symtabptr)
		       then goto br_found;
		    end;
				/* error			       */
br_found:
		    ds (argct) = i;
		    call number;
		 end;

		 if (part.ctl ^= null ())
		 then do;
		    argct = 4;
		    call expr (part.ctl, argl.p (4), argl.l (4));
		 end;
		 macname = "report";
		 argl.p (1) = addr (pt);
		 argl.l (1) = 2;
		 call macro;
	        end;
	        call put_part;
	     end;
	  end;
	  if (pt = "ON")
	  then do;
	     macname = "on";
	     argct = 4;
	     do valptr = report.onlist.b
	        repeat (value.next)
	        while (valptr ^= null ());
	        argl.l (1) = 2;
	        argl.p (1) = addr (value.type);

	        vtemp = "";
	        call expr (value.ctl, argl.p (3), argl.l (3));

	        argl.p (2) = addr (argl.p (3) -> car (argl.l (3) + 1));
	        call regen (value.sym);
	        argl.l (2) = length (vtemp) - argl.l (3);

	        ds (argct) = value.numb;
	        call number;

	        call macro;
	     end;
	  end;

	  if (pt = "BR")
	  then do;
	     macname = "break";
	     i = 0;
	     do srefptr = report.brlist.b
	        repeat (symref.next)
	        while (srefptr ^= null ());
	        symtabptr = symref.sym;
	        daptr = symtab.use.b;
	        argl.p (1) = addr (symtab.data);
	        argl.l (1) = symtab.leng;

	        i = i + 1;
	        argct = 2;
	        ds (argct) = i;
	        call number;

	        argl.p (3) = addrel (addr (kind_char (datum.kind)), 1);
	        argl.l (3) = length (kind_char (datum.kind));

	        argct = 4;
	        ds (argct) = datum.leng;
	        call number;

	        call macro;
	     end;
	  end;
         end;

         macname = "report";
         argl.p (1) = addr (digit (9));
         argl.l (1) = 1;

         argct = 1;
         call macro;

      end; %skip (5);
/* process input declaration					       */
      macname = "input";
      argct = 0;
      call macro;

      macname = "input_field";
      do daptr = tree.input.b
         repeat (datum.next)
         while (daptr ^= null ());

         LINE = datum.line;
         argl.l (1) = 4;
         argl.p (1) = addr (LINE);
         srefptr = datum.sym;
         if (srefptr ^= null ())
         then do;
	  symtabptr = symref.sym;
	  argl.p (2) = addr (symtab.data);
	  argl.l (2) = symtab.leng;
         end;
         else do;
	  argl.p (2) = addr (digit (0));
	  argl.l (2) = 0;
         end;

         argct = 3;
         ds (argct) = datum.pos;
         call number;

         argl.p (4) = addrel (addr (kind_char (datum.kind)), 1);
         argl.l (4) = length (kind_char (datum.kind));

         argct = 5;
         ds (argct) = datum.leng;
         call number;

         vtemp = "";
         call expr (datum.datal.b, argl.p (6), argl.l (6));

         argct = 6;
         call macro;
      end; %skip (5);
/* process executable					       */

      macname = "exec";
      argct = 0;
      call macro;

      call stmt_exp (tree.exec.b);

      macname = "exec";
      argct = 0;
      call macro;

      argct = 6;
      argl.p (1) = addr (I_day);
      if tree.day
      then argl.l (1) = 5;
      else argl.l (1) = 0;

      argl.p (2) = addr (I_hhmmss);
      if tree.hhmmss
      then argl.l (2) = 8;
      else argl.l (2) = 0;

      argl.p (3) = addr (I_mmddyy);
      if tree.mmddyy
      then argl.l (3) = 8;
      else argl.l (3) = 0;

      argl.p (4) = addr (I_month);
      if tree.month
      then argl.l (4) = 7;
      else argl.l (4) = 0;

      argl.p (5) = addr (I_yyddd);
      if tree.yyddd
      then argl.l (5) = 7;
      else argl.l (5) = 0;

      vtemp = "";
      if P_skip
      then vtemp = vtemp || "&let P_skip=1&;";
      if P_stop
      then vtemp = vtemp || "&let P_stop=1&;";
      if P_bool_char
      then vtemp = vtemp || "&let P_bool_char=1&;";
      if P_bool_dec
      then vtemp = vtemp || "&let P_bool_dec=1&;";
      if P_char_bool
      then vtemp = vtemp || "&let P_char_bool=1&;";
      if P_char_dec
      then vtemp = vtemp || "&let P_char_dec=1&;";
      if P_dec_bool
      then vtemp = vtemp || "&let P_dec_bool=1&;";
      if P_dec_char
      then vtemp = vtemp || "&let P_dec_char=1&;";
      if P_int
      then vtemp = vtemp || "&let P_int=1&;";
      if P_if
      then vtemp = vtemp || "&let P_if=1&;";
      argl.p (6) = addrel (addr (vtemp), 1);
      argl.l (6) = length (vtemp);

      macname = "end";
      call macro;
exit:
      call macro_$free (db_sw);
      call release_seg_ptr_ (optr, ose * 9, code);
      if (failed ^= 0)
      then call mrpg_error_ (failed, 0, "Unable to complete translation");
      code = failed;
      return; %page;
stmt_exp: proc (stmtp);

dcl stmtp		ptr unal;
dcl tp		ptr;

      do stmtptr = stmtp
         repeat (stmt.next)
         while (stmtptr ^= null ());
         tp = stmtptr;
         if (stmt.type = "IF")
         then do;
	  macname = "if";
	  argct = 1;
	  ds (argct) = 1;
	  call number;

	  argct = 2;
	  call expr (stmt.ref1.b, argl.p (2), argl.l (2));

	  call macro;
	  call stmt_exp (tp -> stmt.ref2.b);
	  if (tp -> stmt.ref3.b ^= null ())
	  then do;
	     macname = "if";
	     argct = 1;
	     ds (argct) = 2;
	     call number;
	     call macro;

	     call stmt_exp (tp -> stmt.ref3.b);
	  end;
	  macname = "if";
	  argct = 1;
	  ds (argct) = 3;
	  call number;
	  call macro;
         end;
         else if (stmt.type = ":=")
	       | (stmt.type = "=:")
         then do;
	  macname = "assign";
	  argct = 4;

	  srefptr = stmt.ref1.b;
	  symtabptr = symref.sym;
	  argl.p (1) = addr (symtab.data);
	  argl.l (1) = symtab.leng;

	  vtemp = "";
	  call expr (stmt.ref2.b, argl.p (2), argl.l (2));

	  argl.l (3) = 2;
	  argl.p (3) = addr (stmt.type);

	  ds (argct) = symref.line;
	  call number;

	  call macro;
         end;
         else if (stmt.type = "PR")
         then do;
	  macname = "print";
	  argct = 1;

	  srefptr = stmt.ref1.b;
	  symtabptr = symref.sym;
	  argl.p (1) = addr (symtab.data);
	  argl.l (1) = symtab.leng;

	  call macro;
         end;
         else if (stmt.type = "SR")
	       | (stmt.type = "SU")
	       | (stmt.type = "HD")
         then do;
	  macname = "sort";
	  argct = 1;
	  argl.l (1) = 2;
	  argl.p (1) = addr (stmt.type);

	  call macro;

	  argct = 4;
	  do atptr = stmt.ref2.b
	     repeat (attr.next)
	     while (atptr ^= null ()),
	     stmt.ref1.b
	     repeat (attr.next)
	     while (atptr ^= null ());
dcl A		char (1) int static init ("A");
dcl D		char (1) int static init ("D");
	     argl.p (1) = addr (A);
	     if (attr.type = "KY")
	     then do;
	        if attr.des
	        then argl.p (1) = addr (D);
	        argl.l (1) = 1;
	        srefptr = attr.sym;
	     end;
	     else do;
	        argl.l (1) = 0;
	        srefptr = atptr;
	     end;
	     if (symref.type ^= "SY")
	     then do;
	        call mrpg_error_ (3, (symref.line), "SORT/HOLD fields cannot be expressions.");
	     end;
	     else do;
	        symtabptr = symref.sym;
	        argl.l (2) = symtab.leng;
	        argl.p (2) = addr (symtab.data);

	        daptr = symtab.use.b;
	        argl.p (3) = addrel (addr (kind_char (datum.kind)), 1);
	        argl.l (3) = length (kind_char (datum.kind));

	        argct = 4;
	        ds (argct) = datum.leng;
	        call number;

	        call macro;
	     end;
	  end;
	  argct = 0;
	  call macro;
         end;
         else if (stmt.type = "BG")
         then do;
	  macname = "bg";
	  argct = 1;
	  ds (argct) = 1;
	  call number;
	  call macro;

	  call stmt_exp (tp -> stmt.ref1.b);
	  call stmt_exp (tp -> stmt.ref2.b);
	  macname = "bg";
	  argct = 1;
	  ds (argct) = 2;
	  call number;
	  call macro;
	  call stmt_exp (tp -> stmt.ref3.b);
	  macname = "bg";
	  argct = 1;
	  ds (argct) = 3;
	  call number;
	  call macro;

         end;
         else if (stmt.type = "NT")
         then ;
         else do;
	  call mrpg_error_ (3, 0, "Invalid stmt.type ""^a""", stmt.type);
         end;
         stmtptr = tp;

      end;
   end stmt_exp; %page;
put_part: proc;

dcl tptr		ptr;

      do linptr = part.lines.b
         repeat (lines.next)
         while (linptr ^= null ());
         argl.p (1) = addr (digit (1));
         argl.l (1) = 1;

         argct = 2;
         ds (argct) = lines.number;
         call number;

         call expr (lines.ctl, argl.p (3), argl.l (3));

         argct = 3;
         macname = "line";
         call macro;

         do fldptr = lines.field.b
	  repeat (field.next)
	  while (fldptr ^= null ());
	  do stmtptr = field.let.b
	     repeat (stmt.next)
	     while (stmtptr ^= null ());
	     vtemp = "";
	     tptr = stmtptr;
exec_loop:
	     if (tptr -> stmt.type = "IF")
	     then do;
	        macname = "if";

	        argct = 1;
	        call expr (tptr -> stmt.ref1.b, argl.p (1), argl.l (1));

	        call macro;
	        stmtptr = tptr -> stmt.ref2.b;
	        goto exec_loop;
	     end;
	     else if (tptr -> stmt.type = ":=")
		   | (tptr -> stmt.type = "=:")
	     then do;
	        macname = "assign";
	        argct = 4;

	        srefptr = tptr -> stmt.ref1.b;
	        symtabptr = symref.sym;
	        argl.p (1) = addr (symtab.data);
	        argl.l (1) = symtab.leng;

	        call expr (tptr -> stmt.ref2.b, argl.p (2), argl.l (2));

	        argl.l (3) = 2;
	        argl.p (3) = addr (tptr -> stmt.type);

	        ds (argct) = symref.line;
	        call number;

	        call macro;
	     end;
	     else if (tptr -> stmt.type = "cP")
	     then do;
	        macname = "picture";
	        goto pic_edit;
	     end;
	     else if (tptr -> stmt.type = "cE")
	     then do;
	        macname = "edit";
pic_edit:
	        argct = 3;

	        srefptr = tptr -> stmt.ref1.b;
	        symtabptr = symref.sym;
	        argl.p (1) = addr (symtab.data);
	        argl.l (1) = symtab.leng;

	        call expr (tptr -> stmt.ref2.b, argl.p (2), argl.l (2));

	        srefptr = tptr -> stmt.ref2.e;
	        symtabptr = symref.sym;
	        argl.p (3) = addr (symtab.data);
	        argl.l (3) = symtab.leng;

	        call macro;
	     end;
	     else do;
	        call mrpg_error_ (2, 0, "Unknown stmt.type ""^a""", tptr -> stmt.type);
	     end;
	  end;
	  P_ctl = "000000000";
	  valptr = field.value.b;
	  srefptr = value.sym;
	  symtabptr = symref.sym;
	  argl.p (1) = addr (symtab.data);
	  argl.l (1) = symtab.leng;

	  if (symtab.type = "ID")
	  then do;
	     daptr = symtab.use.b;
	     argct = 2;
	     ds (argct) = datum.kind;
	     call number;

	     argct = 3;
	     ds (argct) = datum.leng;
	     call number;
	     if (datum.kind = Decimal)
	     then do;
	        P.numeric = "1";
	        if (field.align = 0)
	        then P.space = "1";
	     end;
	  end;
	  else do;
	     argct = 2;
	     if (symtab.type = "NU")
	     then do;
	        ds (argct) = Decimal;
	        P.numeric = "1";
	        if (field.align = 0)
	        then P.right = "1";
	     end;
	     else do;
	        ds (argct) = Char;
	     end;
	     call number;

	     argl.l (3) = 1;
	     argl.p (3) = addr (digit (0));
	  end;

	  argct = 4;
	  ds (argct) = field.col;
	  call number;

	  argct = 5;
	  ds (argct) = field.leng;
	  call number;
	  if (field.leng = 0) & (symtab.type ^= "ST")
	  then P.space = "1";

	  argct = 6;
dcl P_ctl		char (9);
dcl 1 P		defined (P_ctl),
      2 (bsp, left, center, right, align, numeric, space) char (1);
	  if field.bsp
	  then P.bsp = "1";
	  if (field.align >= 8) & (field.align <= 11)
	  then substr (P_ctl, field.align - 6, 1) = "1";
	  argl.l (6) = 9;
	  argl.p (6) = addr (P_ctl);

	  argct = 7;
	  argl.l (7) = 1;
	  argl.p (7) = addr (field.alch);

/* take care of fill(1:2) */ /*				       */

	  macname = "value";
	  call macro;
         end;
         macname = "line";
         argct = 1;

         argl.p (1) = addr (digit (2));
         argl.l (1) = 1;

         call macro;
      end;

   end put_part; %page;
number: proc;

dcl i		fixed bin;

      i = index (reverse (ds (argct)), " ");
      argl.p (argct) = addr (substr (ds (argct), 10 - i, 1));
      argl.l (argct) = i - 1;

   end number; %skip (5);
macro: proc;

      call macro_ ("mrpg_lib", "mrpg", macname, optr, ose,
         addr (argl), argct, msg, codeptr (macro), code);
      if (code ^= 0)
      then do;
         if (code = error_table_$translation_failed)
	  | (code = error_table_$badsyntax)
         then do;
	  failed = 2;
	  code = 0;
         end;
         if (code = error_table_$translation_aborted)
         then do;
	  ose = 0;
	  failed = 3;
	  call com_err_ (code, "mrpg", "^a", msg);
	  goto exit;
         end;
         call ioa_ ("^a", msg);
         code = 0;
      end;

   end macro; %page;
expr: proc (axptr, rptr, rlen);

dcl axptr		ptr unal,		/* pointer to node to expand	       */
    rptr		ptr,		/* pointer to argument (OUT)	       */
    rlen		fixed bin;	/* length of argument	       */
dcl xptr		ptr;

      vtemp = "";
      xptr = axptr;
      if (xptr ^= null ())
      then do;
         call regen ((xptr));
      end;
      rptr = addrel (addr (vtemp), 1);
      rlen = length (vtemp);
      return;

/* note that only 1 expr of this kind can used in one macro call	       */

   end expr;
%page;
dcl P_skip	bit (1);
dcl P_stop	bit (1);
dcl P_bool_char	bit (1);
dcl P_bool_dec	bit (1);
dcl P_char_bool	bit (1);
dcl P_char_dec	bit (1);
dcl P_dec_bool	bit (1);
dcl P_dec_char	bit (1);
dcl P_int		bit (1);
dcl P_if		bit (1);
regen: proc (xptr);

dcl xptr		ptr unal;

      if (xptr -> stmt.type = "VL")
      then do;
         call regen (xptr -> value.sym);
         return;
      end;
      if (xptr -> stmt.type = "SY")
      then do;
         call regen (xptr -> symref.sym);
         return;
      end;

      if (xptr -> stmt.type = "ID")
         | (xptr -> stmt.type = "NU")
         | (xptr -> stmt.type = "ST")
      then do;
         vtemp = vtemp || xptr -> symtab.data;
         return;
      end;

      if (xptr -> stmt.type = "OP")
      then do;

/* Level => ( op1 .I_level <=  op2 )				       */
         if (xptr -> opn.op = Level)
         then do;
	  vtemp = vtemp || "(";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ".I_level <= ";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")";
	  return;
         end;


/* Beg => (before ( op1 , op2 ) = "")				       */
         if (xptr -> opn.op = Beg)
         then do;
	  vtemp = vtemp || "(before (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ",";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ") = """")";
	  return;
         end;


/* Nbeg => (before ( op1 , op2 ) ^= "")				       */
         if (xptr -> opn.op = Nbeg)
         then do;
	  vtemp = vtemp || "(before (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ",";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ") ^= """")";
	  return;
         end;


/* End => (before ( reverse( op1 ) , reverse( op2 ) ) = "")		       */
         if (xptr -> opn.op = End)
         then do;
	  vtemp = vtemp || "(before (reverse (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "), reverse (";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")) = """")";
	  return;
         end;


/* Nend => (before ( reverse( op1 ) , reverse( op2 ) ) ^= "")	       */
         if (xptr -> opn.op = Nend)
         then do;
	  vtemp = vtemp || "(before (reverse (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "), reverse (";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")) ^= """")";
	  return;
         end;


/* Cont => (index ( op1 , op2 ) ^= 0)				       */
         if (xptr -> opn.op = Cont)
         then do;
	  vtemp = vtemp || "(index (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ",";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ") ^= 0)";
	  return;
         end;


/* Ncont => (index ( op1 , op2 ) = 0)				       */
         if (xptr -> opn.op = Ncont)
         then do;
	  vtemp = vtemp || "(index (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ",";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ") = 0)";
	  return;
         end;


/* Begw => (before ( op1 ||" " , op2 ||" " ) = "")		       */
         if (xptr -> opn.op = Beg)
         then do;
	  vtemp = vtemp || "(before (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "||"" "", ";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || "||"" "") = """")";
	  return;
         end;


/* Nbegw => (before ( op1 ||" " , op2 ||" " ) ^= "")		       */
         if (xptr -> opn.op = Nbeg)
         then do;
	  vtemp = vtemp || "(before (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "||"" "", ";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || "||"" "") ^= """")";
	  return;
         end;


/* Endw => (before ( reverse( " "|| op1 ) , reverse( " "|| op2 ) ) = "")     */
         if (xptr -> opn.op = End)
         then do;
	  vtemp = vtemp || "(before (reverse ( "" ""||";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "), reverse ( "" ""||";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")) = """")";
	  return;
         end;


/* Nendw => (before ( reverse( " "|| op1 ) , reverse( op2 ) ) ^= "")	       */
         if (xptr -> opn.op = Nend)
         then do;
	  vtemp = vtemp || "(before (reverse ( "" ""||";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "), reverse ( "" ""||";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")) ^= """")";
	  return;
         end;


/* Contw => (index ( " "|| op1 ||" " , " "|| op2 ||" " ) = 0)	       */
         if (xptr -> opn.op = Cont)
         then do;
	  vtemp = vtemp || "(index ( "" ""||";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "||"" "", "" ""||";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || "||"" "") = 0)";
	  return;
         end;


/* Ncontw => (index ( " "|| op1 ||" " , op2 ) ^= 0)		       */
         if (xptr -> opn.op = Ncont)
         then do;
	  vtemp = vtemp || "(index ( "" ""||";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "||"" "", "" ""||";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || "||"" "") ^= 0)";
	  return;
         end;


/* In => op1 ( op2 )					       */
         if (xptr -> opn.op = In)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "(";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")";
	  return;
         end;


/* Nin => ^ op1 ( op2 )					       */
         if (xptr -> opn.op = Nin)
         then do;
	  vtemp = vtemp || "^";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "(";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")";
	  return;
         end;

/* Skip => if ( op1 ) then call P_skip( op2 );			       */
         if (xptr -> opn.op = Skip)
         then do;
	  vtemp = vtemp || "if (";
	  call regen (xptr -> opn.op1);
	  P_skip = "1"b;
	  vtemp = vtemp || ") then call P_skip(";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ");";
	  return;
         end;


/* Stop => if ( op1 ) then call P_stop( op2 );			       */
         if (xptr -> opn.op = Stop)
         then do;
	  vtemp = vtemp || "if (";
	  call regen (xptr -> opn.op1);
	  P_stop = "1"b;
	  vtemp = vtemp || ") then call P_stop(";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ");";
	  return;
         end;


/* Tran => op1 ( op2 )					       */
         if (xptr -> opn.op = Tran)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "(";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")";
	  return;
         end;


/* n_s => n_s						       */
         if (xptr -> opn.op = n_s)
         then do;
	  vtemp = vtemp || "n_s";
	  return;
         end;


/* s_n => s_n						       */
         if (xptr -> opn.op = s_n)
         then do;
	  vtemp = vtemp || "s_n";
	  return;
         end;


/* s_s => s_s						       */
         if (xptr -> opn.op = s_s)
         then do;
	  vtemp = vtemp || "s_s";
	  return;
         end;


/* b_c => P_bool_char( op1 )					       */
         if (xptr -> opn.op = b_c)
         then do;
	  P_bool_char = "1"b;
	  vtemp = vtemp || "P_bool_char(";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ")";
	  return;
         end;


/* b_d => P_bool_dec( op1 ) */
         if (xptr -> opn.op = b_d)
         then do;
	  P_bool_dec = "1"b;
	  vtemp = vtemp || "P_bool_dec(";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ")";
	  return;
         end;


/* c_b => P_char_bool( op1 )					       */
         if (xptr -> opn.op = c_b)
         then do;
	  P_char_bool = "1"b;
	  vtemp = vtemp || "P_char_bool((";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "))";
	  return;
         end;


/* c_d => convert(F_d20,  op1 )				       */
         if (xptr -> opn.op = c_d)
         then do;
	  vtemp = vtemp || "convert(F_d20,";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ")";
	  return;
         end;


/* d_b => P_dec_bool( op1)					       */
         if (xptr -> opn.op = d_b)
         then do;
	  P_dec_bool = "1"b;
	  vtemp = vtemp || "P_dec_bool(";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ")";
	  return;
         end;


/* d_c => P_dec_char					       */
/* ( op1 )						       */
         if (xptr -> opn.op = d_c)
         then do;
	  P_dec_char = "1"b;
	  vtemp = vtemp || "P_dec_char(";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ")";
	  return;
         end;


/* If => P_if( op1 , op2 , op3 )				       */
         if (xptr -> opn.op = If)
         then do;
	  P_if = "1"b;
	  vtemp = vtemp || "P_if (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ",";
	  if (xptr -> opn.op2 = null ())
	  then vtemp = vtemp || """""";
	  else call regen (xptr -> opn.op2);
	  vtemp = vtemp || ",";
	  if (xptr -> opn.op3 = null ())
	  then vtemp = vtemp || """""";
	  else call regen (xptr -> opn.op3);
	  vtemp = vtemp || ")";
	  return;
         end;


/* Pnum => P_int( op1 .I_page)				       */
         if (xptr -> opn.op = Pnum)
         then do;
	  vtemp = vtemp || "P_int (";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ".I_page)";
	  return;
         end;


/* Func =>  op1 ( op2 )					       */
         if (xptr -> opn.op = Func)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "(";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")";
	  return;
         end;


/* Paren => ( op1 )						       */
         if (xptr -> opn.op = Paren)
         then do;
	  vtemp = vtemp || "(";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ")";
	  return;
         end;


/* Add =>  op1 + op2					       */
         if (xptr -> opn.op = Add)
         then do;
	  if (xptr -> opn.op1 ^= null ())
	  then call regen (xptr -> opn.op1);
	  vtemp = vtemp || "+";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* Sub =>  op1 - op2					       */
         if (xptr -> opn.op = Sub)
         then do;
	  if (xptr -> opn.op1 ^= null ())
	  then call regen (xptr -> opn.op1);
	  vtemp = vtemp || "-";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* Mul =>  op1 * op2					       */
         if (xptr -> opn.op = Mul)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "*";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* Div =>  op1 / op2					       */
         if (xptr -> opn.op = Div)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "/";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* Rpt => copy( op1 , op2 )					       */
         if (xptr -> opn.op = Rpt)
         then do;
	  vtemp = vtemp || "copy(";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ",";
	  call regen (xptr -> opn.op2);
	  vtemp = vtemp || ")";
	  return;
         end;


/* Cat =>  op1 || op2					       */
         if (xptr -> opn.op = Cat)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "||";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* EQ =>  op1 = op2						       */
         if (xptr -> opn.op = EQ)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "=";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* NE =>  op1 ^= op2					       */
         if (xptr -> opn.op = NE)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "^=";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* LE =>  op1 <= op2					       */
         if (xptr -> opn.op = LE)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "<=";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* GE =>  op1 >= op2					       */
         if (xptr -> opn.op = GE)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ">=";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* LT =>  op1 < op2						       */
         if (xptr -> opn.op = LT)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "<";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* GT =>  op1 > op2						       */
         if (xptr -> opn.op = GT)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ">";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* Not => ^ op2						       */
         if (xptr -> opn.op = Not)
         then do;
	  vtemp = vtemp || "^";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* And =>  op1 & op2					       */
         if (xptr -> opn.op = And)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "&";
	  call regen (xptr -> opn.op2);
	  return;
         end;


/* Substr => substr( op1, op2, op3)				       */
         if (xptr -> opn.op = Substr)
         then do;
	  vtemp = vtemp || " substr(";
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || ",";
	  call regen (xptr -> opn.op2);
	  if (xptr -> opn.op3 ^= null ())
	  then do;
	     vtemp = vtemp || ",";
	     call regen (xptr -> opn.op3);
	  end;
	  vtemp = vtemp || ")";
	  return;
         end;

/* Or =>  op1 | op2						       */
         if (xptr -> opn.op = Or)
         then do;
	  call regen (xptr -> opn.op1);
	  vtemp = vtemp || "|";
	  call regen (xptr -> opn.op2);
	  return;
         end;


      end;

      vtemp = vtemp || "
<<opn.op>>
";

   end regen;

dcl (mrpg_dump_, mrpg_dump_$list, mrpg_dump_$all) entry (ptr unal, fixed bin);

dcl I_day		char (8) int static init ("I_DAY");
dcl I_hhmmss	char (8) int static init ("I_HHMMSS");
dcl I_mmddyy	char (8) int static init ("I_MMDDYY");
dcl I_month	char (8) int static init ("I_MONTH");
dcl I_yyddd	char (8) int static init ("I_YYDDD");
dcl vtemp		char (512) var;
dcl car		(2000) char (1) unal based;
dcl name		char (32) var;
dcl mrpg_error_	entry options (variable);
dcl get_seg_ptr_	entry (char (*), bit (6) aligned, fixed bin (24), ptr, fixed bin (35));
dcl release_seg_ptr_ entry (ptr, fixed bin (24), fixed bin (35));
dcl bc		fixed bin (24);
dcl pt		char (3);
dcl rc		char (1);
dcl dflt_sw	bit (1);
dcl msg		char (1000) var;
dcl failed	fixed bin;
dcl com_err_	entry options (variable);
dcl macname	char (32) var;
dcl ds		(24) pic "(7)-9";
dcl cleanup	condition;
dcl ose		fixed bin (24);
dcl optr		ptr;
dcl i		fixed bin;
dcl argct		fixed bin;
dcl max_name	fixed bin;
dcl error_table_$badsyntax fixed bin (35) ext static;
dcl error_table_$translation_aborted fixed bin (35) ext static;
dcl error_table_$translation_failed fixed bin (35) ext static;
dcl ioa_		entry options (variable);
dcl macro_$free	entry (bit (1));
dcl mrpg		entry;
dcl stop_mrpg	condition;
dcl t_n		char (13) int static options (constant) init ("float dec(20)");
dcl t_c		char (14) int static options (constant) init ("char(&leng)var");
%include macro;
%include mrpg_tree;
dcl (db_sw, lg_sw, stop_sw) bit (1) int static init ("0"b);
dcl execptr	ptr;
dbn: entry; db_sw = "1"b; return;
lgn: entry; lg_sw = "1"b; return;
stopn: entry; stop_sw = "1"b; return;
stopf: entry; stop_sw = "0"b; return;
lgf: entry; lg_sw = "0"b; return;
dbf: entry; db_sw = "0"b; return;
dcl (addr, addrel, before, index, length, max, null, reverse, string, substr) builtin;
   end mrpg_generate_;
   



		    mrpg_get_ln_.pl1                11/05/86  1617.0r w 11/04/86  1042.5       13959


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16	       */
/**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
/**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
/**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */

mrpg_get_ln_: proc returns (fixed bin (18));

dcl line_no	fixed bin (18);

      call cu_$stack_frame_ptr (sf_ptr);
%include stack_frame;
dcl 1 sf		like stack_frame based (sf_ptr);
dcl sf_ptr	ptr;

      sf_ptr = sf.prev_sp;
      call stu_$get_runtime_block (sf_ptr, header_ptr, block_ptr,
         fixed (rel (sf.return_ptr), 18));
      line_no = 0;
      call stu_$get_line_no (block_ptr, fixed (rel (sf.return_ptr), 18),
         0, 0, line_no);

      return (line_no);

dcl header_ptr	ptr;
dcl block_ptr	ptr;
dcl stu_$get_runtime_block entry (ptr, ptr, ptr, fixed bin (18));
dcl stu_$get_line_no entry (ptr, fixed bin (18), fixed bin (18), fixed bin (18), fixed bin (18));
dcl cu_$stack_frame_ptr entry (ptr);
   end;
 



		    mrpg_parse_.pl1                 02/14/84  0905.4r w 02/14/84  0844.1       35190


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16	       */
/**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo       */
/**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend   */
/**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt   */

mrpg_parse_: proc (aifp, aife, atreeptr, acode);
dcl aifp		ptr,		/* pointer to input segment	       */
    aife		fixed bin (24),	/* length of input segment	       */
    atreeptr	ptr,		/* pointer to tree area	       */
    acode		fixed bin (35);	/* return code		       */

      ifp = aifp;
      ife = aife;
      area_ptr = atreeptr;
      ifi = 1;
      allocate tree in (space);
      table.b, table.e = null ();
      parm_pos.b, parm_pos.e = null ();
      parm_key.b, parm_key.e = null ();
      input.b, input.e = null ();
      from = null ();
      local.b, local.e = null ();
      tree.report.b, tree.report.e = null ();
      tree.input_check.b, tree.input_check.e = null ();
      tree.parm_check.b, tree.parm_check.e = null ();
      tree.rec_str = -2;
      tree.res_siz = 500;
      tree.phase0.b, tree.phase0.e = null ();
      exec.b, exec.e = null ();
      acode = 0;
      linenumber = 0;
      parenct = 0;
      ifl = 0;
      if (lino (1) ^= 0)
      then db_sw = "0"b;

      call mrpg_parse_;
      atreeptr = tree_ptr;
      return;

dbn: entry; db_sw = "1"b; return;
prn: entry; pr_sw = "1"b; return;
dmpn: entry; dmp_sw = "1"b; return;
dmpf: entry; dmp_sw = "0"b; return;
prf: entry; pr_sw = "0"b; return;
dbf: entry; db_sw = "0"b; return;

line: entry (line1, line2);
dcl (line1, line2)	char (*);
dcl lino		(2) fixed bin int static init (0, 0);
      lino (1) = fixed (line1);
      lino (2) = fixed (line2);
      return;


dcl (pr_sw, dmp_sw) bit (1) int static init ("0"b);
dcl tptr		ptr;
dcl parenct	fixed bin;
dcl BOOL		fixed bin int static init (1);
dcl CHAR		fixed bin int static init (2);
dcl DEC		fixed bin int static init (3);
dcl SET		fixed bin int static init (4);
dcl TABLE		fixed bin int static init (5);
dcl REP		fixed bin int static init (6);
dcl DET		fixed bin int static init (7);
dcl dt_s		(0:7) char (12) int static init (
		"undefined",
		"BOOLEAN",
		"CHARACTER",
		"DECIMAL",
		"SET",
		"TABLE",
		"REPORT",
		"DETAIL");
dcl (hbound, index, lbound, max, min, null, string, substr, translate, unspec, verify) builtin;

dcl ifp		ptr;
dcl ifile		char (2000) based (ifp);
dcl ifilea	(2000) char (1) based (ifp);
dcl ifi		fixed bin (24);
dcl ifl		fixed bin (24);
dcl ife		fixed bin (24);
dcl linenumber	fixed bin (24);

dcl mrpg_error_	entry options (variable);
dcl (mrpg_dump_, mrpg_dump_$list, mrpg_dump_$all) entry (ptr unal, fixed bin);

%include mrpg_parse_;
%include mrpg_tables_;
%include mrpg_tree;
dcl used		bit (302) int static init ("0"b);
usage: entry;

dcl numbe		(10) pic "zzz9";
dcl (i, j)	fixed bin;
dcl ioa_$nnl	entry options (variable);

      call ioa_$nnl ("Unused productions:^/");
      j = 0;
      goto us_1;
us_2:
      if ^substr (used, j, 1)
      then do;
         numbe (i) = j;
         i = i + 1;
         if (i > 10)
         then do;
	  call ioa_$nnl ("^a^/", string (numbe));
us_1:
	  string (numbe) = " ";
	  i = 1;
         end;
      end;
      j = j + 1;
      if (j <= 302)
      then goto us_2;
      if (i > 1)
      then call ioa_$nnl ("^a", string (numbe));
      return;
   end mrpg_parse_;
  



		    mrpg_tables_.alm                05/20/80  1933.0r w 05/20/80  1919.0     1098810


"  ******************************************************
"  *                                                    *
"  *                                                    *
"  * Copyright (c) 1972 by Massachusetts Institute of   *
"  * Technology and Honeywell Information Systems, Inc. *
"  *                                                    *
"  *                                                    *
"  ******************************************************

	equ	STRD,0
	equ	LOOK,1
	equ	STRDS,2
	equ	LOOKS,3
	equ	APLY,4
	equ	APLY1,5
	equ	APLYS,6
	equ	SKIP,7
	equ	ADJUST,8
	equ	NSRD,9
	equ	NSRDS,10
	equ	T0,0
	equ	ST0,0
"
"
" TERMINALS table (TL TC)
"
	use	utc
TC:	zero	0,TCs*4
	segdef	TC
	equ	T0,0
	use	utl
TL:	zero	0,TLs
	segdef	TL
"
" TERMINAL 1
	use	utc
	set	Tsl,*-TC-1
	aci	"%ABS"
	aci	"ENT "
	use	utl
	equ	T1,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 2
	use	utc
	set	Tsl,*-TC-1
	aci	"%DAY"
	use	utl
	equ	T2,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 3
	use	utc
	set	Tsl,*-TC-1
	aci	"%FIT"
	use	utl
	equ	T3,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 4
	use	utc
	set	Tsl,*-TC-1
	aci	"%HHM"
	aci	"MSS "
	use	utl
	equ	T4,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 5
	use	utc
	set	Tsl,*-TC-1
	aci	"%LEV"
	aci	"EL  "
	use	utl
	equ	T5,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 6
	use	utc
	set	Tsl,*-TC-1
	aci	"%MMD"
	aci	"DYY "
	use	utl
	equ	T6,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 7
	use	utc
	set	Tsl,*-TC-1
	aci	"%MON"
	aci	"TH  "
	use	utl
	equ	T7,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 8
	use	utc
	set	Tsl,*-TC-1
	aci	"%PAG"
	aci	"ENUM"
	aci	"BER "
	use	utl
	equ	T8,*-TL
	zero	Tsl*4+1,11
"
" TERMINAL 9
	use	utc
	set	Tsl,*-TC-1
	aci	"%PRE"
	aci	"SENT"
	use	utl
	equ	T9,*-TL
	zero	Tsl*4+1,8
"
" TERMINAL 10
	use	utc
	set	Tsl,*-TC-1
	aci	"%REP"
	aci	"EAT "
	use	utl
	equ	T10,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 11
	use	utc
	set	Tsl,*-TC-1
	aci	"%ROM"
	aci	"AN  "
	use	utl
	equ	T11,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 12
	use	utc
	set	Tsl,*-TC-1
	aci	"%SUB"
	aci	"STR "
	use	utl
	equ	T12,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 13
	use	utc
	set	Tsl,*-TC-1
	aci	"%YYD"
	aci	"DD  "
	use	utl
	equ	T13,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 14
	use	utc
	set	Tsl,*-TC-1
	aci	"(   "
	use	utl
	equ	T14,*-TL
	zero	Tsl*4+1,1
"
" TERMINAL 15
	use	utc
	set	Tsl,*-TC-1
	aci	")   "
	use	utl
	equ	T15,*-TL
	zero	Tsl*4+1,1
"
" TERMINAL 16
	use	utc
	set	Tsl,*-TC-1
	aci	"*   "
	use	utl
	equ	T16,*-TL
	zero	Tsl*4+1,1
"
" TERMINAL 17
	use	utc
	set	Tsl,*-TC-1
	aci	"+   "
	use	utl
	equ	T17,*-TL
	zero	Tsl*4+1,1
"
" TERMINAL 18
	use	utc
	set	Tsl,*-TC-1
	aci	",   "
	use	utl
	equ	T18,*-TL
	zero	Tsl*4+1,1
"
" TERMINAL 19
	use	utc
	set	Tsl,*-TC-1
	aci	"-   "
	use	utl
	equ	T19,*-TL
	zero	Tsl*4+1,1
"
" TERMINAL 20
	use	utc
	set	Tsl,*-TC-1
	aci	"->  "
	use	utl
	equ	T20,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 21
	use	utc
	set	Tsl,*-TC-1
	aci	"/   "
	use	utl
	equ	T21,*-TL
	zero	Tsl*4+1,1
"
" TERMINAL 22
	use	utc
	set	Tsl,*-TC-1
	aci	":=  "
	use	utl
	equ	T22,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 23
	use	utc
	set	Tsl,*-TC-1
	aci	";   "
	use	utl
	equ	T23,*-TL
	zero	Tsl*4+1,1
"
" TERMINAL 24
	use	utc
	set	Tsl,*-TC-1
	aci	"ALIG"
	aci	"N   "
	use	utl
	equ	T24,*-TL
	zero	Tsl*4+1,5
"
" TERMINAL 25
	use	utc
	set	Tsl,*-TC-1
	aci	"AND "
	use	utl
	equ	T25,*-TL
	zero	Tsl*4+1,3
"
" TERMINAL 26
	use	utc
	set	Tsl,*-TC-1
	aci	"ASCE"
	aci	"NDIN"
	aci	"G   "
	use	utl
	equ	T26,*-TL
	zero	Tsl*4+1,9
"
" TERMINAL 27
	use	utc
	set	Tsl,*-TC-1
	aci	"ATTA"
	aci	"CH  "
	use	utl
	equ	T27,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 28
	use	utc
	set	Tsl,*-TC-1
	aci	"BEGI"
	aci	"N   "
	use	utl
	equ	T28,*-TL
	zero	Tsl*4+1,5
"
" TERMINAL 29
	use	utc
	set	Tsl,*-TC-1
	aci	"BEGI"
	aci	"NS  "
	use	utl
	equ	T29,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 30
	use	utc
	set	Tsl,*-TC-1
	aci	"DECI"
	aci	"MAL "
	use	utl
	equ	T30,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 31
	use	utc
	set	Tsl,*-TC-1
	aci	"BREA"
	aci	"K   "
	use	utl
	equ	T31,*-TL
	zero	Tsl*4+1,5
"
" TERMINAL 32
	use	utc
	set	Tsl,*-TC-1
	aci	"CENT"
	aci	"ER  "
	use	utl
	equ	T32,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 33
	use	utc
	set	Tsl,*-TC-1
	aci	"CHAR"
	aci	"ACTE"
	aci	"R   "
	use	utl
	equ	T33,*-TL
	zero	Tsl*4+1,9
"
" TERMINAL 34
	use	utc
	set	Tsl,*-TC-1
	aci	"COLU"
	aci	"MN  "
	use	utl
	equ	T34,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 35
	use	utc
	set	Tsl,*-TC-1
	aci	"CONC"
	aci	"ATEN"
	aci	"ATE "
	use	utl
	equ	T35,*-TL
	zero	Tsl*4+1,11
"
" TERMINAL 36
	use	utc
	set	Tsl,*-TC-1
	aci	"CONT"
	aci	"AIN "
	use	utl
	equ	T36,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 37
	use	utc
	set	Tsl,*-TC-1
	aci	"CONT"
	aci	"AINS"
	use	utl
	equ	T37,*-TL
	zero	Tsl*4+1,8
"
" TERMINAL 38
	use	utc
	set	Tsl,*-TC-1
	aci	"DECL"
	aci	"ARE "
	use	utl
	equ	T38,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 39
	use	utc
	set	Tsl,*-TC-1
	aci	"DECL"
	aci	"ARE_"
	aci	"1   "
	use	utl
	equ	T39,*-TL
	zero	Tsl*4+1,9
"
" TERMINAL 40
	use	utc
	set	Tsl,*-TC-1
	aci	"DEFA"
	aci	"ULT "
	use	utl
	equ	T40,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 41
	use	utc
	set	Tsl,*-TC-1
	aci	"DEFI"
	aci	"NE_1"
	use	utl
	equ	T41,*-TL
	zero	Tsl*4+1,8
"
" TERMINAL 42
	use	utc
	set	Tsl,*-TC-1
	aci	"DELI"
	aci	"MITE"
	aci	"D   "
	use	utl
	equ	T42,*-TL
	zero	Tsl*4+1,9
"
" TERMINAL 43
	use	utc
	set	Tsl,*-TC-1
	aci	"DESC"
	aci	"ENDI"
	aci	"NG  "
	use	utl
	equ	T43,*-TL
	zero	Tsl*4+1,10
"
" TERMINAL 44
	use	utc
	set	Tsl,*-TC-1
	aci	"DETA"
	aci	"IL  "
	use	utl
	equ	T44,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 45
	use	utc
	set	Tsl,*-TC-1
	aci	"DETA"
	aci	"ILFO"
	aci	"OT  "
	use	utl
	equ	T45,*-TL
	zero	Tsl*4+1,10
"
" TERMINAL 46
	use	utc
	set	Tsl,*-TC-1
	aci	"DETA"
	aci	"ILHE"
	aci	"AD  "
	use	utl
	equ	T46,*-TL
	zero	Tsl*4+1,10
"
" TERMINAL 47
	use	utc
	set	Tsl,*-TC-1
	aci	"DUPL"
	aci	"ICAT"
	aci	"E   "
	use	utl
	equ	T47,*-TL
	zero	Tsl*4+1,9
"
" TERMINAL 48
	use	utc
	set	Tsl,*-TC-1
	aci	"EDIT"
	use	utl
	equ	T48,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 49
	use	utc
	set	Tsl,*-TC-1
	aci	"END "
	use	utl
	equ	T49,*-TL
	zero	Tsl*4+1,3
"
" TERMINAL 50
	use	utc
	set	Tsl,*-TC-1
	aci	"ENDS"
	use	utl
	equ	T50,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 51
	use	utc
	set	Tsl,*-TC-1
	aci	"EQ  "
	use	utl
	equ	T51,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 52
	use	utc
	set	Tsl,*-TC-1
	aci	"FALS"
	aci	"E   "
	use	utl
	equ	T52,*-TL
	zero	Tsl*4+1,5
"
" TERMINAL 53
	use	utc
	set	Tsl,*-TC-1
	aci	"FILE"
	use	utl
	equ	T53,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 54
	use	utc
	set	Tsl,*-TC-1
	aci	"FILL"
	use	utl
	equ	T54,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 55
	use	utc
	set	Tsl,*-TC-1
	aci	"FIT "
	use	utl
	equ	T55,*-TL
	zero	Tsl*4+1,3
"
" TERMINAL 56
	use	utc
	set	Tsl,*-TC-1
	aci	"BOOL"
	aci	"EAN "
	use	utl
	equ	T56,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 57
	use	utc
	set	Tsl,*-TC-1
	aci	"FLOA"
	aci	"T_un"
	aci	"used"
	use	utl
	equ	T57,*-TL
	zero	Tsl*4+1,12
"
" TERMINAL 58
	use	utc
	set	Tsl,*-TC-1
	aci	"FOLD"
	use	utl
	equ	T58,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 59
	use	utc
	set	Tsl,*-TC-1
	aci	"GE  "
	use	utl
	equ	T59,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 60
	use	utc
	set	Tsl,*-TC-1
	aci	"GT  "
	use	utl
	equ	T60,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 61
	use	utc
	set	Tsl,*-TC-1
	aci	"HOLD"
	use	utl
	equ	T61,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 62
	use	utc
	set	Tsl,*-TC-1
	aci	"IF  "
	use	utl
	equ	T62,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 63
	use	utc
	set	Tsl,*-TC-1
	aci	"IN  "
	use	utl
	equ	T63,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 64
	use	utc
	set	Tsl,*-TC-1
	aci	"INPU"
	aci	"T   "
	use	utl
	equ	T64,*-TL
	zero	Tsl*4+1,5
"
" TERMINAL 65
	use	utc
	set	Tsl,*-TC-1
	aci	"PAUS"
	aci	"E   "
	use	utl
	equ	T65,*-TL
	zero	Tsl*4+1,5
"
" TERMINAL 66
	use	utc
	set	Tsl,*-TC-1
	aci	"KEY "
	use	utl
	equ	T66,*-TL
	zero	Tsl*4+1,3
"
" TERMINAL 67
	use	utc
	set	Tsl,*-TC-1
	aci	"LE  "
	use	utl
	equ	T67,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 68
	use	utc
	set	Tsl,*-TC-1
	aci	"LEFT"
	use	utl
	equ	T68,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 69
	use	utc
	set	Tsl,*-TC-1
	aci	"LET "
	use	utl
	equ	T69,*-TL
	zero	Tsl*4+1,3
"
" TERMINAL 70
	use	utc
	set	Tsl,*-TC-1
	aci	"LINE"
	use	utl
	equ	T70,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 71
	use	utc
	set	Tsl,*-TC-1
	aci	"LT  "
	use	utl
	equ	T71,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 72
	use	utc
	set	Tsl,*-TC-1
	aci	"MAXL"
	aci	"INE "
	use	utl
	equ	T72,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 73
	use	utc
	set	Tsl,*-TC-1
	aci	"MINL"
	aci	"INE "
	use	utl
	equ	T73,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 74
	use	utc
	set	Tsl,*-TC-1
	aci	"NE  "
	use	utl
	equ	T74,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 75
	use	utc
	set	Tsl,*-TC-1
	aci	"NO  "
	use	utl
	equ	T75,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 76
	use	utc
	set	Tsl,*-TC-1
	aci	"NOT "
	use	utl
	equ	T76,*-TL
	zero	Tsl*4+1,3
"
" TERMINAL 77
	use	utc
	set	Tsl,*-TC-1
	aci	"NUMB"
	aci	"ER  "
	use	utl
	equ	T77,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 78
	use	utc
	set	Tsl,*-TC-1
	aci	"ON  "
	use	utl
	equ	T78,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 79
	use	utc
	set	Tsl,*-TC-1
	aci	"OPTI"
	aci	"ONAL"
	use	utl
	equ	T79,*-TL
	zero	Tsl*4+1,8
"
" TERMINAL 80
	use	utc
	set	Tsl,*-TC-1
	aci	"OR  "
	use	utl
	equ	T80,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 81
	use	utc
	set	Tsl,*-TC-1
	aci	"PAGE"
	aci	"FOOT"
	use	utl
	equ	T81,*-TL
	zero	Tsl*4+1,8
"
" TERMINAL 82
	use	utc
	set	Tsl,*-TC-1
	aci	"PAGE"
	aci	"HEAD"
	use	utl
	equ	T82,*-TL
	zero	Tsl*4+1,8
"
" TERMINAL 83
	use	utc
	set	Tsl,*-TC-1
	aci	"PAGE"
	aci	"LENG"
	aci	"TH  "
	use	utl
	equ	T83,*-TL
	zero	Tsl*4+1,10
"
" TERMINAL 84
	use	utc
	set	Tsl,*-TC-1
	aci	"PAGE"
	aci	"WIDT"
	aci	"H   "
	use	utl
	equ	T84,*-TL
	zero	Tsl*4+1,9
"
" TERMINAL 85
	use	utc
	set	Tsl,*-TC-1
	aci	"PARA"
	aci	"METE"
	aci	"R   "
	use	utl
	equ	T85,*-TL
	zero	Tsl*4+1,9
"
" TERMINAL 86
	use	utc
	set	Tsl,*-TC-1
	aci	"PICT"
	aci	"URE "
	use	utl
	equ	T86,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 87
	use	utc
	set	Tsl,*-TC-1
	aci	"POSI"
	aci	"TION"
	use	utl
	equ	T87,*-TL
	zero	Tsl*4+1,8
"
" TERMINAL 88
	use	utc
	set	Tsl,*-TC-1
	aci	"PRIN"
	aci	"T   "
	use	utl
	equ	T88,*-TL
	zero	Tsl*4+1,5
"
" TERMINAL 89
	use	utc
	set	Tsl,*-TC-1
	aci	"RECO"
	aci	"RD  "
	use	utl
	equ	T89,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 90
	use	utc
	set	Tsl,*-TC-1
	aci	"REPO"
	aci	"RT  "
	use	utl
	equ	T90,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 91
	use	utc
	set	Tsl,*-TC-1
	aci	"REPO"
	aci	"RTFO"
	aci	"OT  "
	use	utl
	equ	T91,*-TL
	zero	Tsl*4+1,10
"
" TERMINAL 92
	use	utc
	set	Tsl,*-TC-1
	aci	"REPO"
	aci	"RTHE"
	aci	"AD  "
	use	utl
	equ	T92,*-TL
	zero	Tsl*4+1,10
"
" TERMINAL 93
	use	utc
	set	Tsl,*-TC-1
	aci	"RETU"
	aci	"RNS "
	use	utl
	equ	T93,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 94
	use	utc
	set	Tsl,*-TC-1
	aci	"RIGH"
	aci	"T   "
	use	utl
	equ	T94,*-TL
	zero	Tsl*4+1,5
"
" TERMINAL 95
	use	utc
	set	Tsl,*-TC-1
	aci	"SORT"
	use	utl
	equ	T95,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 96
	use	utc
	set	Tsl,*-TC-1
	aci	"STRE"
	aci	"AM  "
	use	utl
	equ	T96,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 97
	use	utc
	set	Tsl,*-TC-1
	aci	"SWIT"
	aci	"CH  "
	use	utl
	equ	T97,*-TL
	zero	Tsl*4+1,6
"
" TERMINAL 98
	use	utc
	set	Tsl,*-TC-1
	aci	"TABL"
	aci	"E   "
	use	utl
	equ	T98,*-TL
	zero	Tsl*4+1,5
"
" TERMINAL 99
	use	utc
	set	Tsl,*-TC-1
	aci	"TRAN"
	aci	"SFOR"
	aci	"M   "
	use	utl
	equ	T99,*-TL
	zero	Tsl*4+1,9
"
" TERMINAL 100
	use	utc
	set	Tsl,*-TC-1
	aci	"TRUE"
	use	utl
	equ	T100,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 101
	use	utc
	set	Tsl,*-TC-1
	aci	"VARY"
	aci	"ING "
	use	utl
	equ	T101,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 102
	use	utc
	set	Tsl,*-TC-1
	aci	"WORD"
	use	utl
	equ	T102,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 103
	use	utc
	set	Tsl,*-TC-1
	aci	"<ide"
	aci	"ntif"
	aci	"ier>"
	use	utl
	equ	T103,*-TL
	zero	Tsl*4+1,12
"
" TERMINAL 104
	use	utc
	set	Tsl,*-TC-1
	aci	"<num"
	aci	"ber>"
	use	utl
	equ	T104,*-TL
	zero	Tsl*4+1,8
"
" TERMINAL 105
	use	utc
	set	Tsl,*-TC-1
	aci	"<quo"
	aci	"ted_"
	aci	"str>"
	use	utl
	equ	T105,*-TL
	zero	Tsl*4+1,12
"
" TERMINAL 106
	use	utc
	set	Tsl,*-TC-1
	aci	",2  "
	use	utl
	equ	T106,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 107
	use	utc
	set	Tsl,*-TC-1
	aci	",3  "
	use	utl
	equ	T107,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 108
	use	utc
	set	Tsl,*-TC-1
	aci	",4  "
	use	utl
	equ	T108,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 109
	use	utc
	set	Tsl,*-TC-1
	aci	"BSP "
	use	utl
	equ	T109,*-TL
	zero	Tsl*4+1,3
"
" TERMINAL 110
	use	utc
	set	Tsl,*-TC-1
	aci	"SPEC"
	aci	"IAL "
	use	utl
	equ	T110,*-TL
	zero	Tsl*4+1,7
"
" TERMINAL 111
	use	utc
	set	Tsl,*-TC-1
	aci	"STOP"
	use	utl
	equ	T111,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 112
	use	utc
	set	Tsl,*-TC-1
	aci	"SKIP"
	use	utl
	equ	T112,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 113
	use	utc
	set	Tsl,*-TC-1
	aci	"SET "
	use	utl
	equ	T113,*-TL
	zero	Tsl*4+1,3
"
" TERMINAL 114
	use	utc
	set	Tsl,*-TC-1
	aci	"THEN"
	use	utl
	equ	T114,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 115
	use	utc
	set	Tsl,*-TC-1
	aci	"ELSE"
	use	utl
	equ	T115,*-TL
	zero	Tsl*4+1,4
"
" TERMINAL 116
	use	utc
	set	Tsl,*-TC-1
	aci	"FI  "
	use	utl
	equ	T116,*-TL
	zero	Tsl*4+1,2
"
" TERMINAL 117
	use	utc
	set	Tsl,*-TC-1
	aci	"FI; "
	use	utl
	equ	T117,*-TL
	zero	Tsl*4+1,3
"
" TERMINAL 118
	use	utc
	set	Tsl,*-TC-1
	aci	"RECO"
	aci	"VERY"
	aci	"_TOK"
	aci	"EN  "
	use	utl
	equ	T118,*-TL
	zero	Tsl*4+1,14
"
	use	utc
	equ	TCs,"-TC-1
	use	utl
	equ	TLs,*-TL-1

	use	text
"
"
" DPDA table
DPDA:	zero	0,DPDAs
	segdef	DPDA
"
" STATE 1
	equ	ST1,*-DPDA
	zero	STRD,LN1
	zero	T28,ST72	"BEGIN
	zero	T38,ST76	"DECLARE
	zero	T39,ST80	"DECLARE_1
	zero	T41,ST83	"DEFINE_1
	equ	LN1,*-DPDA-ST1-1
"
" STATE 6
	equ	ST6,*-DPDA
	zero	APLY,LN6
	zero	0,0   pd ld
	zero	-3,5   rule/alt
	zero	3,ST60 prod/val
	zero	ST64,ST195
	equ	LN6,*-DPDA-ST6-1
"
" STATE 11
	equ	ST11,*-DPDA
	zero	NSRD,LN11
	zero	T23,-ST2450	".
	zero	T28,-ST2450	"BEGIN
	zero	T38,-ST2450	"DECLARE
	zero	T39,-ST2450	"DECLARE_1
	zero	T41,-ST2450	"DEFINE_1
	zero	T49,-ST2450	"END
	zero	T61,-ST2450	"HOLD
	zero	T62,-ST2450	"IF
	zero	T88,-ST2450	"PRINT
	zero	T95,-ST2448	"SORT
	zero	T103,-ST2450	"<identifier>
	zero	T114,-ST2450	"THEN
	equ	LN11,*-DPDA-ST11-1
"
" STATE 24
	equ	ST24,*-DPDA
	zero	STRD,LN24
	zero	T14,ST103	"(
	equ	LN24,*-DPDA-ST24-1
"
" STATE 26
	equ	ST26,*-DPDA
	zero	APLYS,LN26
	zero	0,0   pd ld
	zero	-3,4   rule/alt
	zero	3,ST6 prod/val
	equ	LN26,*-DPDA-ST26-1
"
" STATE 30
	equ	ST30,*-DPDA
	zero	NSRD,LN30
	zero	T31,-ST2454	"BREAK
	zero	T72,-ST2454	"MAXLINE
	zero	T73,-ST2454	"MINLINE
	zero	T78,-ST2454	"ON
	zero	T83,-ST2454	"PAGELENGTH
	zero	T84,-ST2454	"PAGEWIDTH
	zero	T106,-ST2461	",2
	equ	LN30,*-DPDA-ST30-1
"
" STATE 38
	equ	ST38,*-DPDA
	zero	APLYS,LN38
	zero	0,0   pd ld
	zero	-3,3   rule/alt
	zero	3,ST6 prod/val
	equ	LN38,*-DPDA-ST38-1
"
" STATE 42
	equ	ST42,*-DPDA
	zero	STRD,LN42
	zero	T103,ST134	"<identifier>
	equ	LN42,*-DPDA-ST42-1
"
" STATE 44
	equ	ST44,*-DPDA
	zero	APLYS,LN44
	zero	0,0   pd ld
	zero	-3,2   rule/alt
	zero	3,ST6 prod/val
	equ	LN44,*-DPDA-ST44-1
"
" STATE 48
	equ	ST48,*-DPDA
	zero	NSRD,LN48
	zero	T27,-ST2465	"ATTACH
	zero	T53,-ST2465	"FILE
	zero	T89,-ST2465	"RECORD
	zero	T96,-ST2465	"STREAM
	zero	T106,-ST2470	",2
	equ	LN48,*-DPDA-ST48-1
"
" STATE 54
	equ	ST54,*-DPDA
	zero	APLYS,LN54
	zero	0,0   pd ld
	zero	-3,1   rule/alt
	zero	3,ST6 prod/val
	equ	LN54,*-DPDA-ST54-1
"
" STATE 58
	equ	ST58,*-DPDA
	zero	STRD,LN58
	zero	T106,ST193	",2
	equ	LN58,*-DPDA-ST58-1
"
" STATE 60
	equ	ST60,*-DPDA
	zero	APLY1,LN60
	zero	0,0   pd ld
	zero	-2,1   rule/alt
	zero	2,ST64 prod/val
	equ	LN60,*-DPDA-ST60-1
"
" STATE 64
	equ	ST64,*-DPDA
	zero	STRD,LN64
	zero	T28,ST72	"BEGIN
	zero	T38,ST76	"DECLARE
	zero	T39,ST80	"DECLARE_1
	zero	T41,ST83	"DEFINE_1
	zero	T49,ST199	"END
	equ	LN64,*-DPDA-ST64-1
"
" STATE 70
	equ	ST70,*-DPDA
	zero	STRD,LN70
	zero	T0,ST0	"EOI
	equ	LN70,*-DPDA-ST70-1
"
" STATE 72
	equ	ST72,*-DPDA
	zero	APLY1,LN72
	zero	0,0   pd ld
	zero	186,1   rule/alt
	zero	77,ST24 prod/val
	equ	LN72,*-DPDA-ST72-1
"
" STATE 76
	equ	ST76,*-DPDA
	zero	APLY1,LN76
	zero	0,0   pd ld
	zero	75,1   rule/alt
	zero	27,ST42 prod/val
	equ	LN76,*-DPDA-ST76-1
"
" STATE 80
	equ	ST80,*-DPDA
	zero	STRD,LN80
	zero	T64,ST201	"INPUT
	zero	T85,ST205	"PARAMETER
	equ	LN80,*-DPDA-ST80-1
"
" STATE 83
	equ	ST83,*-DPDA
	zero	STRD,LN83
	zero	T90,ST209	"REPORT
	equ	LN83,*-DPDA-ST83-1
"
" STATE 85
	equ	ST85,*-DPDA
	zero	STRD,LN85
	zero	T103,ST219	"<identifier>
	equ	LN85,*-DPDA-ST85-1
"
" STATE 87
	equ	ST87,*-DPDA
	zero	NSRD,LN87
	zero	T23,-ST2474	".
	zero	T28,-ST2475	"BEGIN
	zero	T38,-ST2475	"DECLARE
	zero	T39,-ST2475	"DECLARE_1
	zero	T41,-ST2475	"DEFINE_1
	zero	T49,-ST2475	"END
	zero	T61,-ST2475	"HOLD
	zero	T62,-ST2474	"IF
	zero	T88,-ST2474	"PRINT
	zero	T103,-ST2474	"<identifier>
	zero	T114,-ST2474	"THEN
	equ	LN87,*-DPDA-ST87-1
"
" STATE 99
	equ	ST99,*-DPDA
	zero	APLY1,LN99
	zero	0,0   pd ld
	zero	208,1   rule/alt
	zero	88,ST85 prod/val
	equ	LN99,*-DPDA-ST99-1
"
" STATE 103
	equ	ST103,*-DPDA
	zero	NSRD,LN103
	zero	T15,-ST2481	")
	zero	T103,-ST2479	"<identifier>
	equ	LN103,*-DPDA-ST103-1
"
" STATE 106
	equ	ST106,*-DPDA
	zero	APLY1,LN106
	zero	0,0   pd ld
	zero	-104,1   rule/alt
	zero	42,ST110 prod/val
	equ	LN106,*-DPDA-ST106-1
"
" STATE 110
	equ	ST110,*-DPDA
	zero	NSRD,LN110
	zero	T31,-ST2485	"BREAK
	zero	T72,-ST2485	"MAXLINE
	zero	T73,-ST2485	"MINLINE
	zero	T78,-ST2485	"ON
	zero	T83,-ST2485	"PAGELENGTH
	zero	T84,-ST2485	"PAGEWIDTH
	zero	T106,-ST2486	",2
	equ	LN110,*-DPDA-ST110-1
"
" STATE 118
	equ	ST118,*-DPDA
	zero	NSRD,LN118
	zero	T106,-ST2496	",2
	equ	LN118,*-DPDA-ST118-1
"
" STATE 120
	equ	ST120,*-DPDA
	zero	STRD,LN120
	zero	T14,ST320	"(
	equ	LN120,*-DPDA-ST120-1
"
" STATE 122
	equ	ST122,*-DPDA
	zero	STRD,LN122
	zero	T104,ST323	"<number>
	equ	LN122,*-DPDA-ST122-1
"
" STATE 124
	equ	ST124,*-DPDA
	zero	STRD,LN124
	zero	T104,ST328	"<number>
	equ	LN124,*-DPDA-ST124-1
"
" STATE 126
	equ	ST126,*-DPDA
	zero	STRD,LN126
	zero	T14,ST336	"(
	zero	T53,ST339	"FILE
	zero	T97,ST340	"SWITCH
	equ	LN126,*-DPDA-ST126-1
"
" STATE 130
	equ	ST130,*-DPDA
	zero	STRD,LN130
	zero	T104,ST341	"<number>
	equ	LN130,*-DPDA-ST130-1
"
" STATE 132
	equ	ST132,*-DPDA
	zero	STRD,LN132
	zero	T104,ST345	"<number>
	equ	LN132,*-DPDA-ST132-1
"
" STATE 134
	equ	ST134,*-DPDA
	zero	STRD,LN134
	zero	T30,ST351	"DECIMAL
	zero	T33,ST355	"CHARACTER
	zero	T56,ST357	"BOOLEAN
	zero	T98,ST361	"TABLE
	zero	T113,ST363	"SET
	equ	LN134,*-DPDA-ST134-1
"
" STATE 140
	equ	ST140,*-DPDA
	zero	APLY1,LN140
	zero	0,0   pd ld
	zero	-30,1   rule/alt
	zero	18,ST144 prod/val
	equ	LN140,*-DPDA-ST140-1
"
" STATE 144
	equ	ST144,*-DPDA
	zero	NSRD,LN144
	zero	T27,-ST2501	"ATTACH
	zero	T53,-ST2501	"FILE
	zero	T89,-ST2501	"RECORD
	zero	T96,-ST2501	"STREAM
	zero	T106,-ST2502	",2
	equ	LN144,*-DPDA-ST144-1
"
" STATE 150
	equ	ST150,*-DPDA
	zero	STRD,LN150
	zero	T106,ST377	",2
	equ	LN150,*-DPDA-ST150-1
"
" STATE 152
	equ	ST152,*-DPDA
	zero	STRD,LN152
	zero	T2,ST547	"%DAY
	zero	T4,ST551	"%HHMMSS
	zero	T6,ST555	"%MMDDYY
	zero	T7,ST559	"%MONTH
	zero	T8,ST563	"%PAGENUMBER
	zero	T10,ST565	"%REPEAT
	zero	T11,ST569	"%ROMAN
	zero	T12,ST573	"%SUBSTR
	zero	T13,ST577	"%YYDDD
	zero	T14,ST581	"(
	zero	T17,ST582	"+
	zero	T19,ST588	"-
	zero	T62,ST594	"IF
	zero	T99,ST596	"TRANSFORM
	zero	T103,ST600	"<identifier>
	zero	T104,ST604	"<number>
	zero	T105,ST608	"<quoted_str>
	equ	LN152,*-DPDA-ST152-1
"
" STATE 170
	equ	ST170,*-DPDA
	zero	STRDS,ST152

"
" STATE 171
	equ	ST171,*-DPDA
	zero	NSRD,LN171
	zero	T27,-ST2508	"ATTACH
	zero	T53,-ST2508	"FILE
	zero	T89,-ST2508	"RECORD
	zero	T96,-ST2508	"STREAM
	zero	T104,-ST2506	"<number>
	zero	T106,-ST2508	",2
	equ	LN171,*-DPDA-ST171-1
"
" STATE 178
	equ	ST178,*-DPDA
	zero	NSRD,LN178
	zero	T27,-ST2514	"ATTACH
	zero	T53,-ST2514	"FILE
	zero	T89,-ST2514	"RECORD
	zero	T96,-ST2514	"STREAM
	zero	T104,-ST2512	"<number>
	zero	T106,-ST2514	",2
	equ	LN178,*-DPDA-ST178-1
"
" STATE 185
	equ	ST185,*-DPDA
	zero	APLY1,LN185
	zero	0,0   pd ld
	zero	7,1   rule/alt
	zero	6,ST189 prod/val
	equ	LN185,*-DPDA-ST185-1
"
" STATE 189
	equ	ST189,*-DPDA
	zero	STRD,LN189
	zero	T18,ST632	",
	zero	T23,ST634	".
	zero	T106,ST193	",2
	equ	LN189,*-DPDA-ST189-1
"
" STATE 193
	equ	ST193,*-DPDA
	zero	STRD,LN193
	zero	T103,ST638	"<identifier>
	equ	LN193,*-DPDA-ST193-1
"
" STATE 195
	equ	ST195,*-DPDA
	zero	APLY1,LN195
	zero	1,1   pd ld
	zero	-2,2   rule/alt
	zero	2,ST64 prod/val
	equ	LN195,*-DPDA-ST195-1
"
" STATE 199
	equ	ST199,*-DPDA
	zero	STRD,LN199
	zero	T23,ST644	".
	equ	LN199,*-DPDA-ST199-1
"
" STATE 201
	equ	ST201,*-DPDA
	zero	APLY1,LN201
	zero	1,1   pd ld
	zero	21,1   rule/alt
	zero	12,ST48 prod/val
	equ	LN201,*-DPDA-ST201-1
"
" STATE 205
	equ	ST205,*-DPDA
	zero	APLY1,LN205
	zero	1,1   pd ld
	zero	4,1   rule/alt
	zero	4,ST58 prod/val
	equ	LN205,*-DPDA-ST205-1
"
" STATE 209
	equ	ST209,*-DPDA
	zero	STRD,LN209
	zero	T103,ST648	"<identifier>
	equ	LN209,*-DPDA-ST209-1
"
" STATE 211
	equ	ST211,*-DPDA
	zero	APLY1,LN211
	zero	0,0   pd ld
	zero	-211,1   rule/alt
	zero	89,ST215 prod/val
	equ	LN211,*-DPDA-ST211-1
"
" STATE 215
	equ	ST215,*-DPDA
	zero	STRD,LN215
	zero	T18,ST652	",
	zero	T23,ST654	".
	zero	T75,ST658	"NO
	equ	LN215,*-DPDA-ST215-1
"
" STATE 219
	equ	ST219,*-DPDA
	zero	NSRD,LN219
	zero	T18,-ST2521	",
	zero	T23,-ST2521	".
	zero	T26,-ST2518	"ASCENDING
	zero	T43,-ST2518	"DESCENDING
	zero	T75,-ST2521	"NO
	equ	LN219,*-DPDA-ST219-1
"
" STATE 225
	equ	ST225,*-DPDA
	zero	APLY,LN225
	zero	0,0   pd ld
	zero	199,1   rule/alt
	zero	84,ST232 prod/val
	zero	ST1541,ST669
	zero	ST2003,ST669
	zero	ST2525,ST669
	equ	LN225,*-DPDA-ST225-1
"
" STATE 232
	equ	ST232,*-DPDA
	zero	APLY,LN232
	zero	0,0   pd ld
	zero	-191,1   rule/alt
	zero	81,ST1541 prod/val
	zero	ST1810,ST2003
	zero	ST2474,ST238
	equ	LN232,*-DPDA-ST232-1
"
" STATE 238
	equ	ST238,*-DPDA
	zero	NSRD,LN238
	zero	T23,-ST2525	".
	zero	T28,-ST2526	"BEGIN
	zero	T38,-ST2526	"DECLARE
	zero	T39,-ST2526	"DECLARE_1
	zero	T41,-ST2526	"DEFINE_1
	zero	T49,-ST2526	"END
	zero	T61,-ST2526	"HOLD
	zero	T62,-ST2525	"IF
	zero	T88,-ST2525	"PRINT
	zero	T103,-ST2525	"<identifier>
	zero	T114,-ST2525	"THEN
	equ	LN238,*-DPDA-ST238-1
"
" STATE 250
	equ	ST250,*-DPDA
	zero	NSRD,LN250
	zero	T28,-ST2532	"BEGIN
	zero	T38,-ST2532	"DECLARE
	zero	T39,-ST2532	"DECLARE_1
	zero	T41,-ST2532	"DEFINE_1
	zero	T49,-ST2532	"END
	zero	T61,-ST2530	"HOLD
	equ	LN250,*-DPDA-ST250-1
"
" STATE 257
	equ	ST257,*-DPDA
	zero	APLYS,LN257
	zero	0,0   pd ld
	zero	-201,1   rule/alt
	zero	84,ST225 prod/val
	equ	LN257,*-DPDA-ST257-1
"
" STATE 261
	equ	ST261,*-DPDA
	zero	STRD,LN261
	zero	T1,ST737	"%ABSENT
	zero	T2,ST547	"%DAY
	zero	T3,ST739	"%FIT
	zero	T4,ST551	"%HHMMSS
	zero	T5,ST743	"%LEVEL
	zero	T6,ST555	"%MMDDYY
	zero	T7,ST559	"%MONTH
	zero	T8,ST563	"%PAGENUMBER
	zero	T9,ST745	"%PRESENT
	zero	T10,ST565	"%REPEAT
	zero	T11,ST569	"%ROMAN
	zero	T12,ST573	"%SUBSTR
	zero	T13,ST577	"%YYDDD
	zero	T14,ST581	"(
	zero	T17,ST582	"+
	zero	T19,ST588	"-
	zero	T52,ST747	"FALSE
	zero	T62,ST594	"IF
	zero	T76,ST751	"NOT
	zero	T99,ST596	"TRANSFORM
	zero	T100,ST775	"TRUE
	zero	T103,ST600	"<identifier>
	zero	T104,ST604	"<number>
	zero	T105,ST608	"<quoted_str>
	equ	LN261,*-DPDA-ST261-1
"
" STATE 286
	equ	ST286,*-DPDA
	zero	STRD,LN286
	zero	T103,ST779	"<identifier>
	equ	LN286,*-DPDA-ST286-1
"
" STATE 288
	equ	ST288,*-DPDA
	zero	STRD,LN288
	zero	T22,ST781	":=
	equ	LN288,*-DPDA-ST288-1
"
" STATE 290
	equ	ST290,*-DPDA
	zero	APLYS,LN290
	zero	0,0   pd ld
	zero	202,1   rule/alt
	zero	84,ST225 prod/val
	equ	LN290,*-DPDA-ST290-1
"
" STATE 294
	equ	ST294,*-DPDA
	zero	APLY,LN294
	zero	0,0   pd ld
	zero	218,1   rule/alt
	zero	92,ST2401 prod/val
	zero	ST2479,ST299
	equ	LN294,*-DPDA-ST294-1
"
" STATE 299
	equ	ST299,*-DPDA
	zero	NSRD,LN299
	zero	T15,-ST2538	")
	zero	T103,-ST2536	"<identifier>
	equ	LN299,*-DPDA-ST299-1
"
" STATE 302
	equ	ST302,*-DPDA
	zero	STRD,LN302
	zero	T15,ST786	")
	equ	LN302,*-DPDA-ST302-1
"
" STATE 304
	equ	ST304,*-DPDA
	zero	APLY1,LN304
	zero	1,1   pd ld
	zero	-105,1   rule/alt
	zero	42,ST110 prod/val
	equ	LN304,*-DPDA-ST304-1
"
" STATE 308
	equ	ST308,*-DPDA
	zero	APLY1,LN308
	zero	0,0   pd ld
	zero	-120,1   rule/alt
	zero	47,ST312 prod/val
	equ	LN308,*-DPDA-ST308-1
"
" STATE 312
	equ	ST312,*-DPDA
	zero	NSRD,LN312
	zero	T106,-ST2548	",2
	equ	LN312,*-DPDA-ST312-1
"
" STATE 314
	equ	ST314,*-DPDA
	zero	STRD,LN314
	zero	T106,ST801	",2
	equ	LN314,*-DPDA-ST314-1
"
" STATE 316
	equ	ST316,*-DPDA
	zero	STRD,LN316
	zero	T46,ST809	"DETAILHEAD
	zero	T82,ST813	"PAGEHEAD
	zero	T92,ST817	"REPORTHEAD
	equ	LN316,*-DPDA-ST316-1
"
" STATE 320
	equ	ST320,*-DPDA
	zero	STRD,LN320
	zero	T64,ST824	"INPUT
	zero	T103,ST829	"<identifier>
	equ	LN320,*-DPDA-ST320-1
"
" STATE 323
	equ	ST323,*-DPDA
	zero	APLY,LN323
	zero	1,1   pd ld
	zero	109,1   rule/alt
	zero	43,ST106 prod/val
	zero	ST2485,ST304
	equ	LN323,*-DPDA-ST323-1
"
" STATE 328
	equ	ST328,*-DPDA
	zero	APLYS,LN328
	zero	1,1   pd ld
	zero	108,1   rule/alt
	zero	43,ST323 prod/val
	equ	LN328,*-DPDA-ST328-1
"
" STATE 332
	equ	ST332,*-DPDA
	zero	APLYS,LN332
	zero	1,1   pd ld
	zero	111,1   rule/alt
	zero	43,ST323 prod/val
	equ	LN332,*-DPDA-ST332-1
"
" STATE 336
	equ	ST336,*-DPDA
	zero	STRD,LN336
	zero	T53,ST339	"FILE
	zero	T97,ST340	"SWITCH
	equ	LN336,*-DPDA-ST336-1
"
" STATE 339
	equ	ST339,*-DPDA
	zero	STRDS,ST152

"
" STATE 340
	equ	ST340,*-DPDA
	zero	STRDS,ST152

"
" STATE 341
	equ	ST341,*-DPDA
	zero	APLYS,LN341
	zero	1,1   pd ld
	zero	107,1   rule/alt
	zero	43,ST323 prod/val
	equ	LN341,*-DPDA-ST341-1
"
" STATE 345
	equ	ST345,*-DPDA
	zero	APLYS,LN345
	zero	1,1   pd ld
	zero	106,1   rule/alt
	zero	43,ST323 prod/val
	equ	LN345,*-DPDA-ST345-1
"
" STATE 349
	equ	ST349,*-DPDA
	zero	STRD,LN349
	zero	T23,ST861	".
	equ	LN349,*-DPDA-ST349-1
"
" STATE 351
	equ	ST351,*-DPDA
	zero	APLY1,LN351
	zero	0,0   pd ld
	zero	77,1   rule/alt
	zero	29,ST349 prod/val
	equ	LN351,*-DPDA-ST351-1
"
" STATE 355
	equ	ST355,*-DPDA
	zero	STRD,LN355
	zero	T14,ST865	"(
	equ	LN355,*-DPDA-ST355-1
"
" STATE 357
	equ	ST357,*-DPDA
	zero	APLY1,LN357
	zero	0,0   pd ld
	zero	80,1   rule/alt
	zero	29,ST349 prod/val
	equ	LN357,*-DPDA-ST357-1
"
" STATE 361
	equ	ST361,*-DPDA
	zero	STRD,LN361
	zero	T14,ST867	"(
	equ	LN361,*-DPDA-ST361-1
"
" STATE 363
	equ	ST363,*-DPDA
	zero	STRD,LN363
	zero	T14,ST870	"(
	equ	LN363,*-DPDA-ST363-1
"
" STATE 365
	equ	ST365,*-DPDA
	zero	APLY1,LN365
	zero	1,1   pd ld
	zero	-31,1   rule/alt
	zero	18,ST144 prod/val
	equ	LN365,*-DPDA-ST365-1
"
" STATE 369
	equ	ST369,*-DPDA
	zero	APLY1,LN369
	zero	0,0   pd ld
	zero	-32,1   rule/alt
	zero	19,ST373 prod/val
	equ	LN369,*-DPDA-ST369-1
"
" STATE 373
	equ	ST373,*-DPDA
	zero	NSRD,LN373
	zero	T18,-ST2553	",
	zero	T23,-ST2556	".
	zero	T106,-ST2553	",2
	equ	LN373,*-DPDA-ST373-1
"
" STATE 377
	equ	ST377,*-DPDA
	zero	STRD,LN377
	zero	T54,ST888	"FILL
	zero	T103,ST890	"<identifier>
	equ	LN377,*-DPDA-ST377-1
"
" STATE 380
	equ	ST380,*-DPDA
	zero	APLY,LN380
	zero	0,0   pd ld
	zero	-306,1   rule/alt
	zero	120,ST386 prod/val
	zero	ST582,ST915
	zero	ST588,ST920
	equ	LN380,*-DPDA-ST380-1
"
" STATE 386
	equ	ST386,*-DPDA
	zero	APLY,LN386
	zero	0,0   pd ld
	zero	-297,1   rule/alt
	zero	119,ST392 prod/val
	zero	ST893,ST1250
	zero	ST901,ST1254
	equ	LN386,*-DPDA-ST386-1
"
" STATE 392
	equ	ST392,*-DPDA
	zero	APLY,LN392
	zero	0,0   pd ld
	zero	-296,1   rule/alt
	zero	118,ST398 prod/val
	zero	ST902,ST1258
	zero	ST903,ST1311
	equ	LN392,*-DPDA-ST392-1
"
" STATE 398
	equ	ST398,*-DPDA
	zero	NSRD,LN398
	zero	T15,-ST2563	")
	zero	T16,-ST2560	"*
	zero	T17,-ST2563	"+
	zero	T18,-ST2563	",
	zero	T19,-ST2563	"-
	zero	T21,-ST2560	"/
	zero	T23,-ST2563	".
	zero	T24,-ST2563	"ALIGN
	zero	T25,-ST2563	"AND
	zero	T27,-ST2563	"ATTACH
	zero	T29,-ST2563	"BEGINS
	zero	T31,-ST2563	"BREAK
	zero	T32,-ST2563	"CENTER
	zero	T33,-ST2563	"CHARACTER
	zero	T34,-ST2563	"COLUMN
	zero	T35,-ST2563	"CONCATENATE
	zero	T37,-ST2563	"CONTAINS
	zero	T40,-ST2563	"DEFAULT
	zero	T48,-ST2563	"EDIT
	zero	T50,-ST2563	"ENDS
	zero	T51,-ST2563	"EQ
	zero	T53,-ST2563	"FILE
	zero	T54,-ST2563	"FILL
	zero	T56,-ST2563	"BOOLEAN
	zero	T58,-ST2563	"FOLD
	zero	T59,-ST2563	"GE
	zero	T60,-ST2563	"GT
	zero	T62,-ST2563	"IF
	zero	T63,-ST2563	"IN
	zero	T66,-ST2563	"KEY
	zero	T67,-ST2563	"LE
	zero	T68,-ST2563	"LEFT
	zero	T69,-ST2563	"LET
	zero	T71,-ST2563	"LT
	zero	T72,-ST2563	"MAXLINE
	zero	T73,-ST2563	"MINLINE
	zero	T74,-ST2563	"NE
	zero	T76,-ST2563	"NOT
	zero	T77,-ST2563	"NUMBER
	zero	T78,-ST2563	"ON
	zero	T80,-ST2563	"OR
	zero	T83,-ST2563	"PAGELENGTH
	zero	T84,-ST2563	"PAGEWIDTH
	zero	T86,-ST2563	"PICTURE
	zero	T89,-ST2563	"RECORD
	zero	T94,-ST2563	"RIGHT
	zero	T96,-ST2563	"STREAM
	zero	T106,-ST2563	",2
	zero	T107,-ST2563	",3
	zero	T108,-ST2563	",4
	zero	T109,-ST2563	"BSP
	zero	T114,-ST2563	"THEN
	equ	LN398,*-DPDA-ST398-1
"
" STATE 451
	equ	ST451,*-DPDA
	zero	NSRD,LN451
	zero	T15,-ST2576	")
	zero	T17,-ST2573	"+
	zero	T18,-ST2576	",
	zero	T19,-ST2573	"-
	zero	T23,-ST2576	".
	zero	T24,-ST2576	"ALIGN
	zero	T25,-ST2576	"AND
	zero	T27,-ST2576	"ATTACH
	zero	T29,-ST2576	"BEGINS
	zero	T31,-ST2576	"BREAK
	zero	T32,-ST2576	"CENTER
	zero	T33,-ST2576	"CHARACTER
	zero	T34,-ST2576	"COLUMN
	zero	T35,-ST2576	"CONCATENATE
	zero	T37,-ST2576	"CONTAINS
	zero	T40,-ST2576	"DEFAULT
	zero	T48,-ST2576	"EDIT
	zero	T50,-ST2576	"ENDS
	zero	T51,-ST2576	"EQ
	zero	T53,-ST2576	"FILE
	zero	T54,-ST2576	"FILL
	zero	T56,-ST2576	"BOOLEAN
	zero	T58,-ST2576	"FOLD
	zero	T59,-ST2576	"GE
	zero	T60,-ST2576	"GT
	zero	T62,-ST2576	"IF
	zero	T63,-ST2576	"IN
	zero	T66,-ST2576	"KEY
	zero	T67,-ST2576	"LE
	zero	T68,-ST2576	"LEFT
	zero	T69,-ST2576	"LET
	zero	T71,-ST2576	"LT
	zero	T72,-ST2576	"MAXLINE
	zero	T73,-ST2576	"MINLINE
	zero	T74,-ST2576	"NE
	zero	T76,-ST2576	"NOT
	zero	T77,-ST2576	"NUMBER
	zero	T78,-ST2576	"ON
	zero	T80,-ST2576	"OR
	zero	T83,-ST2576	"PAGELENGTH
	zero	T84,-ST2576	"PAGEWIDTH
	zero	T86,-ST2576	"PICTURE
	zero	T89,-ST2576	"RECORD
	zero	T94,-ST2576	"RIGHT
	zero	T96,-ST2576	"STREAM
	zero	T106,-ST2576	",2
	zero	T107,-ST2576	",3
	zero	T108,-ST2576	",4
	zero	T109,-ST2576	"BSP
	zero	T114,-ST2576	"THEN
	equ	LN451,*-DPDA-ST451-1
"
" STATE 502
	equ	ST502,*-DPDA
	zero	APLY,LN502
	zero	0,0   pd ld
	zero	-281,1   rule/alt
	zero	115,ST507 prod/val
	zero	ST1758,ST1983
	equ	LN502,*-DPDA-ST502-1
"
" STATE 507
	equ	ST507,*-DPDA
	zero	APLY,LN507
	zero	0,0   pd ld
	zero	-278,1   rule/alt
	zero	113,ST519 prod/val
	zero	ST904,ST1364
	equ	LN507,*-DPDA-ST507-1
"
" STATE 512
	equ	ST512,*-DPDA
	zero	NSRD,LN512
	zero	T27,-ST2582	"ATTACH
	zero	T35,-ST2580	"CONCATENATE
	zero	T53,-ST2582	"FILE
	zero	T89,-ST2582	"RECORD
	zero	T96,-ST2582	"STREAM
	zero	T106,-ST2582	",2
	equ	LN512,*-DPDA-ST512-1
"
" STATE 519
	equ	ST519,*-DPDA
	zero	APLY,LN519
	zero	0,0   pd ld
	zero	-276,1   rule/alt
	zero	114,ST685 prod/val
	zero	ST152,ST512
	zero	ST170,ST612
	zero	ST339,ST838
	zero	ST340,ST850
	zero	ST751,ST1087
	zero	ST906,ST1371
	zero	ST908,ST1378
	zero	ST957,ST1418
	zero	ST977,ST1438
	zero	ST978,ST1446
	zero	ST979,ST1454
	zero	ST2027,ST2122
	equ	LN519,*-DPDA-ST519-1
"
" STATE 535
	equ	ST535,*-DPDA
	zero	APLYS,LN535
	zero	0,0   pd ld
	zero	-303,1   rule/alt
	zero	120,ST380 prod/val
	equ	LN535,*-DPDA-ST535-1
"
" STATE 539
	equ	ST539,*-DPDA
	zero	STRD,LN539
	zero	T14,ST905	"(
	equ	LN539,*-DPDA-ST539-1
"
" STATE 541
	equ	ST541,*-DPDA
	zero	STRD,LN541
	zero	T14,ST906	"(
	equ	LN541,*-DPDA-ST541-1
"
" STATE 543
	equ	ST543,*-DPDA
	zero	STRD,LN543
	zero	T14,ST907	"(
	equ	LN543,*-DPDA-ST543-1
"
" STATE 545
	equ	ST545,*-DPDA
	zero	STRD,LN545
	zero	T14,ST908	"(
	equ	LN545,*-DPDA-ST545-1
"
" STATE 547
	equ	ST547,*-DPDA
	zero	APLY1,LN547
	zero	0,0   pd ld
	zero	-288,1   rule/alt
	zero	116,ST502 prod/val
	equ	LN547,*-DPDA-ST547-1
"
" STATE 551
	equ	ST551,*-DPDA
	zero	APLY1,LN551
	zero	0,0   pd ld
	zero	-289,1   rule/alt
	zero	116,ST502 prod/val
	equ	LN551,*-DPDA-ST551-1
"
" STATE 555
	equ	ST555,*-DPDA
	zero	APLY1,LN555
	zero	0,0   pd ld
	zero	-285,1   rule/alt
	zero	116,ST502 prod/val
	equ	LN555,*-DPDA-ST555-1
"
" STATE 559
	equ	ST559,*-DPDA
	zero	APLY1,LN559
	zero	0,0   pd ld
	zero	-287,1   rule/alt
	zero	116,ST502 prod/val
	equ	LN559,*-DPDA-ST559-1
"
" STATE 563
	equ	ST563,*-DPDA
	zero	STRD,LN563
	zero	T14,ST909	"(
	equ	LN563,*-DPDA-ST563-1
"
" STATE 565
	equ	ST565,*-DPDA
	zero	APLY1,LN565
	zero	0,0   pd ld
	zero	223,1   rule/alt
	zero	96,ST541 prod/val
	equ	LN565,*-DPDA-ST565-1
"
" STATE 569
	equ	ST569,*-DPDA
	zero	APLY1,LN569
	zero	0,0   pd ld
	zero	222,1   rule/alt
	zero	95,ST543 prod/val
	equ	LN569,*-DPDA-ST569-1
"
" STATE 573
	equ	ST573,*-DPDA
	zero	APLY1,LN573
	zero	0,0   pd ld
	zero	221,1   rule/alt
	zero	94,ST545 prod/val
	equ	LN573,*-DPDA-ST573-1
"
" STATE 577
	equ	ST577,*-DPDA
	zero	APLY1,LN577
	zero	0,0   pd ld
	zero	-286,1   rule/alt
	zero	116,ST502 prod/val
	equ	LN577,*-DPDA-ST577-1
"
" STATE 581
	equ	ST581,*-DPDA
	zero	STRDS,ST261

"
" STATE 582
	equ	ST582,*-DPDA
	zero	STRD,LN582
	zero	T8,ST563	"%PAGENUMBER
	zero	T14,ST919	"(
	zero	T99,ST596	"TRANSFORM
	zero	T103,ST600	"<identifier>
	zero	T104,ST604	"<number>
	equ	LN582,*-DPDA-ST582-1
"
" STATE 588
	equ	ST588,*-DPDA
	zero	STRD,LN588
	zero	T8,ST563	"%PAGENUMBER
	zero	T14,ST924	"(
	zero	T99,ST596	"TRANSFORM
	zero	T103,ST600	"<identifier>
	zero	T104,ST604	"<number>
	equ	LN588,*-DPDA-ST588-1
"
" STATE 594
	equ	ST594,*-DPDA
	zero	STRD,LN594
	zero	T14,ST925	"(
	equ	LN594,*-DPDA-ST594-1
"
" STATE 596
	equ	ST596,*-DPDA
	zero	APLY1,LN596
	zero	0,0   pd ld
	zero	224,1   rule/alt
	zero	97,ST539 prod/val
	equ	LN596,*-DPDA-ST596-1
"
" STATE 600
	equ	ST600,*-DPDA
	zero	APLYS,LN600
	zero	0,0   pd ld
	zero	305,1   rule/alt
	zero	120,ST380 prod/val
	equ	LN600,*-DPDA-ST600-1
"
" STATE 604
	equ	ST604,*-DPDA
	zero	APLYS,LN604
	zero	0,0   pd ld
	zero	304,1   rule/alt
	zero	120,ST380 prod/val
	equ	LN604,*-DPDA-ST604-1
"
" STATE 608
	equ	ST608,*-DPDA
	zero	APLYS,LN608
	zero	0,0   pd ld
	zero	-280,1   rule/alt
	zero	115,ST502 prod/val
	equ	LN608,*-DPDA-ST608-1
"
" STATE 612
	equ	ST612,*-DPDA
	zero	NSRD,LN612
	zero	T27,-ST2588	"ATTACH
	zero	T35,-ST2586	"CONCATENATE
	zero	T53,-ST2588	"FILE
	zero	T89,-ST2588	"RECORD
	zero	T96,-ST2588	"STREAM
	zero	T106,-ST2588	",2
	equ	LN612,*-DPDA-ST612-1
"
" STATE 619
	equ	ST619,*-DPDA
	zero	APLY,LN619
	zero	1,1   pd ld
	zero	34,1   rule/alt
	zero	20,ST140 prod/val
	zero	ST2501,ST365
	equ	LN619,*-DPDA-ST619-1
"
" STATE 624
	equ	ST624,*-DPDA
	zero	APLYS,LN624
	zero	1,1   pd ld
	zero	35,1   rule/alt
	zero	20,ST619 prod/val
	equ	LN624,*-DPDA-ST624-1
"
" STATE 628
	equ	ST628,*-DPDA
	zero	APLY1,LN628
	zero	1,1   pd ld
	zero	8,1   rule/alt
	zero	6,ST189 prod/val
	equ	LN628,*-DPDA-ST628-1
"
" STATE 632
	equ	ST632,*-DPDA
	zero	STRD,LN632
	zero	T62,ST935	"IF
	equ	LN632,*-DPDA-ST632-1
"
" STATE 634
	equ	ST634,*-DPDA
	zero	APLY1,LN634
	zero	2,2   pd ld
	zero	-6,1   rule/alt
	zero	5,ST54 prod/val
	equ	LN634,*-DPDA-ST634-1
"
" STATE 638
	equ	ST638,*-DPDA
	zero	STRD,LN638
	zero	T33,ST955	"CHARACTER
	zero	T40,ST957	"DEFAULT
	zero	T56,ST958	"BOOLEAN
	zero	T62,ST935	"IF
	zero	T66,ST962	"KEY
	equ	LN638,*-DPDA-ST638-1
"
" STATE 644
	equ	ST644,*-DPDA
	zero	APLY1,LN644
	zero	2,2   pd ld
	zero	1,1   rule/alt
	zero	1,ST70 prod/val
	equ	LN644,*-DPDA-ST644-1
"
" STATE 648
	equ	ST648,*-DPDA
	zero	APLY1,LN648
	zero	2,2   pd ld
	zero	100,1   rule/alt
	zero	39,ST30 prod/val
	equ	LN648,*-DPDA-ST648-1
"
" STATE 652
	equ	ST652,*-DPDA
	zero	STRD,LN652
	zero	T103,ST219	"<identifier>
	equ	LN652,*-DPDA-ST652-1
"
" STATE 654
	equ	ST654,*-DPDA
	zero	APLY1,LN654
	zero	2,2   pd ld
	zero	209,1   rule/alt
	zero	87,ST87 prod/val
	equ	LN654,*-DPDA-ST654-1
"
" STATE 658
	equ	ST658,*-DPDA
	zero	STRD,LN658
	zero	T47,ST968	"DUPLICATE
	equ	LN658,*-DPDA-ST658-1
"
" STATE 660
	equ	ST660,*-DPDA
	zero	APLY,LN660
	zero	1,1   pd ld
	zero	214,1   rule/alt
	zero	90,ST211 prod/val
	zero	ST652,ST964
	equ	LN660,*-DPDA-ST660-1
"
" STATE 665
	equ	ST665,*-DPDA
	zero	APLYS,LN665
	zero	1,1   pd ld
	zero	215,1   rule/alt
	zero	90,ST660 prod/val
	equ	LN665,*-DPDA-ST665-1
"
" STATE 669
	equ	ST669,*-DPDA
	zero	APLYS,LN669
	zero	1,1   pd ld
	zero	-192,1   rule/alt
	zero	81,ST232 prod/val
	equ	LN669,*-DPDA-ST669-1
"
" STATE 673
	equ	ST673,*-DPDA
	zero	APLY1,LN673
	zero	3,3   pd ld
	zero	188,1   rule/alt
	zero	79,ST6 prod/val
	equ	LN673,*-DPDA-ST673-1
"
" STATE 677
	equ	ST677,*-DPDA
	zero	STRD,LN677
	zero	T23,ST973	".
	zero	T64,ST824	"INPUT
	zero	T103,ST829	"<identifier>
	equ	LN677,*-DPDA-ST677-1
"
" STATE 681
	equ	ST681,*-DPDA
	zero	APLY1,LN681
	zero	0,0   pd ld
	zero	203,1   rule/alt
	zero	85,ST677 prod/val
	equ	LN681,*-DPDA-ST681-1
"
" STATE 685
	equ	ST685,*-DPDA
	zero	NSRD,LN685
	zero	T15,-ST2605	")
	zero	T18,-ST2605	",
	zero	T23,-ST2605	".
	zero	T25,-ST2605	"AND
	zero	T29,-ST2592	"BEGINS
	zero	T35,-ST2592	"CONCATENATE
	zero	T37,-ST2592	"CONTAINS
	zero	T50,-ST2592	"ENDS
	zero	T51,-ST2592	"EQ
	zero	T59,-ST2592	"GE
	zero	T60,-ST2592	"GT
	zero	T63,-ST2592	"IN
	zero	T67,-ST2592	"LE
	zero	T71,-ST2592	"LT
	zero	T74,-ST2592	"NE
	zero	T76,-ST2592	"NOT
	zero	T80,-ST2605	"OR
	zero	T114,-ST2605	"THEN
	equ	LN685,*-DPDA-ST685-1
"
" STATE 704
	equ	ST704,*-DPDA
	zero	APLY,LN704
	zero	0,0   pd ld
	zero	-269,1   rule/alt
	zero	111,ST709 prod/val
	zero	ST751,ST1095
	equ	LN704,*-DPDA-ST704-1
"
" STATE 709
	equ	ST709,*-DPDA
	zero	APLY,LN709
	zero	0,0   pd ld
	zero	-233,1   rule/alt
	zero	102,ST722 prod/val
	zero	ST1068,ST1537
	equ	LN709,*-DPDA-ST709-1
"
" STATE 714
	equ	ST714,*-DPDA
	zero	APLYS,LN714
	zero	0,0   pd ld
	zero	-236,1   rule/alt
	zero	102,ST709 prod/val
	equ	LN714,*-DPDA-ST714-1
"
" STATE 718
	equ	ST718,*-DPDA
	zero	APLYS,LN718
	zero	0,0   pd ld
	zero	-235,1   rule/alt
	zero	102,ST709 prod/val
	equ	LN718,*-DPDA-ST718-1
"
" STATE 722
	equ	ST722,*-DPDA
	zero	APLY,LN722
	zero	0,0   pd ld
	zero	-232,1   rule/alt
	zero	101,ST727 prod/val
	zero	ST1075,ST1550
	equ	LN722,*-DPDA-ST722-1
"
" STATE 727
	equ	ST727,*-DPDA
	zero	NSRD,LN727
	zero	T15,-ST2611	")
	zero	T18,-ST2611	",
	zero	T23,-ST2611	".
	zero	T25,-ST2609	"AND
	zero	T80,-ST2611	"OR
	zero	T114,-ST2611	"THEN
	equ	LN727,*-DPDA-ST727-1
"
" STATE 734
	equ	ST734,*-DPDA
	zero	STRD,LN734
	zero	T80,ST1075	"OR
	zero	T114,ST1076	"THEN
	equ	LN734,*-DPDA-ST734-1
"
" STATE 737
	equ	ST737,*-DPDA
	zero	STRD,LN737
	zero	T14,ST1080	"(
	equ	LN737,*-DPDA-ST737-1
"
" STATE 739
	equ	ST739,*-DPDA
	zero	APLY1,LN739
	zero	0,0   pd ld
	zero	274,1   rule/alt
	zero	112,ST704 prod/val
	equ	LN739,*-DPDA-ST739-1
"
" STATE 743
	equ	ST743,*-DPDA
	zero	STRD,LN743
	zero	T14,ST1082	"(
	equ	LN743,*-DPDA-ST743-1
"
" STATE 745
	equ	ST745,*-DPDA
	zero	STRD,LN745
	zero	T14,ST1085	"(
	equ	LN745,*-DPDA-ST745-1
"
" STATE 747
	equ	ST747,*-DPDA
	zero	APLYS,LN747
	zero	0,0   pd ld
	zero	268,1   rule/alt
	zero	111,ST704 prod/val
	equ	LN747,*-DPDA-ST747-1
"
" STATE 751
	equ	ST751,*-DPDA
	zero	STRD,LN751
	zero	T1,ST737	"%ABSENT
	zero	T2,ST547	"%DAY
	zero	T3,ST739	"%FIT
	zero	T4,ST551	"%HHMMSS
	zero	T5,ST743	"%LEVEL
	zero	T6,ST555	"%MMDDYY
	zero	T7,ST559	"%MONTH
	zero	T8,ST563	"%PAGENUMBER
	zero	T9,ST745	"%PRESENT
	zero	T10,ST565	"%REPEAT
	zero	T11,ST569	"%ROMAN
	zero	T12,ST573	"%SUBSTR
	zero	T13,ST577	"%YYDDD
	zero	T14,ST581	"(
	zero	T17,ST582	"+
	zero	T19,ST588	"-
	zero	T52,ST747	"FALSE
	zero	T62,ST594	"IF
	zero	T99,ST596	"TRANSFORM
	zero	T100,ST775	"TRUE
	zero	T103,ST600	"<identifier>
	zero	T104,ST604	"<number>
	zero	T105,ST608	"<quoted_str>
	equ	LN751,*-DPDA-ST751-1
"
" STATE 775
	equ	ST775,*-DPDA
	zero	APLYS,LN775
	zero	0,0   pd ld
	zero	267,1   rule/alt
	zero	111,ST704 prod/val
	equ	LN775,*-DPDA-ST775-1
"
" STATE 779
	equ	ST779,*-DPDA
	zero	STRD,LN779
	zero	T23,ST1099	".
	equ	LN779,*-DPDA-ST779-1
"
" STATE 781
	equ	ST781,*-DPDA
	zero	STRDS,ST261

"
" STATE 782
	equ	ST782,*-DPDA
	zero	APLYS,LN782
	zero	1,1   pd ld
	zero	219,1   rule/alt
	zero	92,ST294 prod/val
	equ	LN782,*-DPDA-ST782-1
"
" STATE 786
	equ	ST786,*-DPDA
	zero	APLY1,LN786
	zero	3,3   pd ld
	zero	187,1   rule/alt
	zero	78,ST11 prod/val
	equ	LN786,*-DPDA-ST786-1
"
" STATE 790
	equ	ST790,*-DPDA
	zero	APLY1,LN790
	zero	1,1   pd ld
	zero	-121,1   rule/alt
	zero	47,ST312 prod/val
	equ	LN790,*-DPDA-ST790-1
"
" STATE 794
	equ	ST794,*-DPDA
	zero	APLY1,LN794
	zero	0,0   pd ld
	zero	-133,1   rule/alt
	zero	57,ST798 prod/val
	equ	LN794,*-DPDA-ST794-1
"
" STATE 798
	equ	ST798,*-DPDA
	zero	NSRD,LN798
	zero	T23,-ST2631	".
	zero	T106,-ST2629	",2
	equ	LN798,*-DPDA-ST798-1
"
" STATE 801
	equ	ST801,*-DPDA
	zero	STRD,LN801
	zero	T44,ST1126	"DETAIL
	equ	LN801,*-DPDA-ST801-1
"
" STATE 803
	equ	ST803,*-DPDA
	zero	STRD,LN803
	zero	T103,ST1130	"<identifier>
	equ	LN803,*-DPDA-ST803-1
"
" STATE 805
	equ	ST805,*-DPDA
	zero	STRD,LN805
	zero	T107,ST1147	",3
	equ	LN805,*-DPDA-ST805-1
"
" STATE 807
	equ	ST807,*-DPDA
	zero	STRD,LN807
	zero	T107,ST1147	",3
	equ	LN807,*-DPDA-ST807-1
"
" STATE 809
	equ	ST809,*-DPDA
	zero	APLY1,LN809
	zero	0,0   pd ld
	zero	126,1   rule/alt
	zero	51,ST803 prod/val
	equ	LN809,*-DPDA-ST809-1
"
" STATE 813
	equ	ST813,*-DPDA
	zero	APLY1,LN813
	zero	0,0   pd ld
	zero	125,1   rule/alt
	zero	50,ST805 prod/val
	equ	LN813,*-DPDA-ST813-1
"
" STATE 817
	equ	ST817,*-DPDA
	zero	APLY1,LN817
	zero	0,0   pd ld
	zero	124,1   rule/alt
	zero	49,ST807 prod/val
	equ	LN817,*-DPDA-ST817-1
"
" STATE 821
	equ	ST821,*-DPDA
	zero	STRD,LN821
	zero	T15,ST1152	")
	zero	T18,ST1156	",
	equ	LN821,*-DPDA-ST821-1
"
" STATE 824
	equ	ST824,*-DPDA
	zero	APLY,LN824
	zero	0,0   pd ld
	zero	228,1   rule/alt
	zero	99,ST821 prod/val
	zero	ST677,ST970
	equ	LN824,*-DPDA-ST824-1
"
" STATE 829
	equ	ST829,*-DPDA
	zero	APLYS,LN829
	zero	0,0   pd ld
	zero	226,1   rule/alt
	zero	99,ST824 prod/val
	equ	LN829,*-DPDA-ST829-1
"
" STATE 833
	equ	ST833,*-DPDA
	zero	NSRD,LN833
	zero	T15,-ST2637	")
	zero	T62,-ST2635	"IF
	equ	LN833,*-DPDA-ST833-1
"
" STATE 836
	equ	ST836,*-DPDA
	zero	STRD,LN836
	zero	T15,ST1160	")
	equ	LN836,*-DPDA-ST836-1
"
" STATE 838
	equ	ST838,*-DPDA
	zero	NSRD,LN838
	zero	T15,-ST2644	")
	zero	T31,-ST2644	"BREAK
	zero	T35,-ST2641	"CONCATENATE
	zero	T62,-ST2644	"IF
	zero	T72,-ST2644	"MAXLINE
	zero	T73,-ST2644	"MINLINE
	zero	T77,-ST2641	"NUMBER
	zero	T78,-ST2644	"ON
	zero	T83,-ST2644	"PAGELENGTH
	zero	T84,-ST2644	"PAGEWIDTH
	zero	T106,-ST2644	",2
	equ	LN838,*-DPDA-ST838-1
"
" STATE 850
	equ	ST850,*-DPDA
	zero	NSRD,LN850
	zero	T15,-ST2650	")
	zero	T31,-ST2650	"BREAK
	zero	T35,-ST2648	"CONCATENATE
	zero	T62,-ST2650	"IF
	zero	T72,-ST2650	"MAXLINE
	zero	T73,-ST2650	"MINLINE
	zero	T78,-ST2650	"ON
	zero	T83,-ST2650	"PAGELENGTH
	zero	T84,-ST2650	"PAGEWIDTH
	zero	T106,-ST2650	",2
	equ	LN850,*-DPDA-ST850-1
"
" STATE 861
	equ	ST861,*-DPDA
	zero	APLY1,LN861
	zero	3,3   pd ld
	zero	76,1   rule/alt
	zero	28,ST38 prod/val
	equ	LN861,*-DPDA-ST861-1
"
" STATE 865
	equ	ST865,*-DPDA
	zero	STRD,LN865
	zero	T104,ST1166	"<number>
	equ	LN865,*-DPDA-ST865-1
"
" STATE 867
	equ	ST867,*-DPDA
	zero	STRD,LN867
	zero	T104,ST1198	"<number>
	zero	T105,ST1200	"<quoted_str>
	equ	LN867,*-DPDA-ST867-1
"
" STATE 870
	equ	ST870,*-DPDA
	zero	STRD,LN870
	zero	T104,ST1210	"<number>
	zero	T105,ST1214	"<quoted_str>
	equ	LN870,*-DPDA-ST870-1
"
" STATE 873
	equ	ST873,*-DPDA
	zero	APLY1,LN873
	zero	1,1   pd ld
	zero	-33,1   rule/alt
	zero	19,ST373 prod/val
	equ	LN873,*-DPDA-ST873-1
"
" STATE 877
	equ	ST877,*-DPDA
	zero	APLY1,LN877
	zero	0,0   pd ld
	zero	-24,1   rule/alt
	zero	15,ST881 prod/val
	equ	LN877,*-DPDA-ST877-1
"
" STATE 881
	equ	ST881,*-DPDA
	zero	NSRD,LN881
	zero	T18,-ST2654	",
	zero	T23,-ST2656	".
	equ	LN881,*-DPDA-ST881-1
"
" STATE 884
	equ	ST884,*-DPDA
	zero	STRD,LN884
	zero	T23,ST1222	".
	equ	LN884,*-DPDA-ST884-1
"
" STATE 886
	equ	ST886,*-DPDA
	zero	STRD,LN886
	zero	T62,ST1235	"IF
	equ	LN886,*-DPDA-ST886-1
"
" STATE 888
	equ	ST888,*-DPDA
	zero	STRD,LN888
	zero	T14,ST1237	"(
	equ	LN888,*-DPDA-ST888-1
"
" STATE 890
	equ	ST890,*-DPDA
	zero	STRD,LN890
	zero	T30,ST1244	"DECIMAL
	zero	T33,ST1248	"CHARACTER
	equ	LN890,*-DPDA-ST890-1
"
" STATE 893
	equ	ST893,*-DPDA
	zero	STRD,LN893
	zero	T8,ST563	"%PAGENUMBER
	zero	T14,ST581	"(
	zero	T17,ST582	"+
	zero	T19,ST588	"-
	zero	T99,ST596	"TRANSFORM
	zero	T103,ST600	"<identifier>
	zero	T104,ST604	"<number>
	equ	LN893,*-DPDA-ST893-1
"
" STATE 901
	equ	ST901,*-DPDA
	zero	STRDS,ST893

"
" STATE 902
	equ	ST902,*-DPDA
	zero	STRDS,ST893

"
" STATE 903
	equ	ST903,*-DPDA
	zero	STRDS,ST893

"
" STATE 904
	equ	ST904,*-DPDA
	zero	STRDS,ST152

"
" STATE 905
	equ	ST905,*-DPDA
	zero	STRDS,ST261

"
" STATE 906
	equ	ST906,*-DPDA
	zero	STRDS,ST152

"
" STATE 907
	equ	ST907,*-DPDA
	zero	STRDS,ST893

"
" STATE 908
	equ	ST908,*-DPDA
	zero	STRDS,ST152

"
" STATE 909
	equ	ST909,*-DPDA
	zero	STRD,LN909
	zero	T15,ST1381	")
	zero	T103,ST1385	"<identifier>
	equ	LN909,*-DPDA-ST909-1
"
" STATE 912
	equ	ST912,*-DPDA
	zero	STRD,LN912
	zero	T15,ST1387	")
	zero	T80,ST1075	"OR
	equ	LN912,*-DPDA-ST912-1
"
" STATE 915
	equ	ST915,*-DPDA
	zero	APLYS,LN915
	zero	1,1   pd ld
	zero	299,1   rule/alt
	zero	119,ST386 prod/val
	equ	LN915,*-DPDA-ST915-1
"
" STATE 919
	equ	ST919,*-DPDA
	zero	STRDS,ST893

"
" STATE 920
	equ	ST920,*-DPDA
	zero	APLYS,LN920
	zero	1,1   pd ld
	zero	298,1   rule/alt
	zero	119,ST386 prod/val
	equ	LN920,*-DPDA-ST920-1
"
" STATE 924
	equ	ST924,*-DPDA
	zero	STRDS,ST893

"
" STATE 925
	equ	ST925,*-DPDA
	zero	STRDS,ST261

"
" STATE 926
	equ	ST926,*-DPDA
	zero	APLY,LN926
	zero	0,0   pd ld
	zero	-40,1   rule/alt
	zero	21,ST932 prod/val
	zero	ST2744,ST1720
	zero	ST2842,ST1948
	equ	LN926,*-DPDA-ST926-1
"
" STATE 932
	equ	ST932,*-DPDA
	zero	STRD,LN932
	zero	T23,ST1406	".
	zero	T62,ST935	"IF
	equ	LN932,*-DPDA-ST932-1
"
" STATE 935
	equ	ST935,*-DPDA
	zero	STRD,LN935
	zero	T14,ST1410	"(
	equ	LN935,*-DPDA-ST935-1
"
" STATE 937
	equ	ST937,*-DPDA
	zero	APLY,LN937
	zero	0,0   pd ld
	zero	20,1   rule/alt
	zero	9,ST942 prod/val
	zero	ST2660,ST1411
	equ	LN937,*-DPDA-ST937-1
"
" STATE 942
	equ	ST942,*-DPDA
	zero	APLY1,LN942
	zero	0,0   pd ld
	zero	-10,1   rule/alt
	zero	8,ST946 prod/val
	equ	LN942,*-DPDA-ST942-1
"
" STATE 946
	equ	ST946,*-DPDA
	zero	NSRD,LN946
	zero	T18,-ST2661	",
	zero	T23,-ST2661	".
	zero	T33,-ST2660	"CHARACTER
	zero	T40,-ST2660	"DEFAULT
	zero	T56,-ST2660	"BOOLEAN
	zero	T62,-ST2660	"IF
	zero	T66,-ST2660	"KEY
	zero	T106,-ST2661	",2
	equ	LN946,*-DPDA-ST946-1
"
" STATE 955
	equ	ST955,*-DPDA
	zero	STRD,LN955
	zero	T14,ST1415	"(
	equ	LN955,*-DPDA-ST955-1
"
" STATE 957
	equ	ST957,*-DPDA
	zero	STRDS,ST152

"
" STATE 958
	equ	ST958,*-DPDA
	zero	APLYS,LN958
	zero	0,0   pd ld
	zero	14,1   rule/alt
	zero	9,ST937 prod/val
	equ	LN958,*-DPDA-ST958-1
"
" STATE 962
	equ	ST962,*-DPDA
	zero	STRD,LN962
	zero	T14,ST1428	"(
	equ	LN962,*-DPDA-ST962-1
"
" STATE 964
	equ	ST964,*-DPDA
	zero	APLY1,LN964
	zero	2,2   pd ld
	zero	-212,1   rule/alt
	zero	89,ST215 prod/val
	equ	LN964,*-DPDA-ST964-1
"
" STATE 968
	equ	ST968,*-DPDA
	zero	STRD,LN968
	zero	T23,ST1430	".
	equ	LN968,*-DPDA-ST968-1
"
" STATE 970
	equ	ST970,*-DPDA
	zero	STRD,LN970
	zero	T18,ST1156	",
	zero	T23,ST1434	".
	equ	LN970,*-DPDA-ST970-1
"
" STATE 973
	equ	ST973,*-DPDA
	zero	APLY1,LN973
	zero	1,1   pd ld
	zero	205,1   rule/alt
	zero	86,ST673 prod/val
	equ	LN973,*-DPDA-ST973-1
"
" STATE 977
	equ	ST977,*-DPDA
	zero	STRDS,ST152

"
" STATE 978
	equ	ST978,*-DPDA
	zero	STRDS,ST152

"
" STATE 979
	equ	ST979,*-DPDA
	zero	STRDS,ST152

"
" STATE 980
	equ	ST980,*-DPDA
	zero	NSRD,LN980
	zero	T2,-ST2668	"%DAY
	zero	T4,-ST2668	"%HHMMSS
	zero	T6,-ST2668	"%MMDDYY
	zero	T7,-ST2668	"%MONTH
	zero	T8,-ST2668	"%PAGENUMBER
	zero	T10,-ST2668	"%REPEAT
	zero	T11,-ST2668	"%ROMAN
	zero	T12,-ST2668	"%SUBSTR
	zero	T13,-ST2668	"%YYDDD
	zero	T14,-ST2668	"(
	zero	T17,-ST2668	"+
	zero	T19,-ST2668	"-
	zero	T62,-ST2668	"IF
	zero	T99,-ST2668	"TRANSFORM
	zero	T102,-ST2666	"WORD
	zero	T103,-ST2668	"<identifier>
	zero	T104,-ST2668	"<number>
	zero	T105,-ST2668	"<quoted_str>
	equ	LN980,*-DPDA-ST980-1
"
" STATE 999
	equ	ST999,*-DPDA
	zero	NSRD,LN999
	zero	T2,-ST2674	"%DAY
	zero	T4,-ST2674	"%HHMMSS
	zero	T6,-ST2674	"%MMDDYY
	zero	T7,-ST2674	"%MONTH
	zero	T8,-ST2674	"%PAGENUMBER
	zero	T10,-ST2674	"%REPEAT
	zero	T11,-ST2674	"%ROMAN
	zero	T12,-ST2674	"%SUBSTR
	zero	T13,-ST2674	"%YYDDD
	zero	T14,-ST2674	"(
	zero	T17,-ST2674	"+
	zero	T19,-ST2674	"-
	zero	T62,-ST2674	"IF
	zero	T99,-ST2674	"TRANSFORM
	zero	T102,-ST2672	"WORD
	zero	T103,-ST2674	"<identifier>
	zero	T104,-ST2674	"<number>
	zero	T105,-ST2674	"<quoted_str>
	equ	LN999,*-DPDA-ST999-1
"
" STATE 1018
	equ	ST1018,*-DPDA
	zero	NSRD,LN1018
	zero	T2,-ST2680	"%DAY
	zero	T4,-ST2680	"%HHMMSS
	zero	T6,-ST2680	"%MMDDYY
	zero	T7,-ST2680	"%MONTH
	zero	T8,-ST2680	"%PAGENUMBER
	zero	T10,-ST2680	"%REPEAT
	zero	T11,-ST2680	"%ROMAN
	zero	T12,-ST2680	"%SUBSTR
	zero	T13,-ST2680	"%YYDDD
	zero	T14,-ST2680	"(
	zero	T17,-ST2680	"+
	zero	T19,-ST2680	"-
	zero	T62,-ST2680	"IF
	zero	T99,-ST2680	"TRANSFORM
	zero	T102,-ST2678	"WORD
	zero	T103,-ST2680	"<identifier>
	zero	T104,-ST2680	"<number>
	zero	T105,-ST2680	"<quoted_str>
	equ	LN1018,*-DPDA-ST1018-1
"
" STATE 1037
	equ	ST1037,*-DPDA
	zero	APLY1,LN1037
	zero	0,0   pd ld
	zero	237,1   rule/alt
	zero	103,ST979 prod/val
	equ	LN1037,*-DPDA-ST1037-1
"
" STATE 1041
	equ	ST1041,*-DPDA
	zero	APLY1,LN1041
	zero	0,0   pd ld
	zero	240,1   rule/alt
	zero	103,ST979 prod/val
	equ	LN1041,*-DPDA-ST1041-1
"
" STATE 1045
	equ	ST1045,*-DPDA
	zero	APLY1,LN1045
	zero	0,0   pd ld
	zero	242,1   rule/alt
	zero	103,ST979 prod/val
	equ	LN1045,*-DPDA-ST1045-1
"
" STATE 1049
	equ	ST1049,*-DPDA
	zero	STRD,LN1049
	zero	T103,ST1474	"<identifier>
	equ	LN1049,*-DPDA-ST1049-1
"
" STATE 1051
	equ	ST1051,*-DPDA
	zero	APLY1,LN1051
	zero	0,0   pd ld
	zero	239,1   rule/alt
	zero	103,ST979 prod/val
	equ	LN1051,*-DPDA-ST1051-1
"
" STATE 1055
	equ	ST1055,*-DPDA
	zero	APLY1,LN1055
	zero	0,0   pd ld
	zero	241,1   rule/alt
	zero	103,ST979 prod/val
	equ	LN1055,*-DPDA-ST1055-1
"
" STATE 1059
	equ	ST1059,*-DPDA
	zero	APLY1,LN1059
	zero	0,0   pd ld
	zero	238,1   rule/alt
	zero	103,ST979 prod/val
	equ	LN1059,*-DPDA-ST1059-1
"
" STATE 1063
	equ	ST1063,*-DPDA
	zero	STRD,LN1063
	zero	T28,ST1478	"BEGIN
	zero	T36,ST1497	"CONTAIN
	zero	T49,ST1516	"END
	zero	T63,ST1535	"IN
	equ	LN1063,*-DPDA-ST1063-1
"
" STATE 1068
	equ	ST1068,*-DPDA
	zero	STRDS,ST261

"
" STATE 1069
	equ	ST1069,*-DPDA
	zero	STRD,LN1069
	zero	T23,ST257	".
	zero	T62,ST261	"IF
	zero	T88,ST286	"PRINT
	zero	T103,ST288	"<identifier>
	zero	T114,ST290	"THEN
	equ	LN1069,*-DPDA-ST1069-1
"
" STATE 1075
	equ	ST1075,*-DPDA
	zero	STRDS,ST261

"
" STATE 1076
	equ	ST1076,*-DPDA
	zero	APLY1,LN1076
	zero	0,0   pd ld
	zero	193,1   rule/alt
	zero	82,ST1069 prod/val
	equ	LN1076,*-DPDA-ST1076-1
"
" STATE 1080
	equ	ST1080,*-DPDA
	zero	STRD,LN1080
	zero	T103,ST1557	"<identifier>
	equ	LN1080,*-DPDA-ST1080-1
"
" STATE 1082
	equ	ST1082,*-DPDA
	zero	STRD,LN1082
	zero	T103,ST1559	"<identifier>
	zero	T104,ST1561	"<number>
	equ	LN1082,*-DPDA-ST1082-1
"
" STATE 1085
	equ	ST1085,*-DPDA
	zero	STRD,LN1085
	zero	T103,ST1563	"<identifier>
	equ	LN1085,*-DPDA-ST1085-1
"
" STATE 1087
	equ	ST1087,*-DPDA
	zero	NSRD,LN1087
	zero	T15,-ST2686	")
	zero	T18,-ST2686	",
	zero	T23,-ST2686	".
	zero	T25,-ST2686	"AND
	zero	T35,-ST2684	"CONCATENATE
	zero	T80,-ST2686	"OR
	zero	T114,-ST2686	"THEN
	equ	LN1087,*-DPDA-ST1087-1
"
" STATE 1095
	equ	ST1095,*-DPDA
	zero	APLYS,LN1095
	zero	1,1   pd ld
	zero	234,1   rule/alt
	zero	102,ST709 prod/val
	equ	LN1095,*-DPDA-ST1095-1
"
" STATE 1099
	equ	ST1099,*-DPDA
	zero	APLYS,LN1099
	zero	2,2   pd ld
	zero	200,1   rule/alt
	zero	84,ST225 prod/val
	equ	LN1099,*-DPDA-ST1099-1
"
" STATE 1103
	equ	ST1103,*-DPDA
	zero	STRD,LN1103
	zero	T23,ST1565	".
	zero	T80,ST1075	"OR
	equ	LN1103,*-DPDA-ST1103-1
"
" STATE 1106
	equ	ST1106,*-DPDA
	zero	NSRD,LN1106
	zero	T23,-ST2692	".
	zero	T106,-ST2690	",2
	equ	LN1106,*-DPDA-ST1106-1
"
" STATE 1109
	equ	ST1109,*-DPDA
	zero	STRD,LN1109
	zero	T23,ST1581	".
	equ	LN1109,*-DPDA-ST1109-1
"
" STATE 1111
	equ	ST1111,*-DPDA
	zero	APLY1,LN1111
	zero	1,1   pd ld
	zero	-134,1   rule/alt
	zero	57,ST798 prod/val
	equ	LN1111,*-DPDA-ST1111-1
"
" STATE 1115
	equ	ST1115,*-DPDA
	zero	APLY1,LN1115
	zero	0,0   pd ld
	zero	-146,1   rule/alt
	zero	64,ST1106 prod/val
	equ	LN1115,*-DPDA-ST1115-1
"
" STATE 1119
	equ	ST1119,*-DPDA
	zero	STRD,LN1119
	zero	T44,ST1126	"DETAIL
	zero	T45,ST1591	"DETAILFOOT
	zero	T81,ST1595	"PAGEFOOT
	zero	T91,ST1599	"REPORTFOOT
	equ	LN1119,*-DPDA-ST1119-1
"
" STATE 1124
	equ	ST1124,*-DPDA
	zero	STRD,LN1124
	zero	T103,ST1603	"<identifier>
	equ	LN1124,*-DPDA-ST1124-1
"
" STATE 1126
	equ	ST1126,*-DPDA
	zero	APLY1,LN1126
	zero	0,0   pd ld
	zero	127,1   rule/alt
	zero	52,ST1124 prod/val
	equ	LN1126,*-DPDA-ST1126-1
"
" STATE 1130
	equ	ST1130,*-DPDA
	zero	STRD,LN1130
	zero	T55,ST1629	"FIT
	zero	T62,ST1633	"IF
	zero	T72,ST1635	"MAXLINE
	zero	T107,ST1147	",3
	equ	LN1130,*-DPDA-ST1130-1
"
" STATE 1135
	equ	ST1135,*-DPDA
	zero	APLY,LN1135
	zero	0,0   pd ld
	zero	-150,1   rule/alt
	zero	65,ST1610 prod/val
	zero	ST805,ST1144
	zero	ST807,ST1149
	zero	ST1585,ST1837
	zero	ST1587,ST1841
	zero	ST1623,ST1851
	equ	LN1135,*-DPDA-ST1135-1
"
" STATE 1144
	equ	ST1144,*-DPDA
	zero	NSRD,LN1144
	zero	T106,-ST2698	",2
	zero	T107,-ST2696	",3
	equ	LN1144,*-DPDA-ST1144-1
"
" STATE 1147
	equ	ST1147,*-DPDA
	zero	STRD,LN1147
	zero	T70,ST1650	"LINE
	equ	LN1147,*-DPDA-ST1147-1
"
" STATE 1149
	equ	ST1149,*-DPDA
	zero	NSRD,LN1149
	zero	T106,-ST2704	",2
	zero	T107,-ST2702	",3
	equ	LN1149,*-DPDA-ST1149-1
"
" STATE 1152
	equ	ST1152,*-DPDA
	zero	APLYS,LN1152
	zero	3,3   pd ld
	zero	110,1   rule/alt
	zero	43,ST323 prod/val
	equ	LN1152,*-DPDA-ST1152-1
"
" STATE 1156
	equ	ST1156,*-DPDA
	zero	STRD,LN1156
	zero	T103,ST1654	"<identifier>
	equ	LN1156,*-DPDA-ST1156-1
"
" STATE 1158
	equ	ST1158,*-DPDA
	zero	STRD,LN1158
	zero	T14,ST1658	"(
	equ	LN1158,*-DPDA-ST1158-1
"
" STATE 1160
	equ	ST1160,*-DPDA
	zero	APLYS,LN1160
	zero	3,3   pd ld
	zero	-112,1   rule/alt
	zero	43,ST323 prod/val
	equ	LN1160,*-DPDA-ST1160-1
"
" STATE 1164
	equ	ST1164,*-DPDA
	zero	STRD,LN1164
	zero	T104,ST1659	"<number>
	equ	LN1164,*-DPDA-ST1164-1
"
" STATE 1166
	equ	ST1166,*-DPDA
	zero	STRD,LN1166
	zero	T15,ST1664	")
	equ	LN1166,*-DPDA-ST1166-1
"
" STATE 1168
	equ	ST1168,*-DPDA
	zero	APLY1,LN1168
	zero	0,0   pd ld
	zero	-97,1   rule/alt
	zero	37,ST1172 prod/val
	equ	LN1168,*-DPDA-ST1168-1
"
" STATE 1172
	equ	ST1172,*-DPDA
	zero	NSRD,LN1172
	zero	T15,-ST2710	")
	zero	T105,-ST2708	"<quoted_str>
	equ	LN1172,*-DPDA-ST1172-1
"
" STATE 1175
	equ	ST1175,*-DPDA
	zero	APLY1,LN1175
	zero	0,0   pd ld
	zero	-93,1   rule/alt
	zero	35,ST1179 prod/val
	equ	LN1175,*-DPDA-ST1175-1
"
" STATE 1179
	equ	ST1179,*-DPDA
	zero	NSRD,LN1179
	zero	T15,-ST2716	")
	zero	T105,-ST2714	"<quoted_str>
	equ	LN1179,*-DPDA-ST1179-1
"
" STATE 1182
	equ	ST1182,*-DPDA
	zero	APLY1,LN1182
	zero	0,0   pd ld
	zero	-89,1   rule/alt
	zero	33,ST1186 prod/val
	equ	LN1182,*-DPDA-ST1182-1
"
" STATE 1186
	equ	ST1186,*-DPDA
	zero	NSRD,LN1186
	zero	T15,-ST2722	")
	zero	T104,-ST2720	"<number>
	equ	LN1186,*-DPDA-ST1186-1
"
" STATE 1189
	equ	ST1189,*-DPDA
	zero	APLY1,LN1189
	zero	0,0   pd ld
	zero	-85,1   rule/alt
	zero	31,ST1193 prod/val
	equ	LN1189,*-DPDA-ST1189-1
"
" STATE 1193
	equ	ST1193,*-DPDA
	zero	NSRD,LN1193
	zero	T15,-ST2728	")
	zero	T104,-ST2726	"<number>
	equ	LN1193,*-DPDA-ST1193-1
"
" STATE 1196
	equ	ST1196,*-DPDA
	zero	STRD,LN1196
	zero	T15,ST1691	")
	equ	LN1196,*-DPDA-ST1196-1
"
" STATE 1198
	equ	ST1198,*-DPDA
	zero	STRD,LN1198
	zero	T20,ST1694	"->
	equ	LN1198,*-DPDA-ST1198-1
"
" STATE 1200
	equ	ST1200,*-DPDA
	zero	STRD,LN1200
	zero	T20,ST1697	"->
	equ	LN1200,*-DPDA-ST1200-1
"
" STATE 1202
	equ	ST1202,*-DPDA
	zero	NSRD,LN1202
	zero	T15,-ST2734	")
	zero	T18,-ST2732	",
	equ	LN1202,*-DPDA-ST1202-1
"
" STATE 1205
	equ	ST1205,*-DPDA
	zero	NSRD,LN1205
	zero	T15,-ST2740	")
	zero	T18,-ST2738	",
	equ	LN1205,*-DPDA-ST1205-1
"
" STATE 1208
	equ	ST1208,*-DPDA
	zero	STRD,LN1208
	zero	T15,ST1704	")
	equ	LN1208,*-DPDA-ST1208-1
"
" STATE 1210
	equ	ST1210,*-DPDA
	zero	APLY1,LN1210
	zero	0,0   pd ld
	zero	262,1   rule/alt
	zero	109,ST1205 prod/val
	equ	LN1210,*-DPDA-ST1210-1
"
" STATE 1214
	equ	ST1214,*-DPDA
	zero	APLY1,LN1214
	zero	0,0   pd ld
	zero	263,1   rule/alt
	zero	110,ST1202 prod/val
	equ	LN1214,*-DPDA-ST1214-1
"
" STATE 1218
	equ	ST1218,*-DPDA
	zero	APLY1,LN1218
	zero	1,1   pd ld
	zero	-25,1   rule/alt
	zero	15,ST881 prod/val
	equ	LN1218,*-DPDA-ST1218-1
"
" STATE 1222
	equ	ST1222,*-DPDA
	zero	APLY1,LN1222
	zero	4,4   pd ld
	zero	-22,1   rule/alt
	zero	13,ST44 prod/val
	equ	LN1222,*-DPDA-ST1222-1
"
" STATE 1226
	equ	ST1226,*-DPDA
	zero	APLY,LN1226
	zero	1,1   pd ld
	zero	-27,1   rule/alt
	zero	16,ST877 prod/val
	zero	ST2654,ST1218
	equ	LN1226,*-DPDA-ST1226-1
"
" STATE 1231
	equ	ST1231,*-DPDA
	zero	APLYS,LN1231
	zero	1,1   pd ld
	zero	-26,1   rule/alt
	zero	16,ST1226 prod/val
	equ	LN1231,*-DPDA-ST1231-1
"
" STATE 1235
	equ	ST1235,*-DPDA
	zero	STRD,LN1235
	zero	T14,ST1708	"(
	equ	LN1235,*-DPDA-ST1235-1
"
" STATE 1237
	equ	ST1237,*-DPDA
	zero	STRD,LN1237
	zero	T104,ST1709	"<number>
	equ	LN1237,*-DPDA-ST1237-1
"
" STATE 1239
	equ	ST1239,*-DPDA
	zero	NSRD,LN1239
	zero	T18,-ST2746	",
	zero	T23,-ST2746	".
	zero	T62,-ST2744	"IF
	zero	T106,-ST2746	",2
	equ	LN1239,*-DPDA-ST1239-1
"
" STATE 1244
	equ	ST1244,*-DPDA
	zero	STRD,LN1244
	zero	T14,ST1725	"(
	zero	T42,ST1727	"DELIMITED
	zero	T110,ST1729	"SPECIAL
	equ	LN1244,*-DPDA-ST1244-1
"
" STATE 1248
	equ	ST1248,*-DPDA
	zero	STRD,LN1248
	zero	T14,ST1736	"(
	equ	LN1248,*-DPDA-ST1248-1
"
" STATE 1250
	equ	ST1250,*-DPDA
	zero	APLYS,LN1250
	zero	2,2   pd ld
	zero	294,1   rule/alt
	zero	118,ST392 prod/val
	equ	LN1250,*-DPDA-ST1250-1
"
" STATE 1254
	equ	ST1254,*-DPDA
	zero	APLYS,LN1254
	zero	2,2   pd ld
	zero	295,1   rule/alt
	zero	118,ST392 prod/val
	equ	LN1254,*-DPDA-ST1254-1
"
" STATE 1258
	equ	ST1258,*-DPDA
	zero	NSRD,LN1258
	zero	T15,-ST2751	")
	zero	T16,-ST2750	"*
	zero	T17,-ST2751	"+
	zero	T18,-ST2751	",
	zero	T19,-ST2751	"-
	zero	T21,-ST2750	"/
	zero	T23,-ST2751	".
	zero	T24,-ST2751	"ALIGN
	zero	T25,-ST2751	"AND
	zero	T27,-ST2751	"ATTACH
	zero	T29,-ST2751	"BEGINS
	zero	T31,-ST2751	"BREAK
	zero	T32,-ST2751	"CENTER
	zero	T33,-ST2751	"CHARACTER
	zero	T34,-ST2751	"COLUMN
	zero	T35,-ST2751	"CONCATENATE
	zero	T37,-ST2751	"CONTAINS
	zero	T40,-ST2751	"DEFAULT
	zero	T48,-ST2751	"EDIT
	zero	T50,-ST2751	"ENDS
	zero	T51,-ST2751	"EQ
	zero	T53,-ST2751	"FILE
	zero	T54,-ST2751	"FILL
	zero	T56,-ST2751	"BOOLEAN
	zero	T58,-ST2751	"FOLD
	zero	T59,-ST2751	"GE
	zero	T60,-ST2751	"GT
	zero	T62,-ST2751	"IF
	zero	T63,-ST2751	"IN
	zero	T66,-ST2751	"KEY
	zero	T67,-ST2751	"LE
	zero	T68,-ST2751	"LEFT
	zero	T69,-ST2751	"LET
	zero	T71,-ST2751	"LT
	zero	T72,-ST2751	"MAXLINE
	zero	T73,-ST2751	"MINLINE
	zero	T74,-ST2751	"NE
	zero	T76,-ST2751	"NOT
	zero	T77,-ST2751	"NUMBER
	zero	T78,-ST2751	"ON
	zero	T80,-ST2751	"OR
	zero	T83,-ST2751	"PAGELENGTH
	zero	T84,-ST2751	"PAGEWIDTH
	zero	T86,-ST2751	"PICTURE
	zero	T89,-ST2751	"RECORD
	zero	T94,-ST2751	"RIGHT
	zero	T96,-ST2751	"STREAM
	zero	T106,-ST2751	",2
	zero	T107,-ST2751	",3
	zero	T108,-ST2751	",4
	zero	T109,-ST2751	"BSP
	zero	T114,-ST2751	"THEN
	equ	LN1258,*-DPDA-ST1258-1
"
" STATE 1311
	equ	ST1311,*-DPDA
	zero	NSRD,LN1311
	zero	T15,-ST2756	")
	zero	T16,-ST2755	"*
	zero	T17,-ST2756	"+
	zero	T18,-ST2756	",
	zero	T19,-ST2756	"-
	zero	T21,-ST2755	"/
	zero	T23,-ST2756	".
	zero	T24,-ST2756	"ALIGN
	zero	T25,-ST2756	"AND
	zero	T27,-ST2756	"ATTACH
	zero	T29,-ST2756	"BEGINS
	zero	T31,-ST2756	"BREAK
	zero	T32,-ST2756	"CENTER
	zero	T33,-ST2756	"CHARACTER
	zero	T34,-ST2756	"COLUMN
	zero	T35,-ST2756	"CONCATENATE
	zero	T37,-ST2756	"CONTAINS
	zero	T40,-ST2756	"DEFAULT
	zero	T48,-ST2756	"EDIT
	zero	T50,-ST2756	"ENDS
	zero	T51,-ST2756	"EQ
	zero	T53,-ST2756	"FILE
	zero	T54,-ST2756	"FILL
	zero	T56,-ST2756	"BOOLEAN
	zero	T58,-ST2756	"FOLD
	zero	T59,-ST2756	"GE
	zero	T60,-ST2756	"GT
	zero	T62,-ST2756	"IF
	zero	T63,-ST2756	"IN
	zero	T66,-ST2756	"KEY
	zero	T67,-ST2756	"LE
	zero	T68,-ST2756	"LEFT
	zero	T69,-ST2756	"LET
	zero	T71,-ST2756	"LT
	zero	T72,-ST2756	"MAXLINE
	zero	T73,-ST2756	"MINLINE
	zero	T74,-ST2756	"NE
	zero	T76,-ST2756	"NOT
	zero	T77,-ST2756	"NUMBER
	zero	T78,-ST2756	"ON
	zero	T80,-ST2756	"OR
	zero	T83,-ST2756	"PAGELENGTH
	zero	T84,-ST2756	"PAGEWIDTH
	zero	T86,-ST2756	"PICTURE
	zero	T89,-ST2756	"RECORD
	zero	T94,-ST2756	"RIGHT
	zero	T96,-ST2756	"STREAM
	zero	T106,-ST2756	",2
	zero	T107,-ST2756	",3
	zero	T108,-ST2756	",4
	zero	T109,-ST2756	"BSP
	zero	T114,-ST2756	"THEN
	equ	LN1311,*-DPDA-ST1311-1
"
" STATE 1364
	equ	ST1364,*-DPDA
	zero	APLYS,LN1364
	zero	2,2   pd ld
	zero	277,1   rule/alt
	zero	114,ST519 prod/val
	equ	LN1364,*-DPDA-ST1364-1
"
" STATE 1368
	equ	ST1368,*-DPDA
	zero	STRD,LN1368
	zero	T18,ST1738	",
	zero	T80,ST1075	"OR
	equ	LN1368,*-DPDA-ST1368-1
"
" STATE 1371
	equ	ST1371,*-DPDA
	zero	STRD,LN1371
	zero	T18,ST1740	",
	zero	T35,ST904	"CONCATENATE
	equ	LN1371,*-DPDA-ST1371-1
"
" STATE 1374
	equ	ST1374,*-DPDA
	zero	STRD,LN1374
	zero	T15,ST1741	")
	zero	T17,ST902	"+
	zero	T19,ST903	"-
	equ	LN1374,*-DPDA-ST1374-1
"
" STATE 1378
	equ	ST1378,*-DPDA
	zero	STRD,LN1378
	zero	T18,ST1745	",
	zero	T35,ST904	"CONCATENATE
	equ	LN1378,*-DPDA-ST1378-1
"
" STATE 1381
	equ	ST1381,*-DPDA
	zero	APLY1,LN1381
	zero	2,2   pd ld
	zero	308,1   rule/alt
	zero	121,ST380 prod/val
	equ	LN1381,*-DPDA-ST1381-1
"
" STATE 1385
	equ	ST1385,*-DPDA
	zero	STRD,LN1385
	zero	T15,ST1746	")
	equ	LN1385,*-DPDA-ST1385-1
"
" STATE 1387
	equ	ST1387,*-DPDA
	zero	APLYS,LN1387
	zero	2,2   pd ld
	zero	302,1   rule/alt
	zero	119,ST386 prod/val
	equ	LN1387,*-DPDA-ST1387-1
"
" STATE 1391
	equ	ST1391,*-DPDA
	zero	STRD,LN1391
	zero	T15,ST1750	")
	zero	T17,ST902	"+
	zero	T19,ST903	"-
	equ	LN1391,*-DPDA-ST1391-1
"
" STATE 1395
	equ	ST1395,*-DPDA
	zero	STRD,LN1395
	zero	T15,ST1754	")
	zero	T17,ST902	"+
	zero	T19,ST903	"-
	equ	LN1395,*-DPDA-ST1395-1
"
" STATE 1399
	equ	ST1399,*-DPDA
	zero	STRD,LN1399
	zero	T15,ST1758	")
	zero	T80,ST1075	"OR
	equ	LN1399,*-DPDA-ST1399-1
"
" STATE 1402
	equ	ST1402,*-DPDA
	zero	APLYS,LN1402
	zero	1,1   pd ld
	zero	42,1   rule/alt
	zero	21,ST926 prod/val
	equ	LN1402,*-DPDA-ST1402-1
"
" STATE 1406
	equ	ST1406,*-DPDA
	zero	APLY1,LN1406
	zero	4,4   pd ld
	zero	5,1   rule/alt
	zero	5,ST54 prod/val
	equ	LN1406,*-DPDA-ST1406-1
"
" STATE 1410
	equ	ST1410,*-DPDA
	zero	STRDS,ST261

"
" STATE 1411
	equ	ST1411,*-DPDA
	zero	APLY1,LN1411
	zero	1,1   pd ld
	zero	-11,1   rule/alt
	zero	8,ST946 prod/val
	equ	LN1411,*-DPDA-ST1411-1
"
" STATE 1415
	equ	ST1415,*-DPDA
	zero	STRD,LN1415
	zero	T16,ST1778	"*
	zero	T104,ST1780	"<number>
	equ	LN1415,*-DPDA-ST1415-1
"
" STATE 1418
	equ	ST1418,*-DPDA
	zero	NSRD,LN1418
	zero	T18,-ST2762	",
	zero	T23,-ST2762	".
	zero	T33,-ST2762	"CHARACTER
	zero	T35,-ST2760	"CONCATENATE
	zero	T40,-ST2762	"DEFAULT
	zero	T56,-ST2762	"BOOLEAN
	zero	T62,-ST2762	"IF
	zero	T66,-ST2762	"KEY
	zero	T106,-ST2762	",2
	equ	LN1418,*-DPDA-ST1418-1
"
" STATE 1428
	equ	ST1428,*-DPDA
	zero	STRD,LN1428
	zero	T105,ST1789	"<quoted_str>
	equ	LN1428,*-DPDA-ST1428-1
"
" STATE 1430
	equ	ST1430,*-DPDA
	zero	APLY1,LN1430
	zero	4,4   pd ld
	zero	210,1   rule/alt
	zero	87,ST87 prod/val
	equ	LN1430,*-DPDA-ST1430-1
"
" STATE 1434
	equ	ST1434,*-DPDA
	zero	APLY1,LN1434
	zero	2,2   pd ld
	zero	206,1   rule/alt
	zero	86,ST673 prod/val
	equ	LN1434,*-DPDA-ST1434-1
"
" STATE 1438
	equ	ST1438,*-DPDA
	zero	NSRD,LN1438
	zero	T15,-ST2768	")
	zero	T18,-ST2768	",
	zero	T23,-ST2768	".
	zero	T25,-ST2768	"AND
	zero	T35,-ST2766	"CONCATENATE
	zero	T80,-ST2768	"OR
	zero	T114,-ST2768	"THEN
	equ	LN1438,*-DPDA-ST1438-1
"
" STATE 1446
	equ	ST1446,*-DPDA
	zero	NSRD,LN1446
	zero	T15,-ST2774	")
	zero	T18,-ST2774	",
	zero	T23,-ST2774	".
	zero	T25,-ST2774	"AND
	zero	T35,-ST2772	"CONCATENATE
	zero	T80,-ST2774	"OR
	zero	T114,-ST2774	"THEN
	equ	LN1446,*-DPDA-ST1446-1
"
" STATE 1454
	equ	ST1454,*-DPDA
	zero	NSRD,LN1454
	zero	T15,-ST2780	")
	zero	T18,-ST2780	",
	zero	T23,-ST2780	".
	zero	T25,-ST2780	"AND
	zero	T35,-ST2778	"CONCATENATE
	zero	T80,-ST2780	"OR
	zero	T114,-ST2780	"THEN
	equ	LN1454,*-DPDA-ST1454-1
"
" STATE 1462
	equ	ST1462,*-DPDA
	zero	APLY1,LN1462
	zero	1,1   pd ld
	zero	252,1   rule/alt
	zero	106,ST977 prod/val
	equ	LN1462,*-DPDA-ST1462-1
"
" STATE 1466
	equ	ST1466,*-DPDA
	zero	APLY1,LN1466
	zero	1,1   pd ld
	zero	256,1   rule/alt
	zero	106,ST977 prod/val
	equ	LN1466,*-DPDA-ST1466-1
"
" STATE 1470
	equ	ST1470,*-DPDA
	zero	APLY1,LN1470
	zero	1,1   pd ld
	zero	254,1   rule/alt
	zero	106,ST977 prod/val
	equ	LN1470,*-DPDA-ST1470-1
"
" STATE 1474
	equ	ST1474,*-DPDA
	zero	APLY1,LN1474
	zero	2,2   pd ld
	zero	258,1   rule/alt
	zero	107,ST714 prod/val
	equ	LN1474,*-DPDA-ST1474-1
"
" STATE 1478
	equ	ST1478,*-DPDA
	zero	NSRD,LN1478
	zero	T2,-ST2786	"%DAY
	zero	T4,-ST2786	"%HHMMSS
	zero	T6,-ST2786	"%MMDDYY
	zero	T7,-ST2786	"%MONTH
	zero	T8,-ST2786	"%PAGENUMBER
	zero	T10,-ST2786	"%REPEAT
	zero	T11,-ST2786	"%ROMAN
	zero	T12,-ST2786	"%SUBSTR
	zero	T13,-ST2786	"%YYDDD
	zero	T14,-ST2786	"(
	zero	T17,-ST2786	"+
	zero	T19,-ST2786	"-
	zero	T62,-ST2786	"IF
	zero	T99,-ST2786	"TRANSFORM
	zero	T102,-ST2784	"WORD
	zero	T103,-ST2786	"<identifier>
	zero	T104,-ST2786	"<number>
	zero	T105,-ST2786	"<quoted_str>
	equ	LN1478,*-DPDA-ST1478-1
"
" STATE 1497
	equ	ST1497,*-DPDA
	zero	NSRD,LN1497
	zero	T2,-ST2792	"%DAY
	zero	T4,-ST2792	"%HHMMSS
	zero	T6,-ST2792	"%MMDDYY
	zero	T7,-ST2792	"%MONTH
	zero	T8,-ST2792	"%PAGENUMBER
	zero	T10,-ST2792	"%REPEAT
	zero	T11,-ST2792	"%ROMAN
	zero	T12,-ST2792	"%SUBSTR
	zero	T13,-ST2792	"%YYDDD
	zero	T14,-ST2792	"(
	zero	T17,-ST2792	"+
	zero	T19,-ST2792	"-
	zero	T62,-ST2792	"IF
	zero	T99,-ST2792	"TRANSFORM
	zero	T102,-ST2790	"WORD
	zero	T103,-ST2792	"<identifier>
	zero	T104,-ST2792	"<number>
	zero	T105,-ST2792	"<quoted_str>
	equ	LN1497,*-DPDA-ST1497-1
"
" STATE 1516
	equ	ST1516,*-DPDA
	zero	NSRD,LN1516
	zero	T2,-ST2798	"%DAY
	zero	T4,-ST2798	"%HHMMSS
	zero	T6,-ST2798	"%MMDDYY
	zero	T7,-ST2798	"%MONTH
	zero	T8,-ST2798	"%PAGENUMBER
	zero	T10,-ST2798	"%REPEAT
	zero	T11,-ST2798	"%ROMAN
	zero	T12,-ST2798	"%SUBSTR
	zero	T13,-ST2798	"%YYDDD
	zero	T14,-ST2798	"(
	zero	T17,-ST2798	"+
	zero	T19,-ST2798	"-
	zero	T62,-ST2798	"IF
	zero	T99,-ST2798	"TRANSFORM
	zero	T102,-ST2796	"WORD
	zero	T103,-ST2798	"<identifier>
	zero	T104,-ST2798	"<number>
	zero	T105,-ST2798	"<quoted_str>
	equ	LN1516,*-DPDA-ST1516-1
"
" STATE 1535
	equ	ST1535,*-DPDA
	zero	STRD,LN1535
	zero	T103,ST1806	"<identifier>
	equ	LN1535,*-DPDA-ST1535-1
"
" STATE 1537
	equ	ST1537,*-DPDA
	zero	APLYS,LN1537
	zero	2,2   pd ld
	zero	231,1   rule/alt
	zero	101,ST722 prod/val
	equ	LN1537,*-DPDA-ST1537-1
"
" STATE 1541
	equ	ST1541,*-DPDA
	zero	STRD,LN1541
	zero	T23,ST257	".
	zero	T62,ST261	"IF
	zero	T88,ST286	"PRINT
	zero	T103,ST288	"<identifier>
	zero	T114,ST290	"THEN
	zero	T115,ST1811	"ELSE
	zero	T116,ST1815	"FI
	zero	T117,ST1817	"FI.
	equ	LN1541,*-DPDA-ST1541-1
"
" STATE 1550
	equ	ST1550,*-DPDA
	zero	NSRD,LN1550
	zero	T15,-ST2804	")
	zero	T18,-ST2804	",
	zero	T23,-ST2804	".
	zero	T25,-ST2802	"AND
	zero	T80,-ST2804	"OR
	zero	T114,-ST2804	"THEN
	equ	LN1550,*-DPDA-ST1550-1
"
" STATE 1557
	equ	ST1557,*-DPDA
	zero	STRD,LN1557
	zero	T15,ST1821	")
	equ	LN1557,*-DPDA-ST1557-1
"
" STATE 1559
	equ	ST1559,*-DPDA
	zero	STRD,LN1559
	zero	T15,ST1825	")
	equ	LN1559,*-DPDA-ST1559-1
"
" STATE 1561
	equ	ST1561,*-DPDA
	zero	STRD,LN1561
	zero	T15,ST1829	")
	equ	LN1561,*-DPDA-ST1561-1
"
" STATE 1563
	equ	ST1563,*-DPDA
	zero	STRD,LN1563
	zero	T15,ST1833	")
	equ	LN1563,*-DPDA-ST1563-1
"
" STATE 1565
	equ	ST1565,*-DPDA
	zero	APLY,LN1565
	zero	3,3   pd ld
	zero	220,1   rule/alt
	zero	93,ST225 prod/val
	zero	ST2329,ST294
	zero	ST2401,ST782
	zero	ST2479,ST294
	zero	ST2536,ST782
	equ	LN1565,*-DPDA-ST1565-1
"
" STATE 1573
	equ	ST1573,*-DPDA
	zero	APLY1,LN1573
	zero	1,1   pd ld
	zero	-147,1   rule/alt
	zero	64,ST1106 prod/val
	equ	LN1573,*-DPDA-ST1573-1
"
" STATE 1577
	equ	ST1577,*-DPDA
	zero	STRD,LN1577
	zero	T45,ST1591	"DETAILFOOT
	zero	T81,ST1595	"PAGEFOOT
	zero	T91,ST1599	"REPORTFOOT
	equ	LN1577,*-DPDA-ST1577-1
"
" STATE 1581
	equ	ST1581,*-DPDA
	zero	APLY1,LN1581
	zero	5,5   pd ld
	zero	101,1   rule/alt
	zero	40,ST26 prod/val
	equ	LN1581,*-DPDA-ST1581-1
"
" STATE 1585
	equ	ST1585,*-DPDA
	zero	STRD,LN1585
	zero	T107,ST1147	",3
	equ	LN1585,*-DPDA-ST1585-1
"
" STATE 1587
	equ	ST1587,*-DPDA
	zero	STRD,LN1587
	zero	T107,ST1147	",3
	equ	LN1587,*-DPDA-ST1587-1
"
" STATE 1589
	equ	ST1589,*-DPDA
	zero	STRD,LN1589
	zero	T103,ST1845	"<identifier>
	equ	LN1589,*-DPDA-ST1589-1
"
" STATE 1591
	equ	ST1591,*-DPDA
	zero	APLY1,LN1591
	zero	0,0   pd ld
	zero	128,1   rule/alt
	zero	53,ST1589 prod/val
	equ	LN1591,*-DPDA-ST1591-1
"
" STATE 1595
	equ	ST1595,*-DPDA
	zero	APLY1,LN1595
	zero	0,0   pd ld
	zero	129,1   rule/alt
	zero	54,ST1587 prod/val
	equ	LN1595,*-DPDA-ST1595-1
"
" STATE 1599
	equ	ST1599,*-DPDA
	zero	APLY1,LN1599
	zero	0,0   pd ld
	zero	130,1   rule/alt
	zero	55,ST1585 prod/val
	equ	LN1599,*-DPDA-ST1599-1
"
" STATE 1603
	equ	ST1603,*-DPDA
	zero	NSRD,LN1603
	zero	T23,-ST2809	".
	zero	T55,-ST2808	"FIT
	zero	T62,-ST2808	"IF
	zero	T72,-ST2808	"MAXLINE
	zero	T106,-ST2809	",2
	zero	T107,-ST2808	",3
	equ	LN1603,*-DPDA-ST1603-1
"
" STATE 1610
	equ	ST1610,*-DPDA
	zero	NSRD,LN1610
	zero	T23,-ST2815	".
	zero	T106,-ST2815	",2
	zero	T107,-ST2813	",3
	equ	LN1610,*-DPDA-ST1610-1
"
" STATE 1614
	equ	ST1614,*-DPDA
	zero	APLY,LN1614
	zero	0,0   pd ld
	zero	-140,1   rule/alt
	zero	61,ST1619 prod/val
	zero	ST1623,ST1855
	equ	LN1614,*-DPDA-ST1614-1
"
" STATE 1619
	equ	ST1619,*-DPDA
	zero	APLY1,LN1619
	zero	0,0   pd ld
	zero	-138,1   rule/alt
	zero	60,ST1623 prod/val
	equ	LN1619,*-DPDA-ST1619-1
"
" STATE 1623
	equ	ST1623,*-DPDA
	zero	STRDS,ST1130

"
" STATE 1624
	equ	ST1624,*-DPDA
	zero	APLY,LN1624
	zero	3,3   pd ld
	zero	131,1   rule/alt
	zero	48,ST308 prod/val
	zero	ST2542,ST790
	equ	LN1624,*-DPDA-ST1624-1
"
" STATE 1629
	equ	ST1629,*-DPDA
	zero	APLYS,LN1629
	zero	0,0   pd ld
	zero	143,1   rule/alt
	zero	61,ST1614 prod/val
	equ	LN1629,*-DPDA-ST1629-1
"
" STATE 1633
	equ	ST1633,*-DPDA
	zero	STRD,LN1633
	zero	T14,ST1859	"(
	equ	LN1633,*-DPDA-ST1633-1
"
" STATE 1635
	equ	ST1635,*-DPDA
	zero	STRD,LN1635
	zero	T104,ST1860	"<number>
	equ	LN1635,*-DPDA-ST1635-1
"
" STATE 1637
	equ	ST1637,*-DPDA
	zero	APLYS,LN1637
	zero	1,1   pd ld
	zero	-151,1   rule/alt
	zero	65,ST1135 prod/val
	equ	LN1637,*-DPDA-ST1637-1
"
" STATE 1641
	equ	ST1641,*-DPDA
	zero	NSRD,LN1641
	zero	T17,-ST2821	"+
	zero	T23,-ST2826	".
	zero	T62,-ST2821	"IF
	zero	T65,-ST2821	"PAUSE
	zero	T104,-ST2821	"<number>
	zero	T106,-ST2826	",2
	zero	T107,-ST2826	",3
	zero	T108,-ST2826	",4
	equ	LN1641,*-DPDA-ST1641-1
"
" STATE 1650
	equ	ST1650,*-DPDA
	zero	APLY1,LN1650
	zero	0,0   pd ld
	zero	152,1   rule/alt
	zero	66,ST1641 prod/val
	equ	LN1650,*-DPDA-ST1650-1
"
" STATE 1654
	equ	ST1654,*-DPDA
	zero	APLYS,LN1654
	zero	2,2   pd ld
	zero	227,1   rule/alt
	zero	99,ST824 prod/val
	equ	LN1654,*-DPDA-ST1654-1
"
" STATE 1658
	equ	ST1658,*-DPDA
	zero	STRDS,ST261

"
" STATE 1659
	equ	ST1659,*-DPDA
	zero	APLY,LN1659
	zero	3,3   pd ld
	zero	116,1   rule/alt
	zero	45,ST833 prod/val
	zero	ST126,ST332
	equ	LN1659,*-DPDA-ST1659-1
"
" STATE 1664
	equ	ST1664,*-DPDA
	zero	NSRD,LN1664
	zero	T23,-ST2832	".
	zero	T101,-ST2830	"VARYING
	equ	LN1664,*-DPDA-ST1664-1
"
" STATE 1667
	equ	ST1667,*-DPDA
	zero	APLY1,LN1667
	zero	1,1   pd ld
	zero	-98,1   rule/alt
	zero	37,ST1172 prod/val
	equ	LN1667,*-DPDA-ST1667-1
"
" STATE 1671
	equ	ST1671,*-DPDA
	zero	STRD,LN1671
	zero	T20,ST1896	"->
	equ	LN1671,*-DPDA-ST1671-1
"
" STATE 1673
	equ	ST1673,*-DPDA
	zero	APLY1,LN1673
	zero	1,1   pd ld
	zero	-94,1   rule/alt
	zero	35,ST1179 prod/val
	equ	LN1673,*-DPDA-ST1673-1
"
" STATE 1677
	equ	ST1677,*-DPDA
	zero	STRD,LN1677
	zero	T20,ST1898	"->
	equ	LN1677,*-DPDA-ST1677-1
"
" STATE 1679
	equ	ST1679,*-DPDA
	zero	APLY1,LN1679
	zero	1,1   pd ld
	zero	-90,1   rule/alt
	zero	33,ST1186 prod/val
	equ	LN1679,*-DPDA-ST1679-1
"
" STATE 1683
	equ	ST1683,*-DPDA
	zero	STRD,LN1683
	zero	T20,ST1900	"->
	equ	LN1683,*-DPDA-ST1683-1
"
" STATE 1685
	equ	ST1685,*-DPDA
	zero	APLY1,LN1685
	zero	1,1   pd ld
	zero	-86,1   rule/alt
	zero	31,ST1193 prod/val
	equ	LN1685,*-DPDA-ST1685-1
"
" STATE 1689
	equ	ST1689,*-DPDA
	zero	STRD,LN1689
	zero	T20,ST1902	"->
	equ	LN1689,*-DPDA-ST1689-1
"
" STATE 1691
	equ	ST1691,*-DPDA
	zero	NSRD,LN1691
	zero	T23,-ST2838	".
	zero	T101,-ST2836	"VARYING
	equ	LN1691,*-DPDA-ST1691-1
"
" STATE 1694
	equ	ST1694,*-DPDA
	zero	STRD,LN1694
	zero	T104,ST1908	"<number>
	zero	T105,ST1913	"<quoted_str>
	equ	LN1694,*-DPDA-ST1694-1
"
" STATE 1697
	equ	ST1697,*-DPDA
	zero	STRD,LN1697
	zero	T104,ST1918	"<number>
	zero	T105,ST1923	"<quoted_str>
	equ	LN1697,*-DPDA-ST1697-1
"
" STATE 1700
	equ	ST1700,*-DPDA
	zero	STRD,LN1700
	zero	T105,ST1928	"<quoted_str>
	equ	LN1700,*-DPDA-ST1700-1
"
" STATE 1702
	equ	ST1702,*-DPDA
	zero	STRD,LN1702
	zero	T104,ST1932	"<number>
	equ	LN1702,*-DPDA-ST1702-1
"
" STATE 1704
	equ	ST1704,*-DPDA
	zero	APLY1,LN1704
	zero	3,3   pd ld
	zero	81,1   rule/alt
	zero	29,ST349 prod/val
	equ	LN1704,*-DPDA-ST1704-1
"
" STATE 1708
	equ	ST1708,*-DPDA
	zero	STRDS,ST261

"
" STATE 1709
	equ	ST1709,*-DPDA
	zero	STRD,LN1709
	zero	T15,ST1939	")
	equ	LN1709,*-DPDA-ST1709-1
"
" STATE 1711
	equ	ST1711,*-DPDA
	zero	APLY1,LN1711
	zero	0,0   pd ld
	zero	-41,1   rule/alt
	zero	22,ST1715 prod/val
	equ	LN1711,*-DPDA-ST1711-1
"
" STATE 1715
	equ	ST1715,*-DPDA
	zero	NSRD,LN1715
	zero	T18,-ST2844	",
	zero	T23,-ST2844	".
	zero	T62,-ST2842	"IF
	zero	T106,-ST2844	",2
	equ	LN1715,*-DPDA-ST1715-1
"
" STATE 1720
	equ	ST1720,*-DPDA
	zero	NSRD,LN1720
	zero	T18,-ST2850	",
	zero	T23,-ST2850	".
	zero	T62,-ST2848	"IF
	zero	T106,-ST2850	",2
	equ	LN1720,*-DPDA-ST1720-1
"
" STATE 1725
	equ	ST1725,*-DPDA
	zero	STRD,LN1725
	zero	T104,ST1953	"<number>
	equ	LN1725,*-DPDA-ST1725-1
"
" STATE 1727
	equ	ST1727,*-DPDA
	zero	STRD,LN1727
	zero	T105,ST1955	"<quoted_str>
	equ	LN1727,*-DPDA-ST1727-1
"
" STATE 1729
	equ	ST1729,*-DPDA
	zero	NSRD,LN1729
	zero	T18,-ST2857	",
	zero	T23,-ST2857	".
	zero	T62,-ST2857	"IF
	zero	T79,-ST2854	"OPTIONAL
	zero	T87,-ST2854	"POSITION
	zero	T106,-ST2857	",2
	equ	LN1729,*-DPDA-ST1729-1
"
" STATE 1736
	equ	ST1736,*-DPDA
	zero	STRD,LN1736
	zero	T104,ST1970	"<number>
	equ	LN1736,*-DPDA-ST1736-1
"
" STATE 1738
	equ	ST1738,*-DPDA
	zero	STRD,LN1738
	zero	T103,ST1972	"<identifier>
	equ	LN1738,*-DPDA-ST1738-1
"
" STATE 1740
	equ	ST1740,*-DPDA
	zero	STRDS,ST893

"
" STATE 1741
	equ	ST1741,*-DPDA
	zero	APLY1,LN1741
	zero	3,3   pd ld
	zero	284,1   rule/alt
	zero	116,ST502 prod/val
	equ	LN1741,*-DPDA-ST1741-1
"
" STATE 1745
	equ	ST1745,*-DPDA
	zero	STRDS,ST893

"
" STATE 1746
	equ	ST1746,*-DPDA
	zero	APLY1,LN1746
	zero	3,3   pd ld
	zero	307,1   rule/alt
	zero	121,ST380 prod/val
	equ	LN1746,*-DPDA-ST1746-1
"
" STATE 1750
	equ	ST1750,*-DPDA
	zero	APLYS,LN1750
	zero	3,3   pd ld
	zero	301,1   rule/alt
	zero	119,ST386 prod/val
	equ	LN1750,*-DPDA-ST1750-1
"
" STATE 1754
	equ	ST1754,*-DPDA
	zero	APLYS,LN1754
	zero	3,3   pd ld
	zero	300,1   rule/alt
	zero	119,ST386 prod/val
	equ	LN1754,*-DPDA-ST1754-1
"
" STATE 1758
	equ	ST1758,*-DPDA
	zero	STRD,LN1758
	zero	T2,ST547	"%DAY
	zero	T4,ST551	"%HHMMSS
	zero	T6,ST555	"%MMDDYY
	zero	T7,ST559	"%MONTH
	zero	T8,ST563	"%PAGENUMBER
	zero	T10,ST565	"%REPEAT
	zero	T11,ST569	"%ROMAN
	zero	T12,ST573	"%SUBSTR
	zero	T13,ST577	"%YYDDD
	zero	T14,ST581	"(
	zero	T17,ST582	"+
	zero	T19,ST588	"-
	zero	T99,ST596	"TRANSFORM
	zero	T103,ST600	"<identifier>
	zero	T104,ST604	"<number>
	zero	T105,ST608	"<quoted_str>
	equ	LN1758,*-DPDA-ST1758-1
"
" STATE 1775
	equ	ST1775,*-DPDA
	zero	STRD,LN1775
	zero	T15,ST1987	")
	zero	T80,ST1075	"OR
	equ	LN1775,*-DPDA-ST1775-1
"
" STATE 1778
	equ	ST1778,*-DPDA
	zero	STRD,LN1778
	zero	T15,ST1989	")
	equ	LN1778,*-DPDA-ST1778-1
"
" STATE 1780
	equ	ST1780,*-DPDA
	zero	STRD,LN1780
	zero	T15,ST1993	")
	equ	LN1780,*-DPDA-ST1780-1
"
" STATE 1782
	equ	ST1782,*-DPDA
	zero	APLY1,LN1782
	zero	0,0   pd ld
	zero	-17,1   rule/alt
	zero	10,ST1786 prod/val
	equ	LN1782,*-DPDA-ST1782-1
"
" STATE 1786
	equ	ST1786,*-DPDA
	zero	STRD,LN1786
	zero	T15,ST1997	")
	zero	T18,ST2001	",
	equ	LN1786,*-DPDA-ST1786-1
"
" STATE 1789
	equ	ST1789,*-DPDA
	zero	APLY,LN1789
	zero	0,0   pd ld
	zero	19,1   rule/alt
	zero	11,ST1782 prod/val
	zero	ST2001,ST2108
	equ	LN1789,*-DPDA-ST1789-1
"
" STATE 1794
	equ	ST1794,*-DPDA
	zero	APLY1,LN1794
	zero	2,2   pd ld
	zero	253,1   rule/alt
	zero	106,ST977 prod/val
	equ	LN1794,*-DPDA-ST1794-1
"
" STATE 1798
	equ	ST1798,*-DPDA
	zero	APLY1,LN1798
	zero	2,2   pd ld
	zero	257,1   rule/alt
	zero	106,ST977 prod/val
	equ	LN1798,*-DPDA-ST1798-1
"
" STATE 1802
	equ	ST1802,*-DPDA
	zero	APLY1,LN1802
	zero	2,2   pd ld
	zero	255,1   rule/alt
	zero	106,ST977 prod/val
	equ	LN1802,*-DPDA-ST1802-1
"
" STATE 1806
	equ	ST1806,*-DPDA
	zero	APLY1,LN1806
	zero	3,3   pd ld
	zero	259,1   rule/alt
	zero	107,ST714 prod/val
	equ	LN1806,*-DPDA-ST1806-1
"
" STATE 1810
	equ	ST1810,*-DPDA
	zero	STRDS,ST1069

"
" STATE 1811
	equ	ST1811,*-DPDA
	zero	APLY1,LN1811
	zero	0,0   pd ld
	zero	194,1   rule/alt
	zero	83,ST1810 prod/val
	equ	LN1811,*-DPDA-ST1811-1
"
" STATE 1815
	equ	ST1815,*-DPDA
	zero	STRD,LN1815
	zero	T23,ST2011	".
	equ	LN1815,*-DPDA-ST1815-1
"
" STATE 1817
	equ	ST1817,*-DPDA
	zero	APLYS,LN1817
	zero	4,4   pd ld
	zero	196,1   rule/alt
	zero	84,ST225 prod/val
	equ	LN1817,*-DPDA-ST1817-1
"
" STATE 1821
	equ	ST1821,*-DPDA
	zero	APLY1,LN1821
	zero	3,3   pd ld
	zero	272,1   rule/alt
	zero	112,ST704 prod/val
	equ	LN1821,*-DPDA-ST1821-1
"
" STATE 1825
	equ	ST1825,*-DPDA
	zero	APLY1,LN1825
	zero	3,3   pd ld
	zero	270,1   rule/alt
	zero	112,ST704 prod/val
	equ	LN1825,*-DPDA-ST1825-1
"
" STATE 1829
	equ	ST1829,*-DPDA
	zero	APLY1,LN1829
	zero	3,3   pd ld
	zero	271,1   rule/alt
	zero	112,ST704 prod/val
	equ	LN1829,*-DPDA-ST1829-1
"
" STATE 1833
	equ	ST1833,*-DPDA
	zero	APLY1,LN1833
	zero	3,3   pd ld
	zero	273,1   rule/alt
	zero	112,ST704 prod/val
	equ	LN1833,*-DPDA-ST1833-1
"
" STATE 1837
	equ	ST1837,*-DPDA
	zero	NSRD,LN1837
	zero	T23,-ST2863	".
	zero	T106,-ST2863	",2
	zero	T107,-ST2861	",3
	equ	LN1837,*-DPDA-ST1837-1
"
" STATE 1841
	equ	ST1841,*-DPDA
	zero	NSRD,LN1841
	zero	T23,-ST2869	".
	zero	T106,-ST2869	",2
	zero	T107,-ST2867	",3
	equ	LN1841,*-DPDA-ST1841-1
"
" STATE 1845
	equ	ST1845,*-DPDA
	zero	STRDS,ST1130

"
" STATE 1846
	equ	ST1846,*-DPDA
	zero	APLY,LN1846
	zero	3,3   pd ld
	zero	135,1   rule/alt
	zero	58,ST794 prod/val
	zero	ST2629,ST1111
	equ	LN1846,*-DPDA-ST1846-1
"
" STATE 1851
	equ	ST1851,*-DPDA
	zero	NSRD,LN1851
	zero	T23,-ST2875	".
	zero	T106,-ST2875	",2
	zero	T107,-ST2873	",3
	equ	LN1851,*-DPDA-ST1851-1
"
" STATE 1855
	equ	ST1855,*-DPDA
	zero	APLY1,LN1855
	zero	1,1   pd ld
	zero	-139,1   rule/alt
	zero	60,ST1623 prod/val
	equ	LN1855,*-DPDA-ST1855-1
"
" STATE 1859
	equ	ST1859,*-DPDA
	zero	STRDS,ST261

"
" STATE 1860
	equ	ST1860,*-DPDA
	zero	APLYS,LN1860
	zero	1,1   pd ld
	zero	142,1   rule/alt
	zero	61,ST1614 prod/val
	equ	LN1860,*-DPDA-ST1860-1
"
" STATE 1864
	equ	ST1864,*-DPDA
	zero	APLY1,LN1864
	zero	0,0   pd ld
	zero	-154,1   rule/alt
	zero	68,ST1868 prod/val
	equ	LN1864,*-DPDA-ST1864-1
"
" STATE 1868
	equ	ST1868,*-DPDA
	zero	NSRD,LN1868
	zero	T23,-ST2881	".
	zero	T106,-ST2881	",2
	zero	T107,-ST2881	",3
	zero	T108,-ST2879	",4
	equ	LN1868,*-DPDA-ST1868-1
"
" STATE 1873
	equ	ST1873,*-DPDA
	zero	STRD,LN1873
	zero	T104,ST2047	"<number>
	equ	LN1873,*-DPDA-ST1873-1
"
" STATE 1875
	equ	ST1875,*-DPDA
	zero	STRD,LN1875
	zero	T14,ST2053	"(
	equ	LN1875,*-DPDA-ST1875-1
"
" STATE 1877
	equ	ST1877,*-DPDA
	zero	NSRD,LN1877
	zero	T23,-ST2887	".
	zero	T62,-ST2885	"IF
	zero	T106,-ST2887	",2
	zero	T107,-ST2887	",3
	zero	T108,-ST2887	",4
	equ	LN1877,*-DPDA-ST1877-1
"
" STATE 1883
	equ	ST1883,*-DPDA
	zero	NSRD,LN1883
	zero	T23,-ST2893	".
	zero	T62,-ST2891	"IF
	zero	T106,-ST2893	",2
	zero	T107,-ST2893	",3
	zero	T108,-ST2893	",4
	equ	LN1883,*-DPDA-ST1883-1
"
" STATE 1889
	equ	ST1889,*-DPDA
	zero	STRD,LN1889
	zero	T15,ST2058	")
	zero	T80,ST1075	"OR
	equ	LN1889,*-DPDA-ST1889-1
"
" STATE 1892
	equ	ST1892,*-DPDA
	zero	APLY1,LN1892
	zero	4,4   pd ld
	zero	79,1   rule/alt
	zero	29,ST349 prod/val
	equ	LN1892,*-DPDA-ST1892-1
"
" STATE 1896
	equ	ST1896,*-DPDA
	zero	STRD,LN1896
	zero	T105,ST1923	"<quoted_str>
	equ	LN1896,*-DPDA-ST1896-1
"
" STATE 1898
	equ	ST1898,*-DPDA
	zero	STRD,LN1898
	zero	T104,ST1918	"<number>
	equ	LN1898,*-DPDA-ST1898-1
"
" STATE 1900
	equ	ST1900,*-DPDA
	zero	STRD,LN1900
	zero	T105,ST1913	"<quoted_str>
	equ	LN1900,*-DPDA-ST1900-1
"
" STATE 1902
	equ	ST1902,*-DPDA
	zero	STRD,LN1902
	zero	T104,ST1908	"<number>
	equ	LN1902,*-DPDA-ST1902-1
"
" STATE 1904
	equ	ST1904,*-DPDA
	zero	APLY1,LN1904
	zero	4,4   pd ld
	zero	83,1   rule/alt
	zero	29,ST349 prod/val
	equ	LN1904,*-DPDA-ST1904-1
"
" STATE 1908
	equ	ST1908,*-DPDA
	zero	APLY,LN1908
	zero	2,2   pd ld
	zero	87,1   rule/alt
	zero	32,ST1189 prod/val
	zero	ST2726,ST1685
	equ	LN1908,*-DPDA-ST1908-1
"
" STATE 1913
	equ	ST1913,*-DPDA
	zero	APLY,LN1913
	zero	2,2   pd ld
	zero	91,1   rule/alt
	zero	34,ST1182 prod/val
	zero	ST2720,ST1679
	equ	LN1913,*-DPDA-ST1913-1
"
" STATE 1918
	equ	ST1918,*-DPDA
	zero	APLY,LN1918
	zero	2,2   pd ld
	zero	95,1   rule/alt
	zero	36,ST1175 prod/val
	zero	ST2714,ST1673
	equ	LN1918,*-DPDA-ST1918-1
"
" STATE 1923
	equ	ST1923,*-DPDA
	zero	APLY,LN1923
	zero	2,2   pd ld
	zero	99,1   rule/alt
	zero	38,ST1168 prod/val
	zero	ST2708,ST1667
	equ	LN1923,*-DPDA-ST1923-1
"
" STATE 1928
	equ	ST1928,*-DPDA
	zero	APLY1,LN1928
	zero	2,2   pd ld
	zero	265,1   rule/alt
	zero	110,ST1202 prod/val
	equ	LN1928,*-DPDA-ST1928-1
"
" STATE 1932
	equ	ST1932,*-DPDA
	zero	APLY1,LN1932
	zero	2,2   pd ld
	zero	264,1   rule/alt
	zero	109,ST1205 prod/val
	equ	LN1932,*-DPDA-ST1932-1
"
" STATE 1936
	equ	ST1936,*-DPDA
	zero	STRD,LN1936
	zero	T15,ST2060	")
	zero	T80,ST1075	"OR
	equ	LN1936,*-DPDA-ST1936-1
"
" STATE 1939
	equ	ST1939,*-DPDA
	zero	APLY,LN1939
	zero	4,4   pd ld
	zero	74,1   rule/alt
	zero	25,ST369 prod/val
	zero	ST2553,ST873
	equ	LN1939,*-DPDA-ST1939-1
"
" STATE 1944
	equ	ST1944,*-DPDA
	zero	APLY1,LN1944
	zero	1,1   pd ld
	zero	43,1   rule/alt
	zero	22,ST1715 prod/val
	equ	LN1944,*-DPDA-ST1944-1
"
" STATE 1948
	equ	ST1948,*-DPDA
	zero	NSRD,LN1948
	zero	T18,-ST2899	",
	zero	T23,-ST2899	".
	zero	T62,-ST2897	"IF
	zero	T106,-ST2899	",2
	equ	LN1948,*-DPDA-ST1948-1
"
" STATE 1953
	equ	ST1953,*-DPDA
	zero	STRD,LN1953
	zero	T15,ST2063	")
	equ	LN1953,*-DPDA-ST1953-1
"
" STATE 1955
	equ	ST1955,*-DPDA
	zero	NSRD,LN1955
	zero	T18,-ST2906	",
	zero	T23,-ST2906	".
	zero	T62,-ST2906	"IF
	zero	T79,-ST2903	"OPTIONAL
	zero	T87,-ST2903	"POSITION
	zero	T106,-ST2906	",2
	equ	LN1955,*-DPDA-ST1955-1
"
" STATE 1962
	equ	ST1962,*-DPDA
	zero	NSRD,LN1962
	zero	T18,-ST2912	",
	zero	T23,-ST2912	".
	zero	T62,-ST2912	"IF
	zero	T87,-ST2910	"POSITION
	zero	T106,-ST2912	",2
	equ	LN1962,*-DPDA-ST1962-1
"
" STATE 1968
	equ	ST1968,*-DPDA
	zero	STRD,LN1968
	zero	T104,ST2080	"<number>
	equ	LN1968,*-DPDA-ST1968-1
"
" STATE 1970
	equ	ST1970,*-DPDA
	zero	STRD,LN1970
	zero	T15,ST2084	")
	equ	LN1970,*-DPDA-ST1970-1
"
" STATE 1972
	equ	ST1972,*-DPDA
	zero	STRD,LN1972
	zero	T15,ST2093	")
	equ	LN1972,*-DPDA-ST1972-1
"
" STATE 1974
	equ	ST1974,*-DPDA
	zero	STRD,LN1974
	zero	T15,ST2097	")
	zero	T17,ST902	"+
	zero	T19,ST903	"-
	equ	LN1974,*-DPDA-ST1974-1
"
" STATE 1978
	equ	ST1978,*-DPDA
	zero	STRD,LN1978
	zero	T15,ST2101	")
	zero	T17,ST902	"+
	zero	T18,ST2105	",
	zero	T19,ST903	"-
	equ	LN1978,*-DPDA-ST1978-1
"
" STATE 1983
	equ	ST1983,*-DPDA
	zero	APLYS,LN1983
	zero	4,4   pd ld
	zero	275,1   rule/alt
	zero	113,ST507 prod/val
	equ	LN1983,*-DPDA-ST1983-1
"
" STATE 1987
	equ	ST1987,*-DPDA
	zero	STRD,LN1987
	zero	T111,ST2106	"STOP
	equ	LN1987,*-DPDA-ST1987-1
"
" STATE 1989
	equ	ST1989,*-DPDA
	zero	APLYS,LN1989
	zero	3,3   pd ld
	zero	12,1   rule/alt
	zero	9,ST937 prod/val
	equ	LN1989,*-DPDA-ST1989-1
"
" STATE 1993
	equ	ST1993,*-DPDA
	zero	APLYS,LN1993
	zero	3,3   pd ld
	zero	13,1   rule/alt
	zero	9,ST937 prod/val
	equ	LN1993,*-DPDA-ST1993-1
"
" STATE 1997
	equ	ST1997,*-DPDA
	zero	APLYS,LN1997
	zero	3,3   pd ld
	zero	-16,1   rule/alt
	zero	9,ST937 prod/val
	equ	LN1997,*-DPDA-ST1997-1
"
" STATE 2001
	equ	ST2001,*-DPDA
	zero	STRD,LN2001
	zero	T105,ST1789	"<quoted_str>
	equ	LN2001,*-DPDA-ST2001-1
"
" STATE 2003
	equ	ST2003,*-DPDA
	zero	STRD,LN2003
	zero	T23,ST257	".
	zero	T62,ST261	"IF
	zero	T88,ST286	"PRINT
	zero	T103,ST288	"<identifier>
	zero	T114,ST290	"THEN
	zero	T116,ST2112	"FI
	zero	T117,ST2114	"FI.
	equ	LN2003,*-DPDA-ST2003-1
"
" STATE 2011
	equ	ST2011,*-DPDA
	zero	APLYS,LN2011
	zero	5,5   pd ld
	zero	195,1   rule/alt
	zero	84,ST225 prod/val
	equ	LN2011,*-DPDA-ST2011-1
"
" STATE 2015
	equ	ST2015,*-DPDA
	zero	APLY,LN2015
	zero	3,3   pd ld
	zero	132,1   rule/alt
	zero	56,ST1115 prod/val
	zero	ST2690,ST1573
	equ	LN2015,*-DPDA-ST2015-1
"
" STATE 2020
	equ	ST2020,*-DPDA
	zero	STRD,LN2020
	zero	T15,ST2118	")
	zero	T80,ST1075	"OR
	equ	LN2020,*-DPDA-ST2020-1
"
" STATE 2023
	equ	ST2023,*-DPDA
	zero	APLY1,LN2023
	zero	0,0   pd ld
	zero	-165,1   rule/alt
	zero	71,ST2028 prod/val
	equ	LN2023,*-DPDA-ST2023-1
"
" STATE 2027
	equ	ST2027,*-DPDA
	zero	STRDS,ST152

"
" STATE 2028
	equ	ST2028,*-DPDA
	zero	NSRD,LN2028
	zero	T23,-ST2918	".
	zero	T106,-ST2918	",2
	zero	T107,-ST2918	",3
	zero	T108,-ST2916	",4
	equ	LN2028,*-DPDA-ST2028-1
"
" STATE 2033
	equ	ST2033,*-DPDA
	zero	APLY,LN2033
	zero	3,3   pd ld
	zero	153,1   rule/alt
	zero	67,ST1135 prod/val
	zero	ST2696,ST1637
	zero	ST2702,ST1637
	zero	ST2813,ST1637
	zero	ST2861,ST1637
	zero	ST2867,ST1637
	zero	ST2873,ST1637
	equ	LN2033,*-DPDA-ST2033-1
"
" STATE 2043
	equ	ST2043,*-DPDA
	zero	APLY1,LN2043
	zero	0,0   pd ld
	zero	167,1   rule/alt
	zero	72,ST2027 prod/val
	equ	LN2043,*-DPDA-ST2043-1
"
" STATE 2047
	equ	ST2047,*-DPDA
	zero	NSRD,LN2047
	zero	T23,-ST2924	".
	zero	T62,-ST2922	"IF
	zero	T106,-ST2924	",2
	zero	T107,-ST2924	",3
	zero	T108,-ST2924	",4
	equ	LN2047,*-DPDA-ST2047-1
"
" STATE 2053
	equ	ST2053,*-DPDA
	zero	STRDS,ST261

"
" STATE 2054
	equ	ST2054,*-DPDA
	zero	STRD,LN2054
	zero	T14,ST2149	"(
	equ	LN2054,*-DPDA-ST2054-1
"
" STATE 2056
	equ	ST2056,*-DPDA
	zero	STRD,LN2056
	zero	T14,ST2150	"(
	equ	LN2056,*-DPDA-ST2056-1
"
" STATE 2058
	equ	ST2058,*-DPDA
	zero	STRD,LN2058
	zero	T80,ST2151	"OR
	equ	LN2058,*-DPDA-ST2058-1
"
" STATE 2060
	equ	ST2060,*-DPDA
	zero	STRD,LN2060
	zero	T111,ST2106	"STOP
	zero	T112,ST2152	"SKIP
	equ	LN2060,*-DPDA-ST2060-1
"
" STATE 2063
	equ	ST2063,*-DPDA
	zero	NSRD,LN2063
	zero	T18,-ST2931	",
	zero	T23,-ST2931	".
	zero	T62,-ST2931	"IF
	zero	T79,-ST2928	"OPTIONAL
	zero	T87,-ST2928	"POSITION
	zero	T106,-ST2931	",2
	equ	LN2063,*-DPDA-ST2063-1
"
" STATE 2070
	equ	ST2070,*-DPDA
	zero	NSRD,LN2070
	zero	T18,-ST2937	",
	zero	T23,-ST2937	".
	zero	T62,-ST2937	"IF
	zero	T87,-ST2935	"POSITION
	zero	T106,-ST2937	",2
	equ	LN2070,*-DPDA-ST2070-1
"
" STATE 2076
	equ	ST2076,*-DPDA
	zero	STRD,LN2076
	zero	T104,ST2164	"<number>
	equ	LN2076,*-DPDA-ST2076-1
"
" STATE 2078
	equ	ST2078,*-DPDA
	zero	STRD,LN2078
	zero	T104,ST2168	"<number>
	equ	LN2078,*-DPDA-ST2078-1
"
" STATE 2080
	equ	ST2080,*-DPDA
	zero	APLY1,LN2080
	zero	3,3   pd ld
	zero	68,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2080,*-DPDA-ST2080-1
"
" STATE 2084
	equ	ST2084,*-DPDA
	zero	NSRD,LN2084
	zero	T18,-ST2946	",
	zero	T23,-ST2946	".
	zero	T42,-ST2941	"DELIMITED
	zero	T62,-ST2946	"IF
	zero	T79,-ST2941	"OPTIONAL
	zero	T87,-ST2941	"POSITION
	zero	T106,-ST2946	",2
	zero	T110,-ST2941	"SPECIAL
	equ	LN2084,*-DPDA-ST2084-1
"
" STATE 2093
	equ	ST2093,*-DPDA
	zero	APLY1,LN2093
	zero	5,5   pd ld
	zero	225,1   rule/alt
	zero	98,ST535 prod/val
	equ	LN2093,*-DPDA-ST2093-1
"
" STATE 2097
	equ	ST2097,*-DPDA
	zero	APLY1,LN2097
	zero	5,5   pd ld
	zero	290,1   rule/alt
	zero	116,ST502 prod/val
	equ	LN2097,*-DPDA-ST2097-1
"
" STATE 2101
	equ	ST2101,*-DPDA
	zero	APLY1,LN2101
	zero	5,5   pd ld
	zero	283,1   rule/alt
	zero	116,ST502 prod/val
	equ	LN2101,*-DPDA-ST2101-1
"
" STATE 2105
	equ	ST2105,*-DPDA
	zero	STRDS,ST893

"
" STATE 2106
	equ	ST2106,*-DPDA
	zero	STRD,LN2106
	zero	T14,ST2193	"(
	equ	LN2106,*-DPDA-ST2106-1
"
" STATE 2108
	equ	ST2108,*-DPDA
	zero	APLY1,LN2108
	zero	2,2   pd ld
	zero	-18,1   rule/alt
	zero	10,ST1786 prod/val
	equ	LN2108,*-DPDA-ST2108-1
"
" STATE 2112
	equ	ST2112,*-DPDA
	zero	STRD,LN2112
	zero	T23,ST2194	".
	equ	LN2112,*-DPDA-ST2112-1
"
" STATE 2114
	equ	ST2114,*-DPDA
	zero	APLYS,LN2114
	zero	6,6   pd ld
	zero	198,1   rule/alt
	zero	84,ST225 prod/val
	equ	LN2114,*-DPDA-ST2114-1
"
" STATE 2118
	equ	ST2118,*-DPDA
	zero	APLY1,LN2118
	zero	3,3   pd ld
	zero	141,1   rule/alt
	zero	62,ST1614 prod/val
	equ	LN2118,*-DPDA-ST2118-1
"
" STATE 2122
	equ	ST2122,*-DPDA
	zero	NSRD,LN2122
	zero	T23,-ST2964	".
	zero	T24,-ST2950	"ALIGN
	zero	T32,-ST2950	"CENTER
	zero	T33,-ST2950	"CHARACTER
	zero	T34,-ST2950	"COLUMN
	zero	T35,-ST2950	"CONCATENATE
	zero	T48,-ST2950	"EDIT
	zero	T54,-ST2950	"FILL
	zero	T58,-ST2950	"FOLD
	zero	T68,-ST2950	"LEFT
	zero	T69,-ST2950	"LET
	zero	T86,-ST2950	"PICTURE
	zero	T94,-ST2950	"RIGHT
	zero	T106,-ST2964	",2
	zero	T107,-ST2964	",3
	zero	T108,-ST2964	",4
	zero	T109,-ST2950	"BSP
	equ	LN2122,*-DPDA-ST2122-1
"
" STATE 2140
	equ	ST2140,*-DPDA
	zero	APLY1,LN2140
	zero	1,1   pd ld
	zero	-166,1   rule/alt
	zero	71,ST2028 prod/val
	equ	LN2140,*-DPDA-ST2140-1
"
" STATE 2144
	equ	ST2144,*-DPDA
	zero	STRD,LN2144
	zero	T14,ST2274	"(
	equ	LN2144,*-DPDA-ST2144-1
"
" STATE 2146
	equ	ST2146,*-DPDA
	zero	STRD,LN2146
	zero	T15,ST2275	")
	zero	T80,ST1075	"OR
	equ	LN2146,*-DPDA-ST2146-1
"
" STATE 2149
	equ	ST2149,*-DPDA
	zero	STRDS,ST261

"
" STATE 2150
	equ	ST2150,*-DPDA
	zero	STRDS,ST261

"
" STATE 2151
	equ	ST2151,*-DPDA
	zero	STRDS,ST336

"
" STATE 2152
	equ	ST2152,*-DPDA
	zero	STRD,LN2152
	zero	T14,ST2290	"(
	equ	LN2152,*-DPDA-ST2152-1
"
" STATE 2154
	equ	ST2154,*-DPDA
	zero	NSRD,LN2154
	zero	T18,-ST2971	",
	zero	T23,-ST2971	".
	zero	T62,-ST2971	"IF
	zero	T87,-ST2969	"POSITION
	zero	T106,-ST2971	",2
	equ	LN2154,*-DPDA-ST2154-1
"
" STATE 2160
	equ	ST2160,*-DPDA
	zero	STRD,LN2160
	zero	T104,ST2293	"<number>
	equ	LN2160,*-DPDA-ST2160-1
"
" STATE 2162
	equ	ST2162,*-DPDA
	zero	STRD,LN2162
	zero	T104,ST2297	"<number>
	equ	LN2162,*-DPDA-ST2162-1
"
" STATE 2164
	equ	ST2164,*-DPDA
	zero	APLY1,LN2164
	zero	4,4   pd ld
	zero	72,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2164,*-DPDA-ST2164-1
"
" STATE 2168
	equ	ST2168,*-DPDA
	zero	APLY1,LN2168
	zero	4,4   pd ld
	zero	69,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2168,*-DPDA-ST2168-1
"
" STATE 2172
	equ	ST2172,*-DPDA
	zero	STRD,LN2172
	zero	T105,ST2301	"<quoted_str>
	equ	LN2172,*-DPDA-ST2172-1
"
" STATE 2174
	equ	ST2174,*-DPDA
	zero	NSRD,LN2174
	zero	T18,-ST2977	",
	zero	T23,-ST2977	".
	zero	T62,-ST2977	"IF
	zero	T87,-ST2975	"POSITION
	zero	T106,-ST2977	",2
	equ	LN2174,*-DPDA-ST2174-1
"
" STATE 2180
	equ	ST2180,*-DPDA
	zero	STRD,LN2180
	zero	T104,ST2310	"<number>
	equ	LN2180,*-DPDA-ST2180-1
"
" STATE 2182
	equ	ST2182,*-DPDA
	zero	NSRD,LN2182
	zero	T18,-ST2984	",
	zero	T23,-ST2984	".
	zero	T62,-ST2984	"IF
	zero	T79,-ST2981	"OPTIONAL
	zero	T87,-ST2981	"POSITION
	zero	T106,-ST2984	",2
	equ	LN2182,*-DPDA-ST2182-1
"
" STATE 2189
	equ	ST2189,*-DPDA
	zero	STRD,LN2189
	zero	T15,ST2322	")
	zero	T17,ST902	"+
	zero	T19,ST903	"-
	equ	LN2189,*-DPDA-ST2189-1
"
" STATE 2193
	equ	ST2193,*-DPDA
	zero	STRDS,ST261

"
" STATE 2194
	equ	ST2194,*-DPDA
	zero	APLYS,LN2194
	zero	7,7   pd ld
	zero	197,1   rule/alt
	zero	84,ST225 prod/val
	equ	LN2194,*-DPDA-ST2194-1
"
" STATE 2198
	equ	ST2198,*-DPDA
	zero	STRD,LN2198
	zero	T14,ST2329	"(
	equ	LN2198,*-DPDA-ST2198-1
"
" STATE 2200
	equ	ST2200,*-DPDA
	zero	APLY1,LN2200
	zero	0,0   pd ld
	zero	-170,1   rule/alt
	zero	74,ST2204 prod/val
	equ	LN2200,*-DPDA-ST2200-1
"
" STATE 2204
	equ	ST2204,*-DPDA
	zero	NSRD,LN2204
	zero	T23,-ST3001	".
	zero	T24,-ST2988	"ALIGN
	zero	T32,-ST2988	"CENTER
	zero	T33,-ST2988	"CHARACTER
	zero	T34,-ST2988	"COLUMN
	zero	T48,-ST2988	"EDIT
	zero	T54,-ST2988	"FILL
	zero	T58,-ST2988	"FOLD
	zero	T68,-ST2988	"LEFT
	zero	T69,-ST2988	"LET
	zero	T86,-ST2988	"PICTURE
	zero	T94,-ST2988	"RIGHT
	zero	T106,-ST3001	",2
	zero	T107,-ST3001	",3
	zero	T108,-ST3001	",4
	zero	T109,-ST2988	"BSP
	equ	LN2204,*-DPDA-ST2204-1
"
" STATE 2221
	equ	ST2221,*-DPDA
	zero	STRD,LN2221
	zero	T105,ST2335	"<quoted_str>
	equ	LN2221,*-DPDA-ST2221-1
"
" STATE 2223
	equ	ST2223,*-DPDA
	zero	APLY,LN2223
	zero	0,0   pd ld
	zero	180,1   rule/alt
	zero	75,ST2200 prod/val
	zero	ST2988,ST2331
	equ	LN2223,*-DPDA-ST2223-1
"
" STATE 2228
	equ	ST2228,*-DPDA
	zero	STRD,LN2228
	zero	T14,ST2339	"(
	equ	LN2228,*-DPDA-ST2228-1
"
" STATE 2230
	equ	ST2230,*-DPDA
	zero	STRD,LN2230
	zero	T104,ST2341	"<number>
	equ	LN2230,*-DPDA-ST2230-1
"
" STATE 2232
	equ	ST2232,*-DPDA
	zero	STRD,LN2232
	zero	T105,ST2345	"<quoted_str>
	equ	LN2232,*-DPDA-ST2232-1
"
" STATE 2234
	equ	ST2234,*-DPDA
	zero	NSRD,LN2234
	zero	T14,-ST3005	"(
	zero	T23,-ST3007	".
	zero	T24,-ST3007	"ALIGN
	zero	T32,-ST3007	"CENTER
	zero	T33,-ST3007	"CHARACTER
	zero	T34,-ST3007	"COLUMN
	zero	T48,-ST3007	"EDIT
	zero	T54,-ST3007	"FILL
	zero	T58,-ST3007	"FOLD
	zero	T68,-ST3007	"LEFT
	zero	T69,-ST3007	"LET
	zero	T86,-ST3007	"PICTURE
	zero	T94,-ST3007	"RIGHT
	zero	T106,-ST3007	",2
	zero	T107,-ST3007	",3
	zero	T108,-ST3007	",4
	zero	T109,-ST3007	"BSP
	equ	LN2234,*-DPDA-ST2234-1
"
" STATE 2252
	equ	ST2252,*-DPDA
	zero	APLYS,LN2252
	zero	0,0   pd ld
	zero	185,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2252,*-DPDA-ST2252-1
"
" STATE 2256
	equ	ST2256,*-DPDA
	zero	APLYS,LN2256
	zero	0,0   pd ld
	zero	179,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2256,*-DPDA-ST2256-1
"
" STATE 2260
	equ	ST2260,*-DPDA
	zero	APLY1,LN2260
	zero	0,0   pd ld
	zero	175,1   rule/alt
	zero	76,ST2198 prod/val
	equ	LN2260,*-DPDA-ST2260-1
"
" STATE 2264
	equ	ST2264,*-DPDA
	zero	STRD,LN2264
	zero	T105,ST2351	"<quoted_str>
	equ	LN2264,*-DPDA-ST2264-1
"
" STATE 2266
	equ	ST2266,*-DPDA
	zero	APLYS,LN2266
	zero	0,0   pd ld
	zero	181,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2266,*-DPDA-ST2266-1
"
" STATE 2270
	equ	ST2270,*-DPDA
	zero	APLYS,LN2270
	zero	0,0   pd ld
	zero	178,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2270,*-DPDA-ST2270-1
"
" STATE 2274
	equ	ST2274,*-DPDA
	zero	STRDS,ST261

"
" STATE 2275
	equ	ST2275,*-DPDA
	zero	APLY1,LN2275
	zero	3,3   pd ld
	zero	160,1   rule/alt
	zero	69,ST1864 prod/val
	equ	LN2275,*-DPDA-ST2275-1
"
" STATE 2279
	equ	ST2279,*-DPDA
	zero	STRD,LN2279
	zero	T15,ST2358	")
	zero	T80,ST1075	"OR
	equ	LN2279,*-DPDA-ST2279-1
"
" STATE 2282
	equ	ST2282,*-DPDA
	zero	STRD,LN2282
	zero	T15,ST2362	")
	zero	T80,ST1075	"OR
	equ	LN2282,*-DPDA-ST2282-1
"
" STATE 2285
	equ	ST2285,*-DPDA
	zero	APLY,LN2285
	zero	6,6   pd ld
	zero	114,1   rule/alt
	zero	44,ST836 prod/val
	zero	ST2151,ST2285
	equ	LN2285,*-DPDA-ST2285-1
"
" STATE 2290
	equ	ST2290,*-DPDA
	zero	STRDS,ST261

"
" STATE 2291
	equ	ST2291,*-DPDA
	zero	STRD,LN2291
	zero	T104,ST2369	"<number>
	equ	LN2291,*-DPDA-ST2291-1
"
" STATE 2293
	equ	ST2293,*-DPDA
	zero	APLY1,LN2293
	zero	5,5   pd ld
	zero	62,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2293,*-DPDA-ST2293-1
"
" STATE 2297
	equ	ST2297,*-DPDA
	zero	APLY1,LN2297
	zero	5,5   pd ld
	zero	73,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2297,*-DPDA-ST2297-1
"
" STATE 2301
	equ	ST2301,*-DPDA
	zero	NSRD,LN2301
	zero	T18,-ST3014	",
	zero	T23,-ST3014	".
	zero	T62,-ST3014	"IF
	zero	T79,-ST3011	"OPTIONAL
	zero	T87,-ST3011	"POSITION
	zero	T106,-ST3014	",2
	equ	LN2301,*-DPDA-ST2301-1
"
" STATE 2308
	equ	ST2308,*-DPDA
	zero	STRD,LN2308
	zero	T104,ST2381	"<number>
	equ	LN2308,*-DPDA-ST2308-1
"
" STATE 2310
	equ	ST2310,*-DPDA
	zero	APLY1,LN2310
	zero	5,5   pd ld
	zero	50,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2310,*-DPDA-ST2310-1
"
" STATE 2314
	equ	ST2314,*-DPDA
	zero	NSRD,LN2314
	zero	T18,-ST3020	",
	zero	T23,-ST3020	".
	zero	T62,-ST3020	"IF
	zero	T87,-ST3018	"POSITION
	zero	T106,-ST3020	",2
	equ	LN2314,*-DPDA-ST2314-1
"
" STATE 2320
	equ	ST2320,*-DPDA
	zero	STRD,LN2320
	zero	T104,ST2387	"<number>
	equ	LN2320,*-DPDA-ST2320-1
"
" STATE 2322
	equ	ST2322,*-DPDA
	zero	APLY1,LN2322
	zero	7,7   pd ld
	zero	282,1   rule/alt
	zero	116,ST502 prod/val
	equ	LN2322,*-DPDA-ST2322-1
"
" STATE 2326
	equ	ST2326,*-DPDA
	zero	STRD,LN2326
	zero	T15,ST2391	")
	zero	T80,ST1075	"OR
	equ	LN2326,*-DPDA-ST2326-1
"
" STATE 2329
	equ	ST2329,*-DPDA
	zero	STRD,LN2329
	zero	T103,ST288	"<identifier>
	equ	LN2329,*-DPDA-ST2329-1
"
" STATE 2331
	equ	ST2331,*-DPDA
	zero	APLY1,LN2331
	zero	1,1   pd ld
	zero	-171,1   rule/alt
	zero	74,ST2204 prod/val
	equ	LN2331,*-DPDA-ST2331-1
"
" STATE 2335
	equ	ST2335,*-DPDA
	zero	APLYS,LN2335
	zero	1,1   pd ld
	zero	184,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2335,*-DPDA-ST2335-1
"
" STATE 2339
	equ	ST2339,*-DPDA
	zero	STRD,LN2339
	zero	T104,ST2404	"<number>
	equ	LN2339,*-DPDA-ST2339-1
"
" STATE 2341
	equ	ST2341,*-DPDA
	zero	APLYS,LN2341
	zero	1,1   pd ld
	zero	177,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2341,*-DPDA-ST2341-1
"
" STATE 2345
	equ	ST2345,*-DPDA
	zero	APLYS,LN2345
	zero	1,1   pd ld
	zero	173,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2345,*-DPDA-ST2345-1
"
" STATE 2349
	equ	ST2349,*-DPDA
	zero	STRD,LN2349
	zero	T104,ST2406	"<number>
	equ	LN2349,*-DPDA-ST2349-1
"
" STATE 2351
	equ	ST2351,*-DPDA
	zero	APLYS,LN2351
	zero	1,1   pd ld
	zero	172,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2351,*-DPDA-ST2351-1
"
" STATE 2355
	equ	ST2355,*-DPDA
	zero	STRD,LN2355
	zero	T15,ST2408	")
	zero	T80,ST1075	"OR
	equ	LN2355,*-DPDA-ST2355-1
"
" STATE 2358
	equ	ST2358,*-DPDA
	zero	APLY1,LN2358
	zero	4,4   pd ld
	zero	161,1   rule/alt
	zero	69,ST1864 prod/val
	equ	LN2358,*-DPDA-ST2358-1
"
" STATE 2362
	equ	ST2362,*-DPDA
	zero	APLY1,LN2362
	zero	4,4   pd ld
	zero	156,1   rule/alt
	zero	69,ST1864 prod/val
	equ	LN2362,*-DPDA-ST2362-1
"
" STATE 2366
	equ	ST2366,*-DPDA
	zero	STRD,LN2366
	zero	T15,ST2412	")
	zero	T80,ST1075	"OR
	equ	LN2366,*-DPDA-ST2366-1
"
" STATE 2369
	equ	ST2369,*-DPDA
	zero	APLY1,LN2369
	zero	6,6   pd ld
	zero	67,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2369,*-DPDA-ST2369-1
"
" STATE 2373
	equ	ST2373,*-DPDA
	zero	NSRD,LN2373
	zero	T18,-ST3026	",
	zero	T23,-ST3026	".
	zero	T62,-ST3026	"IF
	zero	T87,-ST3024	"POSITION
	zero	T106,-ST3026	",2
	equ	LN2373,*-DPDA-ST2373-1
"
" STATE 2379
	equ	ST2379,*-DPDA
	zero	STRD,LN2379
	zero	T104,ST2420	"<number>
	equ	LN2379,*-DPDA-ST2379-1
"
" STATE 2381
	equ	ST2381,*-DPDA
	zero	APLY1,LN2381
	zero	6,6   pd ld
	zero	57,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2381,*-DPDA-ST2381-1
"
" STATE 2385
	equ	ST2385,*-DPDA
	zero	STRD,LN2385
	zero	T104,ST2424	"<number>
	equ	LN2385,*-DPDA-ST2385-1
"
" STATE 2387
	equ	ST2387,*-DPDA
	zero	APLY1,LN2387
	zero	6,6   pd ld
	zero	60,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2387,*-DPDA-ST2387-1
"
" STATE 2391
	equ	ST2391,*-DPDA
	zero	APLY,LN2391
	zero	7,7   pd ld
	zero	45,1   rule/alt
	zero	24,ST926 prod/val
	zero	ST638,ST937
	zero	ST886,ST1226
	zero	ST932,ST1402
	zero	ST2660,ST937
	zero	ST2848,ST1402
	zero	ST2897,ST1402
	equ	LN2391,*-DPDA-ST2391-1
"
" STATE 2401
	equ	ST2401,*-DPDA
	zero	STRD,LN2401
	zero	T15,ST2428	")
	zero	T103,ST288	"<identifier>
	equ	LN2401,*-DPDA-ST2401-1
"
" STATE 2404
	equ	ST2404,*-DPDA
	zero	STRD,LN2404
	zero	T15,ST2432	")
	equ	LN2404,*-DPDA-ST2404-1
"
" STATE 2406
	equ	ST2406,*-DPDA
	zero	STRD,LN2406
	zero	T18,ST2436	",
	equ	LN2406,*-DPDA-ST2406-1
"
" STATE 2408
	equ	ST2408,*-DPDA
	zero	APLY1,LN2408
	zero	5,5   pd ld
	zero	157,1   rule/alt
	zero	69,ST1864 prod/val
	equ	LN2408,*-DPDA-ST2408-1
"
" STATE 2412
	equ	ST2412,*-DPDA
	zero	APLY,LN2412
	zero	7,7   pd ld
	zero	44,1   rule/alt
	zero	23,ST1231 prod/val
	zero	ST2744,ST1711
	zero	ST2842,ST1944
	equ	LN2412,*-DPDA-ST2412-1
"
" STATE 2418
	equ	ST2418,*-DPDA
	zero	STRD,LN2418
	zero	T104,ST2438	"<number>
	equ	LN2418,*-DPDA-ST2418-1
"
" STATE 2420
	equ	ST2420,*-DPDA
	zero	APLY1,LN2420
	zero	7,7   pd ld
	zero	58,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2420,*-DPDA-ST2420-1
"
" STATE 2424
	equ	ST2424,*-DPDA
	zero	APLY1,LN2424
	zero	7,7   pd ld
	zero	61,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2424,*-DPDA-ST2424-1
"
" STATE 2428
	equ	ST2428,*-DPDA
	zero	APLYS,LN2428
	zero	3,3   pd ld
	zero	176,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2428,*-DPDA-ST2428-1
"
" STATE 2432
	equ	ST2432,*-DPDA
	zero	APLYS,LN2432
	zero	3,3   pd ld
	zero	174,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2432,*-DPDA-ST2432-1
"
" STATE 2436
	equ	ST2436,*-DPDA
	zero	STRD,LN2436
	zero	T104,ST2442	"<number>
	equ	LN2436,*-DPDA-ST2436-1
"
" STATE 2438
	equ	ST2438,*-DPDA
	zero	APLY1,LN2438
	zero	8,8   pd ld
	zero	59,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2438,*-DPDA-ST2438-1
"
" STATE 2442
	equ	ST2442,*-DPDA
	zero	STRD,LN2442
	zero	T15,ST2444	")
	equ	LN2442,*-DPDA-ST2442-1
"
" STATE 2444
	equ	ST2444,*-DPDA
	zero	APLYS,LN2444
	zero	5,5   pd ld
	zero	183,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN2444,*-DPDA-ST2444-1
"
" STATE 2448
	equ	ST2448,*-DPDA
	zero	STRD,LN2448
	zero	T95,ST99	"SORT
	equ	LN2448,*-DPDA-ST2448-1
"
" STATE 2450
	equ	ST2450,*-DPDA
	zero	APLY1,LN2450
	zero	-1,-1   pd ld
	zero	207,1   rule/alt
	zero	87,ST87 prod/val
	equ	LN2450,*-DPDA-ST2450-1
"
" STATE 2454
	equ	ST2454,*-DPDA
	zero	STRD,LN2454
	zero	T31,ST120	"BREAK
	zero	T72,ST122	"MAXLINE
	zero	T73,ST124	"MINLINE
	zero	T78,ST126	"ON
	zero	T83,ST130	"PAGELENGTH
	zero	T84,ST132	"PAGEWIDTH
	equ	LN2454,*-DPDA-ST2454-1
"
" STATE 2461
	equ	ST2461,*-DPDA
	zero	APLY1,LN2461
	zero	-1,-1   pd ld
	zero	-103,1   rule/alt
	zero	41,ST118 prod/val
	equ	LN2461,*-DPDA-ST2461-1
"
" STATE 2465
	equ	ST2465,*-DPDA
	zero	STRD,LN2465
	zero	T27,ST152	"ATTACH
	zero	T53,ST170	"FILE
	zero	T89,ST171	"RECORD
	zero	T96,ST178	"STREAM
	equ	LN2465,*-DPDA-ST2465-1
"
" STATE 2470
	equ	ST2470,*-DPDA
	zero	APLY1,LN2470
	zero	-1,-1   pd ld
	zero	-29,1   rule/alt
	zero	17,ST150 prod/val
	equ	LN2470,*-DPDA-ST2470-1
"
" STATE 2474
	equ	ST2474,*-DPDA
	zero	STRDS,ST1069

"
" STATE 2475
	equ	ST2475,*-DPDA
	zero	APLY1,LN2475
	zero	-1,-1   pd ld
	zero	189,1   rule/alt
	zero	80,ST250 prod/val
	equ	LN2475,*-DPDA-ST2475-1
"
" STATE 2479
	equ	ST2479,*-DPDA
	zero	STRD,LN2479
	zero	T103,ST288	"<identifier>
	equ	LN2479,*-DPDA-ST2479-1
"
" STATE 2481
	equ	ST2481,*-DPDA
	zero	APLY1,LN2481
	zero	-1,-1   pd ld
	zero	-216,1   rule/alt
	zero	91,ST302 prod/val
	equ	LN2481,*-DPDA-ST2481-1
"
" STATE 2485
	equ	ST2485,*-DPDA
	zero	STRDS,ST2454

"
" STATE 2486
	equ	ST2486,*-DPDA
	zero	APLY1,LN2486
	zero	0,0   pd ld
	zero	-102,1   rule/alt
	zero	41,ST118 prod/val
	equ	LN2486,*-DPDA-ST2486-1
"
" STATE 2490
	equ	ST2490,*-DPDA
	zero	STRD,LN2490
	zero	T106,ST316	",2
	equ	LN2490,*-DPDA-ST2490-1
"
" STATE 2492
	equ	ST2492,*-DPDA
	zero	APLY1,LN2492
	zero	-1,-1   pd ld
	zero	-119,1   rule/alt
	zero	46,ST314 prod/val
	equ	LN2492,*-DPDA-ST2492-1
"
" STATE 2496
	equ	ST2496,*-DPDA
	zero	LOOK,LN2496
	zero	T44,-ST2492	"DETAIL
	zero	T46,-ST2490	"DETAILHEAD
	zero	T82,-ST2490	"PAGEHEAD
	zero	T92,-ST2490	"REPORTHEAD
	equ	LN2496,*-DPDA-ST2496-1
"
" STATE 2501
	equ	ST2501,*-DPDA
	zero	STRDS,ST2465

"
" STATE 2502
	equ	ST2502,*-DPDA
	zero	APLY1,LN2502
	zero	0,0   pd ld
	zero	-28,1   rule/alt
	zero	17,ST150 prod/val
	equ	LN2502,*-DPDA-ST2502-1
"
" STATE 2506
	equ	ST2506,*-DPDA
	zero	STRD,LN2506
	zero	T104,ST619	"<number>
	equ	LN2506,*-DPDA-ST2506-1
"
" STATE 2508
	equ	ST2508,*-DPDA
	zero	APLYS,LN2508
	zero	0,0   pd ld
	zero	36,1   rule/alt
	zero	20,ST619 prod/val
	equ	LN2508,*-DPDA-ST2508-1
"
" STATE 2512
	equ	ST2512,*-DPDA
	zero	STRD,LN2512
	zero	T104,ST624	"<number>
	equ	LN2512,*-DPDA-ST2512-1
"
" STATE 2514
	equ	ST2514,*-DPDA
	zero	APLYS,LN2514
	zero	0,0   pd ld
	zero	37,1   rule/alt
	zero	20,ST619 prod/val
	equ	LN2514,*-DPDA-ST2514-1
"
" STATE 2518
	equ	ST2518,*-DPDA
	zero	STRD,LN2518
	zero	T26,ST660	"ASCENDING
	zero	T43,ST665	"DESCENDING
	equ	LN2518,*-DPDA-ST2518-1
"
" STATE 2521
	equ	ST2521,*-DPDA
	zero	APLYS,LN2521
	zero	0,0   pd ld
	zero	213,1   rule/alt
	zero	90,ST660 prod/val
	equ	LN2521,*-DPDA-ST2521-1
"
" STATE 2525
	equ	ST2525,*-DPDA
	zero	STRDS,ST1069

"
" STATE 2526
	equ	ST2526,*-DPDA
	zero	APLY1,LN2526
	zero	0,0   pd ld
	zero	-190,1   rule/alt
	zero	80,ST250 prod/val
	equ	LN2526,*-DPDA-ST2526-1
"
" STATE 2530
	equ	ST2530,*-DPDA
	zero	STRD,LN2530
	zero	T61,ST681	"HOLD
	equ	LN2530,*-DPDA-ST2530-1
"
" STATE 2532
	equ	ST2532,*-DPDA
	zero	APLY1,LN2532
	zero	-1,-1   pd ld
	zero	204,1   rule/alt
	zero	86,ST673 prod/val
	equ	LN2532,*-DPDA-ST2532-1
"
" STATE 2536
	equ	ST2536,*-DPDA
	zero	STRD,LN2536
	zero	T103,ST288	"<identifier>
	equ	LN2536,*-DPDA-ST2536-1
"
" STATE 2538
	equ	ST2538,*-DPDA
	zero	APLY1,LN2538
	zero	0,0   pd ld
	zero	-217,1   rule/alt
	zero	91,ST302 prod/val
	equ	LN2538,*-DPDA-ST2538-1
"
" STATE 2542
	equ	ST2542,*-DPDA
	zero	STRD,LN2542
	zero	T106,ST316	",2
	equ	LN2542,*-DPDA-ST2542-1
"
" STATE 2544
	equ	ST2544,*-DPDA
	zero	APLY1,LN2544
	zero	0,0   pd ld
	zero	-118,1   rule/alt
	zero	46,ST314 prod/val
	equ	LN2544,*-DPDA-ST2544-1
"
" STATE 2548
	equ	ST2548,*-DPDA
	zero	LOOK,LN2548
	zero	T44,-ST2544	"DETAIL
	zero	T46,-ST2542	"DETAILHEAD
	zero	T82,-ST2542	"PAGEHEAD
	zero	T92,-ST2542	"REPORTHEAD
	equ	LN2548,*-DPDA-ST2548-1
"
" STATE 2553
	equ	ST2553,*-DPDA
	zero	STRD,LN2553
	zero	T18,ST886	",
	zero	T106,ST377	",2
	equ	LN2553,*-DPDA-ST2553-1
"
" STATE 2556
	equ	ST2556,*-DPDA
	zero	APLY1,LN2556
	zero	-1,-1   pd ld
	zero	-23,2   rule/alt
	zero	14,ST884 prod/val
	equ	LN2556,*-DPDA-ST2556-1
"
" STATE 2560
	equ	ST2560,*-DPDA
	zero	STRD,LN2560
	zero	T16,ST893	"*
	zero	T21,ST901	"/
	equ	LN2560,*-DPDA-ST2560-1
"
" STATE 2563
	equ	ST2563,*-DPDA
	zero	APLY,LN2563
	zero	0,0   pd ld
	zero	-293,1   rule/alt
	zero	117,ST451 prod/val
	zero	ST907,ST1374
	zero	ST919,ST1391
	zero	ST924,ST1395
	zero	ST1740,ST1974
	zero	ST1745,ST1978
	zero	ST2105,ST2189
	equ	LN2563,*-DPDA-ST2563-1
"
" STATE 2573
	equ	ST2573,*-DPDA
	zero	STRD,LN2573
	zero	T17,ST902	"+
	zero	T19,ST903	"-
	equ	LN2573,*-DPDA-ST2573-1
"
" STATE 2576
	equ	ST2576,*-DPDA
	zero	APLYS,LN2576
	zero	0,0   pd ld
	zero	-279,1   rule/alt
	zero	115,ST502 prod/val
	equ	LN2576,*-DPDA-ST2576-1
"
" STATE 2580
	equ	ST2580,*-DPDA
	zero	STRD,LN2580
	zero	T35,ST904	"CONCATENATE
	equ	LN2580,*-DPDA-ST2580-1
"
" STATE 2582
	equ	ST2582,*-DPDA
	zero	APLYS,LN2582
	zero	1,1   pd ld
	zero	39,1   rule/alt
	zero	20,ST619 prod/val
	equ	LN2582,*-DPDA-ST2582-1
"
" STATE 2586
	equ	ST2586,*-DPDA
	zero	STRD,LN2586
	zero	T35,ST904	"CONCATENATE
	equ	LN2586,*-DPDA-ST2586-1
"
" STATE 2588
	equ	ST2588,*-DPDA
	zero	APLYS,LN2588
	zero	1,1   pd ld
	zero	38,1   rule/alt
	zero	20,ST619 prod/val
	equ	LN2588,*-DPDA-ST2588-1
"
" STATE 2592
	equ	ST2592,*-DPDA
	zero	STRD,LN2592
	zero	T29,ST980	"BEGINS
	zero	T35,ST904	"CONCATENATE
	zero	T37,ST999	"CONTAINS
	zero	T50,ST1018	"ENDS
	zero	T51,ST1037	"EQ
	zero	T59,ST1041	"GE
	zero	T60,ST1045	"GT
	zero	T63,ST1049	"IN
	zero	T67,ST1051	"LE
	zero	T71,ST1055	"LT
	zero	T74,ST1059	"NE
	zero	T76,ST1063	"NOT
	equ	LN2592,*-DPDA-ST2592-1
"
" STATE 2605
	equ	ST2605,*-DPDA
	zero	APLYS,LN2605
	zero	0,0   pd ld
	zero	-266,1   rule/alt
	zero	111,ST704 prod/val
	equ	LN2605,*-DPDA-ST2605-1
"
" STATE 2609
	equ	ST2609,*-DPDA
	zero	STRD,LN2609
	zero	T25,ST1068	"AND
	equ	LN2609,*-DPDA-ST2609-1
"
" STATE 2611
	equ	ST2611,*-DPDA
	zero	APLY,LN2611
	zero	0,0   pd ld
	zero	-230,1   rule/alt
	zero	100,ST734 prod/val
	zero	ST581,ST912
	zero	ST781,ST1103
	zero	ST905,ST1368
	zero	ST925,ST1399
	zero	ST1410,ST1775
	zero	ST1658,ST1889
	zero	ST1708,ST1936
	zero	ST1859,ST2020
	zero	ST2053,ST2146
	zero	ST2149,ST2279
	zero	ST2150,ST2282
	zero	ST2193,ST2326
	zero	ST2274,ST2355
	zero	ST2290,ST2366
	equ	LN2611,*-DPDA-ST2611-1
"
" STATE 2629
	equ	ST2629,*-DPDA
	zero	STRD,LN2629
	zero	T106,ST1119	",2
	equ	LN2629,*-DPDA-ST2629-1
"
" STATE 2631
	equ	ST2631,*-DPDA
	zero	APLY1,LN2631
	zero	-1,-1   pd ld
	zero	-145,1   rule/alt
	zero	63,ST1109 prod/val
	equ	LN2631,*-DPDA-ST2631-1
"
" STATE 2635
	equ	ST2635,*-DPDA
	zero	STRD,LN2635
	zero	T62,ST1158	"IF
	equ	LN2635,*-DPDA-ST2635-1
"
" STATE 2637
	equ	ST2637,*-DPDA
	zero	APLYS,LN2637
	zero	0,0   pd ld
	zero	113,1   rule/alt
	zero	44,ST2285 prod/val
	equ	LN2637,*-DPDA-ST2637-1
"
" STATE 2641
	equ	ST2641,*-DPDA
	zero	STRD,LN2641
	zero	T35,ST904	"CONCATENATE
	zero	T77,ST1164	"NUMBER
	equ	LN2641,*-DPDA-ST2641-1
"
" STATE 2644
	equ	ST2644,*-DPDA
	zero	APLYS,LN2644
	zero	1,1   pd ld
	zero	115,1   rule/alt
	zero	45,ST1659 prod/val
	equ	LN2644,*-DPDA-ST2644-1
"
" STATE 2648
	equ	ST2648,*-DPDA
	zero	STRD,LN2648
	zero	T35,ST904	"CONCATENATE
	equ	LN2648,*-DPDA-ST2648-1
"
" STATE 2650
	equ	ST2650,*-DPDA
	zero	APLYS,LN2650
	zero	1,1   pd ld
	zero	117,1   rule/alt
	zero	45,ST1659 prod/val
	equ	LN2650,*-DPDA-ST2650-1
"
" STATE 2654
	equ	ST2654,*-DPDA
	zero	STRD,LN2654
	zero	T18,ST886	",
	equ	LN2654,*-DPDA-ST2654-1
"
" STATE 2656
	equ	ST2656,*-DPDA
	zero	APLY1,LN2656
	zero	0,0   pd ld
	zero	-23,1   rule/alt
	zero	14,ST884 prod/val
	equ	LN2656,*-DPDA-ST2656-1
"
" STATE 2660
	equ	ST2660,*-DPDA
	zero	STRDS,ST638

"
" STATE 2661
	equ	ST2661,*-DPDA
	zero	APLY,LN2661
	zero	2,2   pd ld
	zero	9,1   rule/alt
	zero	7,ST185 prod/val
	zero	ST189,ST628
	equ	LN2661,*-DPDA-ST2661-1
"
" STATE 2666
	equ	ST2666,*-DPDA
	zero	STRD,LN2666
	zero	T102,ST1462	"WORD
	equ	LN2666,*-DPDA-ST2666-1
"
" STATE 2668
	equ	ST2668,*-DPDA
	zero	APLY1,LN2668
	zero	0,0   pd ld
	zero	246,1   rule/alt
	zero	105,ST978 prod/val
	equ	LN2668,*-DPDA-ST2668-1
"
" STATE 2672
	equ	ST2672,*-DPDA
	zero	STRD,LN2672
	zero	T102,ST1466	"WORD
	equ	LN2672,*-DPDA-ST2672-1
"
" STATE 2674
	equ	ST2674,*-DPDA
	zero	APLY1,LN2674
	zero	0,0   pd ld
	zero	250,1   rule/alt
	zero	105,ST978 prod/val
	equ	LN2674,*-DPDA-ST2674-1
"
" STATE 2678
	equ	ST2678,*-DPDA
	zero	STRD,LN2678
	zero	T102,ST1470	"WORD
	equ	LN2678,*-DPDA-ST2678-1
"
" STATE 2680
	equ	ST2680,*-DPDA
	zero	APLY1,LN2680
	zero	0,0   pd ld
	zero	248,1   rule/alt
	zero	105,ST978 prod/val
	equ	LN2680,*-DPDA-ST2680-1
"
" STATE 2684
	equ	ST2684,*-DPDA
	zero	STRD,LN2684
	zero	T35,ST904	"CONCATENATE
	equ	LN2684,*-DPDA-ST2684-1
"
" STATE 2686
	equ	ST2686,*-DPDA
	zero	APLYS,LN2686
	zero	0,0   pd ld
	zero	-266,1   rule/alt
	zero	111,ST704 prod/val
	equ	LN2686,*-DPDA-ST2686-1
"
" STATE 2690
	equ	ST2690,*-DPDA
	zero	STRD,LN2690
	zero	T106,ST1577	",2
	equ	LN2690,*-DPDA-ST2690-1
"
" STATE 2692
	equ	ST2692,*-DPDA
	zero	APLY1,LN2692
	zero	0,0   pd ld
	zero	-144,1   rule/alt
	zero	63,ST1109 prod/val
	equ	LN2692,*-DPDA-ST2692-1
"
" STATE 2696
	equ	ST2696,*-DPDA
	zero	STRD,LN2696
	zero	T107,ST1147	",3
	equ	LN2696,*-DPDA-ST2696-1
"
" STATE 2698
	equ	ST2698,*-DPDA
	zero	APLYS,LN2698
	zero	2,2   pd ld
	zero	-123,1   rule/alt
	zero	48,ST1624 prod/val
	equ	LN2698,*-DPDA-ST2698-1
"
" STATE 2702
	equ	ST2702,*-DPDA
	zero	STRD,LN2702
	zero	T107,ST1147	",3
	equ	LN2702,*-DPDA-ST2702-1
"
" STATE 2704
	equ	ST2704,*-DPDA
	zero	APLYS,LN2704
	zero	2,2   pd ld
	zero	-122,1   rule/alt
	zero	48,ST1624 prod/val
	equ	LN2704,*-DPDA-ST2704-1
"
" STATE 2708
	equ	ST2708,*-DPDA
	zero	STRD,LN2708
	zero	T105,ST1671	"<quoted_str>
	equ	LN2708,*-DPDA-ST2708-1
"
" STATE 2710
	equ	ST2710,*-DPDA
	zero	APLY1,LN2710
	zero	0,0   pd ld
	zero	-96,1   rule/alt
	zero	30,ST1196 prod/val
	equ	LN2710,*-DPDA-ST2710-1
"
" STATE 2714
	equ	ST2714,*-DPDA
	zero	STRD,LN2714
	zero	T105,ST1677	"<quoted_str>
	equ	LN2714,*-DPDA-ST2714-1
"
" STATE 2716
	equ	ST2716,*-DPDA
	zero	APLY1,LN2716
	zero	0,0   pd ld
	zero	-92,1   rule/alt
	zero	30,ST1196 prod/val
	equ	LN2716,*-DPDA-ST2716-1
"
" STATE 2720
	equ	ST2720,*-DPDA
	zero	STRD,LN2720
	zero	T104,ST1683	"<number>
	equ	LN2720,*-DPDA-ST2720-1
"
" STATE 2722
	equ	ST2722,*-DPDA
	zero	APLY1,LN2722
	zero	0,0   pd ld
	zero	-88,1   rule/alt
	zero	30,ST1196 prod/val
	equ	LN2722,*-DPDA-ST2722-1
"
" STATE 2726
	equ	ST2726,*-DPDA
	zero	STRD,LN2726
	zero	T104,ST1689	"<number>
	equ	LN2726,*-DPDA-ST2726-1
"
" STATE 2728
	equ	ST2728,*-DPDA
	zero	APLY1,LN2728
	zero	0,0   pd ld
	zero	-84,1   rule/alt
	zero	30,ST1196 prod/val
	equ	LN2728,*-DPDA-ST2728-1
"
" STATE 2732
	equ	ST2732,*-DPDA
	zero	STRD,LN2732
	zero	T18,ST1700	",
	equ	LN2732,*-DPDA-ST2732-1
"
" STATE 2734
	equ	ST2734,*-DPDA
	zero	APLY1,LN2734
	zero	0,0   pd ld
	zero	-261,1   rule/alt
	zero	108,ST1208 prod/val
	equ	LN2734,*-DPDA-ST2734-1
"
" STATE 2738
	equ	ST2738,*-DPDA
	zero	STRD,LN2738
	zero	T18,ST1702	",
	equ	LN2738,*-DPDA-ST2738-1
"
" STATE 2740
	equ	ST2740,*-DPDA
	zero	APLY1,LN2740
	zero	0,0   pd ld
	zero	-260,1   rule/alt
	zero	108,ST1208 prod/val
	equ	LN2740,*-DPDA-ST2740-1
"
" STATE 2744
	equ	ST2744,*-DPDA
	zero	STRD,LN2744
	zero	T62,ST1235	"IF
	equ	LN2744,*-DPDA-ST2744-1
"
" STATE 2746
	equ	ST2746,*-DPDA
	zero	APLYS,LN2746
	zero	2,2   pd ld
	zero	49,1   rule/alt
	zero	25,ST1939 prod/val
	equ	LN2746,*-DPDA-ST2746-1
"
" STATE 2750
	equ	ST2750,*-DPDA
	zero	STRDS,ST2560

"
" STATE 2751
	equ	ST2751,*-DPDA
	zero	APLYS,LN2751
	zero	2,2   pd ld
	zero	291,1   rule/alt
	zero	117,ST2563 prod/val
	equ	LN2751,*-DPDA-ST2751-1
"
" STATE 2755
	equ	ST2755,*-DPDA
	zero	STRDS,ST2560

"
" STATE 2756
	equ	ST2756,*-DPDA
	zero	APLYS,LN2756
	zero	2,2   pd ld
	zero	292,1   rule/alt
	zero	117,ST2563 prod/val
	equ	LN2756,*-DPDA-ST2756-1
"
" STATE 2760
	equ	ST2760,*-DPDA
	zero	STRD,LN2760
	zero	T35,ST904	"CONCATENATE
	equ	LN2760,*-DPDA-ST2760-1
"
" STATE 2762
	equ	ST2762,*-DPDA
	zero	APLYS,LN2762
	zero	1,1   pd ld
	zero	15,1   rule/alt
	zero	9,ST937 prod/val
	equ	LN2762,*-DPDA-ST2762-1
"
" STATE 2766
	equ	ST2766,*-DPDA
	zero	STRD,LN2766
	zero	T35,ST904	"CONCATENATE
	equ	LN2766,*-DPDA-ST2766-1
"
" STATE 2768
	equ	ST2768,*-DPDA
	zero	APLY1,LN2768
	zero	2,2   pd ld
	zero	245,1   rule/alt
	zero	104,ST718 prod/val
	equ	LN2768,*-DPDA-ST2768-1
"
" STATE 2772
	equ	ST2772,*-DPDA
	zero	STRD,LN2772
	zero	T35,ST904	"CONCATENATE
	equ	LN2772,*-DPDA-ST2772-1
"
" STATE 2774
	equ	ST2774,*-DPDA
	zero	APLY1,LN2774
	zero	2,2   pd ld
	zero	244,1   rule/alt
	zero	104,ST718 prod/val
	equ	LN2774,*-DPDA-ST2774-1
"
" STATE 2778
	equ	ST2778,*-DPDA
	zero	STRD,LN2778
	zero	T35,ST904	"CONCATENATE
	equ	LN2778,*-DPDA-ST2778-1
"
" STATE 2780
	equ	ST2780,*-DPDA
	zero	APLY1,LN2780
	zero	2,2   pd ld
	zero	243,1   rule/alt
	zero	104,ST718 prod/val
	equ	LN2780,*-DPDA-ST2780-1
"
" STATE 2784
	equ	ST2784,*-DPDA
	zero	STRD,LN2784
	zero	T102,ST1794	"WORD
	equ	LN2784,*-DPDA-ST2784-1
"
" STATE 2786
	equ	ST2786,*-DPDA
	zero	APLY1,LN2786
	zero	1,1   pd ld
	zero	247,1   rule/alt
	zero	105,ST978 prod/val
	equ	LN2786,*-DPDA-ST2786-1
"
" STATE 2790
	equ	ST2790,*-DPDA
	zero	STRD,LN2790
	zero	T102,ST1798	"WORD
	equ	LN2790,*-DPDA-ST2790-1
"
" STATE 2792
	equ	ST2792,*-DPDA
	zero	APLY1,LN2792
	zero	1,1   pd ld
	zero	251,1   rule/alt
	zero	105,ST978 prod/val
	equ	LN2792,*-DPDA-ST2792-1
"
" STATE 2796
	equ	ST2796,*-DPDA
	zero	STRD,LN2796
	zero	T102,ST1802	"WORD
	equ	LN2796,*-DPDA-ST2796-1
"
" STATE 2798
	equ	ST2798,*-DPDA
	zero	APLY1,LN2798
	zero	1,1   pd ld
	zero	249,1   rule/alt
	zero	105,ST978 prod/val
	equ	LN2798,*-DPDA-ST2798-1
"
" STATE 2802
	equ	ST2802,*-DPDA
	zero	STRD,LN2802
	zero	T25,ST1068	"AND
	equ	LN2802,*-DPDA-ST2802-1
"
" STATE 2804
	equ	ST2804,*-DPDA
	zero	APLYS,LN2804
	zero	2,2   pd ld
	zero	229,1   rule/alt
	zero	100,ST2611 prod/val
	equ	LN2804,*-DPDA-ST2804-1
"
" STATE 2808
	equ	ST2808,*-DPDA
	zero	STRDS,ST1130

"
" STATE 2809
	equ	ST2809,*-DPDA
	zero	APLYS,LN2809
	zero	2,2   pd ld
	zero	136,1   rule/alt
	zero	58,ST1846 prod/val
	equ	LN2809,*-DPDA-ST2809-1
"
" STATE 2813
	equ	ST2813,*-DPDA
	zero	STRD,LN2813
	zero	T107,ST1147	",3
	equ	LN2813,*-DPDA-ST2813-1
"
" STATE 2815
	equ	ST2815,*-DPDA
	zero	APLY,LN2815
	zero	0,0   pd ld
	zero	-137,1   rule/alt
	zero	59,ST1624 prod/val
	zero	ST1845,ST2015
	zero	ST2808,ST1846
	equ	LN2815,*-DPDA-ST2815-1
"
" STATE 2821
	equ	ST2821,*-DPDA
	zero	STRD,LN2821
	zero	T17,ST1873	"+
	zero	T62,ST1875	"IF
	zero	T65,ST1877	"PAUSE
	zero	T104,ST1883	"<number>
	equ	LN2821,*-DPDA-ST2821-1
"
" STATE 2826
	equ	ST2826,*-DPDA
	zero	APLY1,LN2826
	zero	-1,-1   pd ld
	zero	-155,1   rule/alt
	zero	68,ST1868 prod/val
	equ	LN2826,*-DPDA-ST2826-1
"
" STATE 2830
	equ	ST2830,*-DPDA
	zero	STRD,LN2830
	zero	T101,ST1892	"VARYING
	equ	LN2830,*-DPDA-ST2830-1
"
" STATE 2832
	equ	ST2832,*-DPDA
	zero	APLY1,LN2832
	zero	3,3   pd ld
	zero	78,1   rule/alt
	zero	29,ST349 prod/val
	equ	LN2832,*-DPDA-ST2832-1
"
" STATE 2836
	equ	ST2836,*-DPDA
	zero	STRD,LN2836
	zero	T101,ST1904	"VARYING
	equ	LN2836,*-DPDA-ST2836-1
"
" STATE 2838
	equ	ST2838,*-DPDA
	zero	APLY1,LN2838
	zero	3,3   pd ld
	zero	82,1   rule/alt
	zero	29,ST349 prod/val
	equ	LN2838,*-DPDA-ST2838-1
"
" STATE 2842
	equ	ST2842,*-DPDA
	zero	STRD,LN2842
	zero	T62,ST1235	"IF
	equ	LN2842,*-DPDA-ST2842-1
"
" STATE 2844
	equ	ST2844,*-DPDA
	zero	APLYS,LN2844
	zero	3,3   pd ld
	zero	46,1   rule/alt
	zero	25,ST1939 prod/val
	equ	LN2844,*-DPDA-ST2844-1
"
" STATE 2848
	equ	ST2848,*-DPDA
	zero	STRD,LN2848
	zero	T62,ST935	"IF
	equ	LN2848,*-DPDA-ST2848-1
"
" STATE 2850
	equ	ST2850,*-DPDA
	zero	APLYS,LN2850
	zero	3,3   pd ld
	zero	47,1   rule/alt
	zero	25,ST1939 prod/val
	equ	LN2850,*-DPDA-ST2850-1
"
" STATE 2854
	equ	ST2854,*-DPDA
	zero	STRD,LN2854
	zero	T79,ST1962	"OPTIONAL
	zero	T87,ST1968	"POSITION
	equ	LN2854,*-DPDA-ST2854-1
"
" STATE 2857
	equ	ST2857,*-DPDA
	zero	APLY1,LN2857
	zero	1,1   pd ld
	zero	65,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2857,*-DPDA-ST2857-1
"
" STATE 2861
	equ	ST2861,*-DPDA
	zero	STRD,LN2861
	zero	T107,ST1147	",3
	equ	LN2861,*-DPDA-ST2861-1
"
" STATE 2863
	equ	ST2863,*-DPDA
	zero	APLYS,LN2863
	zero	2,2   pd ld
	zero	-149,1   rule/alt
	zero	56,ST2015 prod/val
	equ	LN2863,*-DPDA-ST2863-1
"
" STATE 2867
	equ	ST2867,*-DPDA
	zero	STRD,LN2867
	zero	T107,ST1147	",3
	equ	LN2867,*-DPDA-ST2867-1
"
" STATE 2869
	equ	ST2869,*-DPDA
	zero	APLYS,LN2869
	zero	2,2   pd ld
	zero	-148,1   rule/alt
	zero	56,ST2015 prod/val
	equ	LN2869,*-DPDA-ST2869-1
"
" STATE 2873
	equ	ST2873,*-DPDA
	zero	STRD,LN2873
	zero	T107,ST1147	",3
	equ	LN2873,*-DPDA-ST2873-1
"
" STATE 2875
	equ	ST2875,*-DPDA
	zero	APLYS,LN2875
	zero	1,1   pd ld
	zero	-137,2   rule/alt
	zero	59,ST2815 prod/val
	equ	LN2875,*-DPDA-ST2875-1
"
" STATE 2879
	equ	ST2879,*-DPDA
	zero	STRD,LN2879
	zero	T108,ST2043	",4
	equ	LN2879,*-DPDA-ST2879-1
"
" STATE 2881
	equ	ST2881,*-DPDA
	zero	APLY1,LN2881
	zero	-1,-1   pd ld
	zero	-164,1   rule/alt
	zero	70,ST2033 prod/val
	equ	LN2881,*-DPDA-ST2881-1
"
" STATE 2885
	equ	ST2885,*-DPDA
	zero	STRD,LN2885
	zero	T62,ST2054	"IF
	equ	LN2885,*-DPDA-ST2885-1
"
" STATE 2887
	equ	ST2887,*-DPDA
	zero	APLY1,LN2887
	zero	0,0   pd ld
	zero	162,1   rule/alt
	zero	69,ST1864 prod/val
	equ	LN2887,*-DPDA-ST2887-1
"
" STATE 2891
	equ	ST2891,*-DPDA
	zero	STRD,LN2891
	zero	T62,ST2056	"IF
	equ	LN2891,*-DPDA-ST2891-1
"
" STATE 2893
	equ	ST2893,*-DPDA
	zero	APLY1,LN2893
	zero	0,0   pd ld
	zero	158,1   rule/alt
	zero	69,ST1864 prod/val
	equ	LN2893,*-DPDA-ST2893-1
"
" STATE 2897
	equ	ST2897,*-DPDA
	zero	STRD,LN2897
	zero	T62,ST935	"IF
	equ	LN2897,*-DPDA-ST2897-1
"
" STATE 2899
	equ	ST2899,*-DPDA
	zero	APLYS,LN2899
	zero	4,4   pd ld
	zero	48,1   rule/alt
	zero	25,ST1939 prod/val
	equ	LN2899,*-DPDA-ST2899-1
"
" STATE 2903
	equ	ST2903,*-DPDA
	zero	STRD,LN2903
	zero	T79,ST2070	"OPTIONAL
	zero	T87,ST2076	"POSITION
	equ	LN2903,*-DPDA-ST2903-1
"
" STATE 2906
	equ	ST2906,*-DPDA
	zero	APLY1,LN2906
	zero	2,2   pd ld
	zero	70,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2906,*-DPDA-ST2906-1
"
" STATE 2910
	equ	ST2910,*-DPDA
	zero	STRD,LN2910
	zero	T87,ST2078	"POSITION
	equ	LN2910,*-DPDA-ST2910-1
"
" STATE 2912
	equ	ST2912,*-DPDA
	zero	APLY1,LN2912
	zero	2,2   pd ld
	zero	66,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2912,*-DPDA-ST2912-1
"
" STATE 2916
	equ	ST2916,*-DPDA
	zero	STRD,LN2916
	zero	T108,ST2043	",4
	equ	LN2916,*-DPDA-ST2916-1
"
" STATE 2918
	equ	ST2918,*-DPDA
	zero	APLY1,LN2918
	zero	0,0   pd ld
	zero	-163,1   rule/alt
	zero	70,ST2033 prod/val
	equ	LN2918,*-DPDA-ST2918-1
"
" STATE 2922
	equ	ST2922,*-DPDA
	zero	STRD,LN2922
	zero	T62,ST2144	"IF
	equ	LN2922,*-DPDA-ST2922-1
"
" STATE 2924
	equ	ST2924,*-DPDA
	zero	APLY1,LN2924
	zero	1,1   pd ld
	zero	159,1   rule/alt
	zero	69,ST1864 prod/val
	equ	LN2924,*-DPDA-ST2924-1
"
" STATE 2928
	equ	ST2928,*-DPDA
	zero	STRD,LN2928
	zero	T79,ST2154	"OPTIONAL
	zero	T87,ST2160	"POSITION
	equ	LN2928,*-DPDA-ST2928-1
"
" STATE 2931
	equ	ST2931,*-DPDA
	zero	APLY1,LN2931
	zero	3,3   pd ld
	zero	63,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2931,*-DPDA-ST2931-1
"
" STATE 2935
	equ	ST2935,*-DPDA
	zero	STRD,LN2935
	zero	T87,ST2162	"POSITION
	equ	LN2935,*-DPDA-ST2935-1
"
" STATE 2937
	equ	ST2937,*-DPDA
	zero	APLY1,LN2937
	zero	3,3   pd ld
	zero	71,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2937,*-DPDA-ST2937-1
"
" STATE 2941
	equ	ST2941,*-DPDA
	zero	STRD,LN2941
	zero	T42,ST2172	"DELIMITED
	zero	T79,ST2174	"OPTIONAL
	zero	T87,ST2180	"POSITION
	zero	T110,ST2182	"SPECIAL
	equ	LN2941,*-DPDA-ST2941-1
"
" STATE 2946
	equ	ST2946,*-DPDA
	zero	APLY1,LN2946
	zero	3,3   pd ld
	zero	51,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2946,*-DPDA-ST2946-1
"
" STATE 2950
	equ	ST2950,*-DPDA
	zero	STRD,LN2950
	zero	T24,ST2221	"ALIGN
	zero	T32,ST2223	"CENTER
	zero	T33,ST2228	"CHARACTER
	zero	T34,ST2230	"COLUMN
	zero	T35,ST904	"CONCATENATE
	zero	T48,ST2232	"EDIT
	zero	T54,ST2234	"FILL
	zero	T58,ST2252	"FOLD
	zero	T68,ST2256	"LEFT
	zero	T69,ST2260	"LET
	zero	T86,ST2264	"PICTURE
	zero	T94,ST2266	"RIGHT
	zero	T109,ST2270	"BSP
	equ	LN2950,*-DPDA-ST2950-1
"
" STATE 2964
	equ	ST2964,*-DPDA
	zero	APLY,LN2964
	zero	1,1   pd ld
	zero	169,1   rule/alt
	zero	73,ST2023 prod/val
	zero	ST2916,ST2140
	equ	LN2964,*-DPDA-ST2964-1
"
" STATE 2969
	equ	ST2969,*-DPDA
	zero	STRD,LN2969
	zero	T87,ST2291	"POSITION
	equ	LN2969,*-DPDA-ST2969-1
"
" STATE 2971
	equ	ST2971,*-DPDA
	zero	APLY1,LN2971
	zero	4,4   pd ld
	zero	64,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2971,*-DPDA-ST2971-1
"
" STATE 2975
	equ	ST2975,*-DPDA
	zero	STRD,LN2975
	zero	T87,ST2308	"POSITION
	equ	LN2975,*-DPDA-ST2975-1
"
" STATE 2977
	equ	ST2977,*-DPDA
	zero	APLY1,LN2977
	zero	4,4   pd ld
	zero	52,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2977,*-DPDA-ST2977-1
"
" STATE 2981
	equ	ST2981,*-DPDA
	zero	STRD,LN2981
	zero	T79,ST2314	"OPTIONAL
	zero	T87,ST2320	"POSITION
	equ	LN2981,*-DPDA-ST2981-1
"
" STATE 2984
	equ	ST2984,*-DPDA
	zero	APLY1,LN2984
	zero	4,4   pd ld
	zero	55,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN2984,*-DPDA-ST2984-1
"
" STATE 2988
	equ	ST2988,*-DPDA
	zero	STRD,LN2988
	zero	T24,ST2221	"ALIGN
	zero	T32,ST2223	"CENTER
	zero	T33,ST2228	"CHARACTER
	zero	T34,ST2230	"COLUMN
	zero	T48,ST2232	"EDIT
	zero	T54,ST2234	"FILL
	zero	T58,ST2252	"FOLD
	zero	T68,ST2256	"LEFT
	zero	T69,ST2260	"LET
	zero	T86,ST2264	"PICTURE
	zero	T94,ST2266	"RIGHT
	zero	T109,ST2270	"BSP
	equ	LN2988,*-DPDA-ST2988-1
"
" STATE 3001
	equ	ST3001,*-DPDA
	zero	APLYS,LN3001
	zero	2,2   pd ld
	zero	168,1   rule/alt
	zero	73,ST2964 prod/val
	equ	LN3001,*-DPDA-ST3001-1
"
" STATE 3005
	equ	ST3005,*-DPDA
	zero	STRD,LN3005
	zero	T14,ST2349	"(
	equ	LN3005,*-DPDA-ST3005-1
"
" STATE 3007
	equ	ST3007,*-DPDA
	zero	APLYS,LN3007
	zero	0,0   pd ld
	zero	182,1   rule/alt
	zero	75,ST2223 prod/val
	equ	LN3007,*-DPDA-ST3007-1
"
" STATE 3011
	equ	ST3011,*-DPDA
	zero	STRD,LN3011
	zero	T79,ST2373	"OPTIONAL
	zero	T87,ST2379	"POSITION
	equ	LN3011,*-DPDA-ST3011-1
"
" STATE 3014
	equ	ST3014,*-DPDA
	zero	APLY1,LN3014
	zero	5,5   pd ld
	zero	53,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN3014,*-DPDA-ST3014-1
"
" STATE 3018
	equ	ST3018,*-DPDA
	zero	STRD,LN3018
	zero	T87,ST2385	"POSITION
	equ	LN3018,*-DPDA-ST3018-1
"
" STATE 3020
	equ	ST3020,*-DPDA
	zero	APLY1,LN3020
	zero	5,5   pd ld
	zero	56,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN3020,*-DPDA-ST3020-1
"
" STATE 3024
	equ	ST3024,*-DPDA
	zero	STRD,LN3024
	zero	T87,ST2418	"POSITION
	equ	LN3024,*-DPDA-ST3024-1
"
" STATE 3026
	equ	ST3026,*-DPDA
	zero	APLY1,LN3026
	zero	6,6   pd ld
	zero	54,1   rule/alt
	zero	26,ST1239 prod/val
	equ	LN3026,*-DPDA-ST3026-1
	equ	DPDAs,*-DPDA


	zero	1,14	"SKIP/ADJ

	zero	7,2	"SKIP/ADJ

	zero	118,0	"SKIP/ADJ

	zero	23,3034	"SKIP/ADJ

	zero	8,10	"SKIP/ADJ

	zero	64,0	"SKIP/ADJ

	zero	70,0	"SKIP/ADJ

	zero	302,0	"SKIP/ADJ

	zero	1541,0	"SKIP/ADJ

	zero	2003,0	"SKIP/ADJ

	zero	2401,0	"SKIP/ADJ

	zero	2474,0	"SKIP/ADJ

	zero	2525,0	"SKIP/ADJ

	zero	2530,0	"SKIP/ADJ

	zero	2536,0	"SKIP/ADJ

	end
  



		    report_.pl1                     05/20/80  1933.0r w 05/20/80  1924.4       39573


/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

report_: proc;

	call com_err_ (0, "report_", "Cannot call I/O switch directly.");
	return;

report_attach: entry (iocb_ptr, option_array, com_err_sw, code);

dcl  iocb_ptr ptr,					/* points to the control block of switch to be attached */
     option_array (*)char (*)var,
     com_err_sw bit (1),
     code fixed bin (35);

	iocbp = iocb_ptr;
	if (iocbp -> iocb.attach_descrip_ptr ^= null ())
	then do;
	     code = error_table_$not_detached;
	     return;
	end;

	if (hbound (option_array, 1) = 0)
	then do;
	     code = error_table_$insufficient_open;
	     if com_err_sw
	     then do;
		call com_err_(code,"report_","Missing report name.");
	     end;
	     return;
	end;
	call hcs_$make_ptr (null(), (option_array (1)), "attach", ep_ptr, code);
	if (code ^= 0)
	then do;
	     if com_err_sw
	     then do;
		call com_err_(code,"report_","^a$attach",option_array(1));
	     end;
	     return;
	end;

	rcbp = null ();
	call cu_$ptr_call (ep_ptr, rcbp, option_array, code);
	if (code ^= 0)
	then do;
	     if com_err_sw
	     then do;
		call com_err_(code,"report_");
	     end;
	     return;
	end;

	iocbp -> iocb.open = report_$open;
	iocbp -> iocb.detach_iocb = report_$detach;
	iocbp -> iocb.attach_data_ptr = rcbp;
	aloc_len = length (option_array (1)) + 8;
	allocate descrip;
	descrip.string = "report_ " || option_array (1);
	iocbp -> iocb.attach_descrip_ptr = d_ptr;

	code = 0;
	call iox_$propagate (iocb_ptr);
	return;

dcl 1 descrip based (d_ptr),
    2 leng fixed bin,
    2 string char (aloc_len refer (leng));
dcl  aloc_len fixed bin;
dcl  d_ptr ptr;
dcl  cmode char (20)var;
dcl  rcbp ptr;
dcl 1 rcb based (rcbp),
    2 E,
      3 mode fixed bin,
      3 write entry (ptr, ptr, fixed bin (21), fixed bin (35)),
      3 close entry (ptr, fixed bin (35));

open:	entry (iocb_ptr, mode, unused, code);
dcl  mode fixed bin,
     unused bit (1);

	iocbp = iocb_ptr -> iocb.actual_iocb_ptr;
	rcbp = iocbp -> attach_data_ptr;
	if (mode ^= E.mode)
	then do;
	     code = error_table_$missent;
	     return;
	end;
	if (mode = 2)
	then do;
	     cmode = "stream_output";
	     iocbp -> iocb.put_chars = report_$put;
	end;
	else if (mode = 5)
	then do;
	     cmode = "sequential_output";
	     iocbp -> iocb.write_record = report_$put;
	end;
	else do;
	     code = error_table_$no_operation;
	     return;
	end;
	aloc_len = length (cmode);
	allocate descrip;
	descrip.string = cmode;
	iocbp -> iocb.open_descrip_ptr = d_ptr;
	iocbp -> iocb.close = report_$close;
	call iox_$propagate (iocb_ptr);
	return;


put:	entry (iocb_ptr, buff_ptr, rec_len, code);

dcl  buff_ptr ptr,
     rec_len fixed bin (21);
	iocbp = iocb_ptr -> actual_iocb_ptr;
	rcbp = iocbp -> attach_data_ptr;
          code = 0;
	call E.write (rcbp, buff_ptr, rec_len, code);
	return;


close:	entry (iocb_ptr, code);

	iocbp = iocb_ptr -> actual_iocb_ptr;
	rcbp = iocbp -> iocb.attach_data_ptr;
	call E.close (rcbp, code);
	iocbp -> iocb.open = report_$reopen;
	iocbp -> iocb.detach_iocb = report_$detach;
	iocbp -> iocb.open_descrip_ptr = null ();
	call iox_$propagate (iocb_ptr);
	return;

reopen:	entry (iocb_ptr, mode, unused, code);

	code = error_table_$not_detached;
	return;

detach:	entry (iocb_ptr, code);

	iocb_ptr -> iocb.attach_descrip_ptr = null ();
	call iox_$propagate (iocb_ptr);
	return;


dcl com_err_ entry options(variable);
dcl  cu_$decode_entry_value entry;
dcl  cu_$ptr_call entry options(variable);
dcl  env_ptr ptr;
dcl  ep_ptr ptr;
dcl  error_table_$insufficient_open fixed bin(35)ext static;
dcl  error_table_$missent fixed bin(35)ext static;
dcl  error_table_$no_operation fixed bin(35)ext static;
dcl  error_table_$not_detached fixed bin(35)ext static;
dcl  hcs_$make_ptr entry(ptr,char(*),char(*),ptr,fixed bin(35));
dcl  iocbp ptr;
dcl iox_$propagate entry (ptr);
dcl  report_$close entry;
dcl  report_$detach entry;
dcl  report_$open entry;
dcl  report_$put entry;
dcl  report_$reopen entry;
%include iocb;

     end;


		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved