



		    COBOL_SYNTAX_TRACE_.pl1         05/24/89  1044.4rew 05/24/89  0834.2       80325



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 COBOL_SYNTAX_TRACE_.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 01/31/80 by FCH, [4.2-2], rw phase added */
/* Modified on 11/15/79 by MHD, [4.2-1], added comment entries to rls segments */
/* Modified since Version 4.0 */


/* format: style3 */
COBOL_SYNTAX_TRACE_:
     proc (arg_ptr, trace_mode);

/*	perform a trace in the syntax interpreter	*/

declare	arg_ptr		ptr,
	trace_mode	fixed bin (31);

declare	ioa_		entry options (variable);

dcl	tssi_$clean_up_segment
			entry (ptr);
dcl	tssi_$get_segment	entry (char (*), char (*), ptr, ptr, fixed bin (35));
dcl	get_pdir_		entry returns (char (168));
dcl	expand_pathname_	entry (char (*), char (*), char (*), fixed bin (35));
dcl	hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35));
dcl	com_err_		entry options (variable);


declare	(mode, line_offset) static internal;


declare	trace_on		fixed bin static internal;

declare	1 trace		static internal,
	  2 curr_first	fixed bin (31) init (0),
	  2 curr_last	fixed bin (31) init (0),
	  2 phase,
	    4 first	(5) fixed bin (31) init (0, 0, 0, 0, 0),
	    4 last	(5) fixed bin (31) init (0, 0, 0, 0, 0);

declare	arc_name		char (32);
declare	NAME		char (32);
declare	line		char (118);
declare	dec		char (16);
declare	digs		char (10) init ("0123456789");

declare	(i, curr_offset, curr_line, line_count)
			fixed bin (31);
declare	(siz, loc, tloc, POS)
			fixed bin;
declare	(first, last, val, pos, CL)
			fixed bin (31);
declare	off		ptr;
declare	phase_num		fixed bin (31);

dcl	(null, addr, substr, unspec, fixed, mod, index, divide)
			builtin;

dcl	code		fixed bin (35);
dcl	aclinfo_ptr	ptr;
dcl	bc		fixed bin (24);
dcl	cleanup		condition;
dcl	dn		char (168),
	en		char (32);

declare	1 interp		based (arg_ptr),
	  2 current_line	fixed bin (31),
	  2 phase		fixed bin (31),
	  2 addr_record	ptr,
	  2 filler	ptr,
	  2 dir_ptr	ptr,
	  2 source_ptr	ptr;

declare	1 header		based (addr_record),
	  2 size		fixed bin (31),
	  2 line		fixed bin (31),
	  2 column	fixed bin (31),
	  2 type		fixed bin (31);

declare	1 rl_dir		(10000) based (interp.dir_ptr),
	  2 offset	ptr,
	  2 size		fixed bin (31),
	  2 line		fixed bin (31);

declare	char_string	char (100000) based (source_ptr);

declare	char_array	(100000) char (1) based (source_ptr);
declare	bit_array		(100000) bit (9) based (source_ptr);

declare	arg		char (32) based (arg_ptr);

reset_trace:
     entry;



	trace.curr_first = 0;
	trace.curr_last = 0;


	return;

trace:
     entry (arg_ptr, trace_mode);


	go to T (trace_on);

T (0):
	if header.line = 0
	then return;
	else if header.line < trace.curr_first
	then return;
	else trace_on = 1;

	go to T1;

T (1):
	if trace.curr_last ^= 0
	then do;
		if header.line > trace.curr_last
		then do;
			trace_on = 2;
			return;
		     end;
	     end;

	go to T1;

T (2):
	return;

T1:
	if mode = 0
	then do;
		CL = current_line + line_offset;
		line = " ";
		siz = rl_dir.size (CL);
		off = rl_dir.offset (CL);

		dec = char (rl_dir.line (CL) * 10);
		substr (line, 1, 5) = substr (dec, 12, 5);

		substr (line, 41, siz) = substr (off -> char_string, 1, siz);

		dec = char (header.line * 10);
		substr (line, 13, 6) = substr (dec, 11, 6);
		dec = char (header.column * 10);
		substr (line, 20, 6) = substr (dec, 11, 6);
		dec = char (header.type * 10);
		substr (line, 27, 6) = substr (dec, 11, 6);

		if (trace_mode = 1 | trace_mode = 4)
		then substr (line, 33, 1) = "~";

		if trace_mode = 4 | trace_mode = 5
		then substr (line, 7, 6) = ">>>>>>";

		if trace_mode = 3
		then substr (line, 7, 6) = "<<<<<<";

		call ioa_ (line);

	     end;

	return;

make_dir:
     proc;

declare	(loc, nb_loc)	fixed bin;
declare	ch		char (1);

	call tssi_$get_segment (get_pdir_ (), "RED_DIR_QJZW", interp.dir_ptr, aclinfo_ptr, code);

	if code ^= 0
	then go to error;

	i, line_count, curr_offset, curr_line = 1;

	do while (substr (char_string, i, 3) ^= "~~~");

	     loc = index (substr (char_string, i, 256), "
");

/*[4.2-1]*/
	     if loc ^= 1 & char_array (i) ^= "~"
	     then do;
		     nb_loc = 1;
		     ch = substr (char_string, 1, 1);

		     do while (ch = " " | ch = "	");

			nb_loc = nb_loc + 1;
			ch = substr (char_string, nb_loc, 1);

		     end;

		     if nb_loc < loc
		     then do;

			     rl_dir.offset (curr_line) = addr (char_array (curr_offset));

			     tloc = index (substr (char_string, i, loc), "~");

			     if tloc = 0
			     then rl_dir.size (curr_line) = loc - 1;
			     else rl_dir.size (curr_line) = tloc - 1;

			     rl_dir.line (curr_line) = line_count;

			     curr_line = curr_line + 1;

			end;

		end;

	     i = i + loc;
	     curr_offset = i;
	     line_count = line_count + 1;
	end;

	if code ^= 0
	then go to error;

     end;

initialize:
     entry (arg_ptr);

/*[4.2-2]*/
	POS = index ("id*dd*pd*db*rw*", substr (arg, 6, 2) || "*");

/*[4.2-2]*/
	if POS = 0
	then return;

/*[4.2-2]*/
	POS = divide (POS + 1, 2, 31, 0);

/*[4.2-2]*/
	call limits;

/*[4.2-2]*/
	trace.phase.first (POS) = first;		/*[4.2-2]*/
	trace.phase.last (POS) = last;

	return;

dec_to_bin:
     proc;

declare	(orig, size)	fixed bin (31);

	orig = i;
	pos = index (digs, substr (arg, i, 1));

	do while (pos ^= 0);
	     i = i + 1;
	     pos = index (digs, substr (arg, i, 1));
	end;

	size = i - orig;

	if size ^= 0
	then val = fixed (substr (arg, orig, size));
	else val = 0;

     end;

arc_entry:
     proc;

/*	char(12)	014 012 012 012				*/
/*		017 012 011 011				*/
/*		b   b   b   b				*/

/*	char(32)	component name(left justified , blank padding)	*/

/*	char(36)	MM/DD/YYbb	date			*/
/*		TTTT.T		time			*/
/*		AAAA		access mode		*/
/*		MM/DD/YYbb	date			*/
/*		TTTT.T		time			*/
/*	char(8)	017 017 017 017				*/
/*		012 012 012 012				*/

/*	char(*)	data (padded with 000 to half word boundry)	*/


declare	ent_ptr		ptr;
declare	size		fixed bin (36);

declare	1 entry		based (ent_ptr),
	  2 flag1		char (12),
	  2 name		char (32),
	  2 desc		char (36),
	  2 size		char (12),
	  2 flag2		char (8),
	  2 data		(100000) char (1);

	ent_ptr = source_ptr;

	do while ("1"b);

	     if NAME = entry.name
	     then do;
		     source_ptr = addr (entry.data (1));
		     return;
		end;

	     if unspec (substr (entry.flag1, 1, 1)) ^= "000001100"b
	     then do;
		     source_ptr = null ();
		     return;
		end;

	     size = fixed (entry.size);
	     size = size / 9;
	     size = size + mod (-size, 4);

	     ent_ptr = addr (entry.data (size + 1));

	end;

     end;

limits:
     proc;

	first = 0;
	last = 0;

	i = 8;
	call dec_to_bin;

	first = val;
	if substr (arg, i, 1) ^= ","
	then return;

	i = i + 1;
	call dec_to_bin;

	last = val;

     end;

error:
	call com_err_ (code, "COBOL_SYNTAX_TRACE_");
	return;

cl:
     proc;

	call tssi_$clean_up_segment (aclinfo_ptr);

     end;

initialize_phase:
     entry (arg_ptr, phase_num);

	line_offset = 0;

	on cleanup call cl;

	go to ph (phase_num);

ph (1):
	NAME = "IDEDTABLE.reductions";
	arc_name = "IDEDTABLE.archive";
	go to pha;

ph (2):
	NAME = "DDTABLE.reductions";
	arc_name = "DDTABLE.archive";
	go to pha;

ph (3):
	NAME = "PDTABLE.reductions";
	arc_name = "PDTABLE.archive";
	go to pha;

ph (4):
	NAME = "DB.reductions";
	arc_name = "DB.archive";
	go to pha;

/*[4.2-2]*/
ph (5):						/*[4.2-2]*/
	NAME = "RW.reductions";
	arc_name = "RW.archive";			/*[4.2-2]*/
	go to pha;

pha:
	mode = 0;

	call expand_pathname_ (NAME, dn, en, code);

	if code ^= 0
	then go to error;

	call hcs_$initiate_count (dn, en, "", bc, 1, source_ptr, code);

	if source_ptr = null ()
	then do;
		call expand_pathname_ (arc_name, dn, en, code);

		if code ^= 0
		then go to error;

		call hcs_$initiate_count (dn, en, "", bc, 1, source_ptr, code);

		if source_ptr = null ()
		then mode = 1;
		else do;
			call arc_entry;

			if source_ptr = null ()
			then go to error;

		     end;
	     end;

	call make_dir;

	trace.curr_first = trace.first (phase_num);
	trace.curr_last = trace.last (phase_num);

	trace_on = 0;


     end COBOL_SYNTAX_TRACE_;




		    PNOTICE_cobol.alm               11/14/89  1050.4r w 11/14/89  1050.4        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., 1989"
          acc       "Copyright (c) 1989 by Massachusetts Institute of
Technology and Honeywell Information Systems, Inc."

	aci	"C1C74M0A2000"
	aci	"C2C74M0A2000"
	aci	"C3C74M0A2000"
	end




		    cobol.pl1                       05/24/89  1044.4rew 05/24/89  0835.4      549918



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 10/1/83 by FCH, [5.2...]. trace added */
/* Modified on 11/25/81 by FCH, [5.1-3], main prog added to include file table, BUG519(phx11818) */
/* Modified on 10/23/81 by FCH, [5.1-2], issue diag if long line found, phx11819(BUG517) */
/* Modified on 10/13/81 by FCH, [5.1-1], hisi data alloc algorithm if cobol$multics */
/* Modified on 10/02/81 by FCH, [5.0-1], formatting not forced if first char was tab, BUG511 */
/* Modified on 07/11/81 by FCH, [4.4-9], work files clobbered if corres and debug phases used, phx10380(BUG492) */
/* Modified on 05/27/81 by FCH, [4.4-8], size of work files reset to zero, phx09988(BUG485) */
/* Modified on 05/26/81 by FCH, [4.4-7], cobol_ecs_info replaced by sys incl file status_structures, phx09946(BUG484) */
/* Modified on 05/25/81 by FCH, [4.4-6], change message emitted when -table and -fmt used, phx09946(BUG484) */
/* Modified on 05/19/81 by FCH, [4.4-5], default is table */
/* Modified on 05/19/81 by FCH, [4.4-4], -sv and -lev may optionally be followed by spaces */
/* Modified on 12/01/80 by FCH, [4.4-3], report writer phase added */
/* Modified on 10/22/80 by FCH, COBOL_SYNTAX_TRACE_ changed to cobol_syntax_trace_ */
/* Modified on 10/17/80 by PRP, [4.4-2], TR7956(BUG446), temp segs not cleaned up on bad arg error */
/* Modified on 08/15/80 by FCH, [4.4-1], TR6483(BUG440), zero length source seg caused compiler to abort */
/* Modified on 2/27/80 by PRP, [4.2-4], phx05396b  -sv4 fixed */
/* Modified on 02/14/80 by FCH, [4.2-3], answered phx05331s */
/* Modified on 02/12/80 by MHD, [4.2-2], answered phx05237o, phx05238u, and phx05231b */
/* Modified on 10/26/79 by MHD, [4.1-3], left cobol_m2fp pointing to last minpral-2 for appending type 25 tokens */
/* Modified on 10/18/79 by MHD, [4.1-2], deleted unused parameter to cobol_print_diag */
/* Modified on 10/12/79 by FCH, [4.1-1], -card, revision to .ex.cobol */
/* Modified on 08/17/79 by PRP, [4.0-6], fixed warning message for -fmt and -tb */
/* Modified on 06/08/79  by PRP, [4.0-5], recursive call to compiler eliminated */
/* Modified on 04/09/79 by FCH, [4.0-4], compatibility entry points added added */
/* Modified on 04/02/79 by FCH, [4.0-3], debug phase added */
/* Modified on 03/30/79 by FCH, [4.0-2], option -svNM added */
/* Modified on 02/26/79 by FCH, [4.0-1], option -levN M added */
/* Modified on 1/31/79 by FCH, [3.0-11], cobol equiv to cobol$id */
/* Modified on 10/25/78 by RAL, [3.0-10], initilize ecs_info_table.diag_indicators */
/* Modified on 10/25/78 by FCH, [3.0-9], area allocation standardized */
/* Modified on 10/23/78 by RAL, [3.0-8], COPY ... REPLACING and REPLACE statements */
/* Modified on 09/12/78 by RAL, [3.0-7], warning about the use of -tb and -fmt and probing source */
/* Modified on 06/22/78 by RAL, [3.0-6], entries cobol$(push_name pop_name) */
/* Modified on 06/06/78 by FCH, [3.0-5], delete list file before compilation */
/* Modified on 05/24/78 by FCH, [3.0-4], logic of condition handling rewritten */
/* Modified on 04/27/78 by FCH, [3.0-3], symbol section(compiler options) */
/* Modified on 04/27/78 by FCH, [3.0-2], symbol section(source module path name) */
/* Modified on 01/24/78 by FCH, [3.0-1], xref listing suppressed if fatals */
/* Modified since Version 3.0 */







/* format: style3 */
cobol:
     proc;

/*   This is the driver for the Multics COBOL compiler.
It processes all compiler control options, establishes the source
segment, and calls each phase of the compiler in order:

     Front:
	cobol_lex		(LEX)
	cobol_idedsyn	(ID/ED SYNTAX)
	cobol_ddsyntax	(DD SYNTAX)
	cobol_ddalloc	(DD ALLOCATION)
	cobol_repl3	(REPLACEMENT)
	cobol_ci_phase	(CORRESPONDING)
	cobol_pdstax	(PD SYNTAX)
	cobol_print_diag	(PRINT DIAG)
     Back:
	cobol_gen_driver_	(GENERATOR)
	cobol_make_xref_	(ANALYZER)
	cobol_fix_driver_	(FIXUP)

All files used by the various phases are declared, opened and closed
by the driver.  */

/*************************************/
id:
     entry;					/*[3.0-11]*/

	string (trace) = ""b;
	MODE = 0;
	go to start;

/*************************************/
trace:
     entry;

	string (trace) = "1000"b;
	MODE = 0;

	go to start;

rw:
     entry;

/*[4.4-0]*/
	MODE = 5;					/*[4.4-0]*/
	go to start;

gcos:
     entry;

/*[4.0-4]*/
	call set_mode (1);				/*[4.0-4]*/
	go to start;

ibm_ansi:
     entry;

/*[4.0-4]*/
	call set_mode (2);				/*[4.0-4]*/
	go to start;

ibm_ef:
     entry;

/*[4.0-4]*/
	call set_mode (3);				/*[4.0-4]*/
	go to start;

multics:
     entry;

/*[4.0-4]*/
	call set_mode (4);				/*[4.0-4]*/
	go to start;

copy_file_size:
     entry (bc);

/*[5.1-2]*/
	call cobol_merge$copy_file_size (bc);		/*[5.1-2]*/
	return;

/*[5.1.2]*/
dcl	cobol_merge$copy_file_size
			entry (fixed bin (24));	/*[5.1-2]*/
dcl	bc		fixed bin (24);

push_name:
     entry (dir_name, entryname);			/* [3.0-6] */

/* This is called to push the source name and
			    all include files onto a stack to be
			      used to build the symbol table */


dcl	dir_name		char (168);
dcl	entryname		char (32);

	call hcs_$status_long (dir_name, entryname, 1, addr (branch_status), null (), mcode);

	c_name.ct = c_name.ct + 1;

/* [3.0-9] */
	allocate source_name in (cobol_area) set (source_name_ptr);
						/* [3.0-9] */
	source_name.prev_name_ptr = c_name.last_name_ptr; /* [3.0-9] */
	c_name.last_name_ptr = source_name_ptr;		/* [3.0-9] */

	l_dn = index (dir_name, " ") - 1;
	l_en = index (entryname, " ") - 1;

	source_name.sname = substr (dir_name, 1, l_dn) || ">" || substr (entryname, 1, l_en);
						/*[4.4-7]*/
	source_name.uid = branch_status.uid;		/*[4.4-7]*/
	source_name.dtm = branch_status.dtcm;

	return;


pop_name:
     entry returns (ptr);				/* [3.0-6] */

/* This is call to pop the names off of
			    a stack by cobol_sym_init.pl1 */

/* [3.0-9] */
	if c_name.last_name_ptr = null ()
	then return (null ());			/* [3.0-9] */
						/* [3.0-9] */
	c_name.pname = c_name.last_name_ptr -> source_name.sname;
						/* [3.0-9] */
	c_name.uid = c_name.last_name_ptr -> source_name.uid;
						/* [3.0-9] */
	c_name.dtm = c_name.last_name_ptr -> source_name.dtm;
						/* [3.0-9] */
	c_name.last_name_ptr = c_name.last_name_ptr -> source_name.prev_name_ptr;

	c_name.size = index (c_name.pname, " ") - 1;
	if c_name.size = -1
	then c_name.size = 168;

	return (addr (c_name));

/* [3.0-9] */

alloc:
     entry (alloc_size) returns (ptr);

declare	alloc_size	fixed bin (35);		/**/
						/**/
	allocate words in (cobol_area) set (source_name_ptr);
						/**/
						/**/
	return (source_name_ptr);			/**/


clean_up:
     entry;

/*  This entry is called as a command to cleanup the compile time files. */
/* The calling sequence is:
				cobol$clean_up
			/*}*/
	if fpath ^= ""
	then do segname = "cobol_seg1_", "cobol_seg2_", "cobol_seg3_", "cobol_initval_", "cobol_ntbuff_",
		"cobol_minpral-1_", "cobol_minpral-2_", /*[4.4-3]*/
		"rwdd.incl.cobol", "rwpd.incl.cobol", "cobol_rmin2_", "cobol_r2min2_", "cobol_print_", "cobol_diags_",
		"cobol_pdout_", "cobol_corrout_", "cobol_minpral-1_1", "cobol_minpral-2_1", "cobol_rmin2_1",
		"cobol_pdout_1", "cobol_minpral-1_2", "cobol_minpral-2_2", "cobol_rmin2_2", "cobol_pdout_2",
						/**/
						/*			"cobol_minpral-1_3","cobol_minpral-2_3","cobol_rmin2_3","cobol_pdout_3",
/*			"cobol_minpral-1_4","cobol_minpral-2_4","cobol_rmin2_4","cobol_pdout_4",
/*			"cobol_minpral-1_5","cobol_minpral-2_5","cobol_rmin2_5","cobol_pdout_5",
/**/
		"cobol_common_", "cobol_name_table_", "cobol_format_temp_";

		call hcs_$delentry_file (fpath, segname, mcode);

	     end;

	return;


/*************************************/

restart:
     entry;

	if ^restart
	then return;

	if abort_sw
	then go to finish;
	else abort_sw = "1"b;

	if intact
	then call cu_$cl;
	else if endgen_sw
	then go to finish;
	else if gen_sw
	then go to no_gen;
	else go to start_print_diag;

define_data:
     entry;

/*[5.1-2]*/
	call ided;				/*[5.1-2]*/
	call dd;

/*[5.1-2]*/
	return;

/*************************************/
/* INITIALIZATION */

start:	/***.....  Trace_Bit="0"b;/**/
	/***.....  Trace_Lev=1;/**/
	/***.....  Trace_Line=(60)".";/**/
	if recursion
	then do;

/*[4.0-5]*/
		call ioa_$ioa_stream ("error_output",
		     "cobol: Translation failed. Attempt to invoke COBOL recursively use release first.");

/*[4.0-5]*/
		return;
	     end;
	else recursion = "1"b;

/*[5.1-2]*/
	lex_quit = LEX_QUIT;			/*[5.1-2]*/
	comp_term = COMP_TERM;

/*[4.0-5]*/
/* ESTABLISH CONDITION HANDLERS */

	on command_abort call COND ("command_abort");	/* [3.0-4] */
	on command_abort_ call COND ("command_abort_");	/* [3.0-4] */
	on cleanup call CLEANUP;


	restart = "0"b;
	cobol_sfp = null ();
	cobol_x2_fileno = 0;			/* for optional jif file */
	p_err = "0"b;
	area_info_area.areap = null ();

	call cu_$af_arg_count (pc, mcode);

	if mcode = 0
	then do;

		call com_err_ (0, "cobol", "This command may not be invoked as an active function");
		go to comp_term;

	     end;
	else if mcode ^= error_table_$not_act_fnc
	then do;

		call com_err_ (mcode, "cobol");
		go to comp_term;

	     end;

	if pc = 0
	then /* if no arguments list options */
	     do;

		call print_options;
		go to comp_term;

	     end;


/*[5.1-2]*/
	call init_cobol;

/*[5.1-2]*/
	do i = 1 to pc;

/*[5.1-2]*/
	     call cu_$arg_ptr (i, arg_ptr, l, mcode);

/*[5.1-2]*/
	     call option;

/*[5.1-2]*/
	end;

/*[5.1-2]*/
	call setup;				/* initialize for compilation */
						/*[5.1-2]*/
	call expand_phase;				/* expand_phase_cobol_source */



/*[5.1-2]*/
	call lex;					/* lexical analysis phase */

/*[5.1-2]*/
	call cobol$define_data;

/*[5.1-2]*/
	call ddalloc;				/* dd allocation phase */

/*[5.1-2]*/
	call replace;				/* replacement phase */

/*[5.1-2]*/
	call db_corr;				/* debug, corresponding phase */



/*[5.1-2]*/
/* pd syntax analysis phase */

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	fixed_common.syntax_trace = trace.pd;

/*[5.1-2]*/
	call cobol_pdstax;

/*[5.1-2]*/
	if mcode ^= 0
	then return;

	call cobol_swf_close (cobol_dfp, ST, tptr, 0);

	if time
	then call timer ("PD_SYNTAX.....");

start_print_diag:					/*[5.1-2]*/
	call print_diag;				/*[5.1-2]*/
	call generator;

no_gen:
	endgen_sw = "1"b;

/*[5.1-2]*/
	call analyzer;

/*[5.1-2]*/
	if fixed_common.fatal_no = 0 & opts.cu & ^abort_sw/*[5.1-2]*/
	then call fixup;

finish:						/*[5.1-2]*/
	call finish_proc;

	return;


/* GENERALIZED ERROR PROCESSING */

arg_error:
	call com_err_ (error_table_$badopt, "cobol", argb);

	go to COMP_TERM;

missing_arg_error:
	call com_err_ (error_table_$noarg, "cobol");

	go to COMP_TERM;



multics_error:
	segname = "";

multics_file_error:
	call com_err_ (mcode, "cobol", "  ^a", segname);

COMP_TERM:
	call finis;

	recursion = "0"b;
	return;

LEX_QUIT:						/*[5.1-2]*/
	call CLEANUP;				/*[5.1-2]*/
	call finis;

/*[5.1-2]*/
	return;





set_mode:
     proc (num);

/*[4.0-4]*/
declare	num		fixed bin;

/*[4.0-4]*/
	MODE = num;				/*[4.0-4]*/
	string (trace) = ""b;

     end;

ssv:
     proc;

/*[4.4-4]*/
declare	ch		char (1);

/*[4.4-4]*/
	call cl_arg_check;

/*[4.4-4]*/
	if m ^= 1
	then go to arg_error;

/*[4.4-4]*/
	ch = substr (argb, 1, 1);

/*[4.4-4]*/
	if ch < "1" | ch > "4"
	then go to arg_error;

/*[4.4-4]*/
	call setsv (ch);

/*[4.4-4]*/
	substr (arg, l, 2) = " " || ch;		/*[4.4-4]*/
	l = l + 2;

     end;

slv:
     proc;

/*[4.4-4]*/
declare	(ch1, ch2)	char (1);

/*[4.4-4]*/
	ch2 = " ";

/*[4.4-4]*/
	call cl_arg_check;

/*[4.4-4]*/
	ch1 = substr (argb, 1, 1);

/*[4.4-4]*/
	if ch1 < "1" | ch1 > "5"
	then go to arg_error;

/*[4.4-4]*/
	if m = 1					/*[4.4-4]*/
	then call setlev (ch1, "3");			/*[4.4-4]*/
	else if m = 2				/*[4.4-4]*/
	then do;
		ch2 = substr (argb, 2, 1);

/*[4.4-4]*/
		if ch2 < "1" | ch2 > "3"
		then go to arg_error;

/*[4.4-4]*/
		call setlev (ch1, ch2);		/*[4.4-4]*/
	     end;					/*[4.4-4]*/
	else go to arg_error;

/*[4.4-4]*/
	substr (arg, l, 3) = " " || ch1 || ch2;		/*[4.4-4]*/
	l = l + 3;

     end;

cl_arg_check:
     proc;

/*[4.4-4]*/
	if i = pc
	then go to arg_error;

/*[4.4-4]*/
	i = i + 1;

/*[4.4-4]*/
	call cu_$arg_ptr (i, arg_ptr, m, mcode);

/*[4.4-4]*/
	if mcode ^= 0
	then go to multics_error;

     end;

comp_env:
     proc;

/*[4.0-4]*/

/*[4.0-4]*/
	go to M (MODE);				/* default */

M (0):						/*[4.0-4]*/
	go to MM;

M (1):						/* gcos */
						/*[4.0-4]*/
	fixed_common.compile_mode = "101"b;

/*[4.0-4]*/
	go to MM;

M (2):						/* ibm_ansi */
						/*[4.0-4]*/
	fixed_common.compile_mode = "01"b;

/*[4.0-4]*/
	go to MM;

M (3):						/* ibm_ef */
						/*[4.0-4]*/
	fixed_common.compile_mode = "01"b;

/*[4.0-4]*/
	go to MM;

M (4):						/* multics */
						/*[5.1-1]*/
	fixed_common.compile_mode = "00011"b;

/*[4.0-4]*/
	go to MM;

M (5):						/* rw */
						/*[4.4-0]*/
	go to MM;

/*	1  alphanumeric literal continuation ala gcos
		2  " or ' allowed to delimit alphanumeric literals
		3  replace tab by spaces to give a 72 char line
		4 "$" and "_" allowed in data-names
		5 hisi data allocation algorithm used
	*/
MM:
     end;


init_cobol:
     proc;

/* GET SOURCE PROGRAM NAME AND OPTIONS */

	upto = 0;
	cobol_options = "";
	cobol_options_len = 1;

	string (opts) = ""b;
	opts.pd = "1"b;				/* always print diagnostics on console*/
	opts.cu = "1"b;				/* produce object code */
	opts.m_wn = "1"b;				/*print warnings on terminal*/
	opts.m_fat = "1"b;				/*   print fatals on terminal*/
						/*[4.4-5]*/
	opts.pst = "1"b;				/* default is table */

	cobol_xlast8 = "0"b;
	time = "0"b;
	intact = "0"b;
	opts.card = "0"b;
	opts.exp, expand = "0"b;			/* [3.0-8] */
	COMP_LEVEL = "5";
	LEVSV = "001"b;
	ddsyn_sw = "0"b;
	repl_sw = "0"b;

	rel = 1;					/* release files as default (truncate and terminate segments) */

	files_wd = "0"b;
	temp_dir_sw = "0"b;
	gen_sw = "0"b;
	endgen_sw = "0"b;
	abort_sw = "0"b;

/*[4.4-5]*/
	no_tbl_pres, tbl_pres = "0"b;

/* [3.0-9] */
	call init;

/* [3.0-9] */
	if code ^= 0
	then go to multics_error;

     end;

option:
     proc;

	if substr (argb, 1, 1) = "-"
	then do;

		arg = substr (argb, 2);

/*[4.4-5]*/
		if arg = "table" | arg = "tb"
		then do;
			opts.pst = "1"b;
			tbl_pres = "1"b;
		     end;
		else if arg = "symbols" | arg = "sb" | arg = "source" | arg = "sc"
		then call ioa_ ("cobol: Option ^a is obsolete, use -ls or -map (see cobol command)", argb);
		else if arg = "map"
		then do;

			opts.exs = "1"b;
			opts.m_map = "1"b;
			opts.xrn = "1"b;

		     end;

/*[4.0-2]*/
		else /*[4.0-2]*/
		     if substr (arg, 1, 8) = "severity" /*[4.0-2]*/
		then do;
			if l = 10			/*[4.0-2]*/
			then call setsv (substr (arg, 9, 1));
						/*[4.0-2]*/
			else /*[4.0-2]*/
			     if l = 11		/*[4.0-2]*/
			then call setsv (substr (arg, 9, 1));
						/*[4.4-4]*/
			else /*[4.4-4]*/
			     if l = 9		/*[4.4-4]*/
			then call ssv;		/*[4.4-4]*/
			else go to arg_error;	/*[4.0-2]*/
		     end;				/*[4.0-2]*/
		else /*[4.0-2]*/
		     if substr (arg, 1, 2) = "sv"	/*[4.0-2]*/
		then do;
			if l = 4			/*[4.0-2]*/
			then call setsv (substr (arg, 3, 1));
						/*[4.0-2]*/
			else /*[4.0-2]*/
			     if l = 5		/*[4.0-2]*/
			then call setsv (substr (arg, 3, 1));
						/*[4.4-4]*/
			else /*[4.4-4]*/
			     if l = 3		/*[4.4-4]*/
			then call ssv;		/*[4.4-4]*/
			else go to arg_error;	/*[4.0-2]*/
		     end;

		else if arg = "brief" | arg = "bf"
		then opts.m_bf = "1"b;
		else if arg = "format" | arg = "fmt"
		then opts.fmt = "1"b;
		else if arg = "runtime_check" | arg = "rck"
		then opts.oc = "1"b;
		else if arg = "profile" | arg = "pf"
		then opts.profile, opts.pst = "1"b;
		else if arg = "check" | arg = "ck"
		then opts.cu = "0"b;
		else if arg = "list" | arg = "ls"
		then do;

			opts.exs = "1"b;
			opts.xrn = "1"b;
			opts.obj = "1"b;

		     end;
		else if arg = "no_warning" | arg = "nw"
		then opts.nw = "1"b;		/*06-30-77*/
		else if arg = "expand" | arg = "exp"
		then opts.exp, expand = "1"b;		/* [3.0-8] */
						/*[4.1-1]*/
		else if arg = "card"
		then opts.card = "1"b;
		else if arg = "time" | arg = "tm"
		then time = "1"b;
		else if arg = "debug" | arg = "db"
		then do;

			intact = "1"b;
			rel = 0;

		     end;				/*[4.4-5]*/
		else /*[4.4-5]*/
		     if arg = "no_table" | arg = "ntb"	/*[4.4-5]*/
		then do;
			opts.pst = "0"b;
			no_tbl_pres = "1"b;
		     end;
		else if arg = "temp_dir" | arg = "td"
		then do;

			files_wd = "1"b;
			temp_dir_sw = "1"b;
			i = i + 1;

			if i > pc
			then go to missing_arg_error;

			call cu_$arg_ptr (i, arg_ptr, l, mcode);
			if mcode ^= 0
			then go to multics_error;

			if substr (argb, 1, 1) = "-"
			then go to missing_arg_error;

/* following changes are for [4.1-1] and check to see if the */
/* argument specified with  the temp_dir argument is a diectory */

			call expand_pathname_ (argb, dpath, en_1, mcode);

			if mcode ^= 0
			then do;

PATHNAME_ERROR:
				call com_err_ (mcode, "cobol", "^a", argb);

				go to comp_term;

			     end;

			call absolute_pathname_ (argb, fpath, mcode);
						/* get it as a single component, as well */

			if mcode ^= 0
			then goto PATHNAME_ERROR;

			if fpath ^= ">"		/* handle special case (ROOT).  */
			then do;

				call hcs_$status_minf (dpath, en_1, 1, entry_type, (0), mcode);

				if mcode ^= 0
				then do;

					call com_err_ (mcode, "cobol", "^a", fpath);
					go to comp_term;

				     end;

				if entry_type ^= DIRECTORY
				then do;

					call com_err_ (error_table_$notadir, "cobol", "^a", fpath);
					go to comp_term;

				     end;

			     end;			/* then */

/* end changes for [4.1-1] */

		     end;
		else if arg = "working_dir" | arg = "wd"
		then do;

			files_wd = "1"b;
			fpath = get_wdir_ ();

			call ioa_ (
			     "cobol: Obsolete -working_dir option accepted: use ""-temp_dir [wd]"" in future.");

		     end;
		else if trace.on & substr (arg, 1, 5) = "trace"
		then do;

			trace_arg = arg;

			if substr (arg, 6, 2) = "id"
			then trace.id = "1"b;
			else if substr (arg, 6, 2) = "dd"
			then trace.dd = "1"b;
			else if substr (arg, 6, 2) = "pd"
			then trace.pd = "1"b;	/*[4.0-3]*/
			else if substr (arg, 6, 2) = "db"
			then trace.db = "1"b;	/*[4.4-3]*/
			else if substr (arg, 6, 2) = "rw"
			then trace.rw = "1"b;
			else go to arg_error;

			call cobol_syntax_trace_$reset_trace;
			call cobol_syntax_trace_$initialize (addr (trace_arg));

		     end;				/*[4.0-1]*/
		else /*[4.0-1]*/
		     if substr (arg, 1, 5) = "level"	/*[4.0-1]*/
		then do;
			if l = 7			/*[4.0-1]*/
			then call setlev (substr (arg, 6, 1), "3");
						/*[4.0-1]*/
			else /*[4.0-1]*/
			     if l = 8		/*[4.0-1]*/
			then call setlev (substr (arg, 6, 1), substr (arg, 7, 1));
						/*[4.4-4]*/
			else /*[4.4-4]*/
			     if l = 6		/*[4.4-4]*/
			then call slv;		/*[4.4-4]*/
			else go to arg_error;	/*[4.0-1]*/
		     end;				/*[4.0-1]*/
		else /*[4.0-1]*/
		     if substr (arg, 1, 3) = "lev"	/*[4.0-1]*/
		then do;
			if l = 5			/*[4.0-1]*/
			then call setlev (substr (arg, 4, 1), "3");
						/*[4.0-1]*/
			else /*[4.0-1]*/
			     if l = 6		/*[4.0-1]*/
			then call setlev (substr (arg, 4, 1), substr (arg, 5, 1));
						/*[4.4-4]*/
			else /*[4.4-4]*/
			     if l = 4		/*[4.4-4]*/
			then call slv;		/*[4.4-4]*/
			else go to arg_error;	/*[4.0-1]*/
		     end;
		else go to arg_error;

		if temp_dir_sw
		then do;

			temp_dir_sw = "0"b;
			substr (cobol_options, cobol_options_len, 9) = "temp_dir,";

		     end;
		else substr (cobol_options, cobol_options_len, l + 1) = substr (arg, 1, l - 1) || ",";

		cobol_options_len = cobol_options_len + l + 1;

	     end;
	else do;

		if p_err = "0"b
		then do;

			tpath = argb;
			ltp = l;
			p_err = "1"b;
		     end;
		else go to arg_error;

	     end;

/*[4.4-5]*/
	if opts.profile				/*[4.4-5]*/
	then do;
		opts.pst, tbl_pres = "1"b;
		no_tbl_pres = "0"b;
	     end;

     end;

setup:
     proc;

/*[4.4-5]*/
	if cobol_options = " "			/*[4.4-5]*/
	then do;
		cobol_options = "tb,";		/*[5.5-5]*/
		cobol_options_len = 5;		/*[4.4-5]*/
	     end;					/*[4.4-5]*/
	else if ^no_tbl_pres & ^tbl_pres		/*[4.4-5]*/
	then do;
		substr (cobol_options, cobol_options_len, 4) = "tb,";
						/*[4.4-5]*/
		cobol_options_len = cobol_options_len + 4;
						/*[4.4-5]*/
	     end;

	if cobol_options_len = 1
	then do;

		cobol_options = "none";
		cobol_options_len = 4;
	     end;
	else do;

		cobol_options_len = cobol_options_len - 2;
		substr (cobol_options, cobol_options_len, 1) = ";";
	     end;

	if p_err = "0"b
	then go to missing_arg_error;

/* GET ENTRY NAME,DIRECTORY NAME AND PATH NAME */

	p_ptr = addr (dpath);
	e_ptr = addr (ename);
	tp_ptr = addr (tpath);
	fd_ptr = addr (fpath);

/* Following changes made in [4.1-1] */
/* begin changes */

	call expand_pathname_$add_suffix (tpb, "cobol", dpath, en_1, mcode);

	if mcode ^= 0
	then go to multics_error;

	call get_length (p_ptr, 168, ldp);
	call get_length (addr (en_1), 32, en_len);

	len = en_len - 6;
	ename = substr (en_1, 1, len);

	ln = substr (ename, 1, len) || ".list";

	call expand_pathname_ (lname, pln, ln, mcode);

	if mcode ^= 0
	then go to multics_error;

	tpath = dpb || ">" || enb;

	call get_length (tp_ptr, 168, ltp);

	pdpath = get_pdir_ ();

	if ^files_wd
	then fpath = pdpath;

	call get_length (fd_ptr, 168, fdlen);

/* end changes in [4.1-1] */

	if fdlen < 0
	then fdlen = 168;


/* START COMPILATION */

	if time | intact
	then call hcs_$get_usage_values (rb_pf, rb_tm, rb_pp);

	if intact
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	cc = cc + 1;
	cobol_$compile_count = cc;

/* DECLARE FILES TO THE IO SYSTEM */

	call cobol_vdwf (cobol_cmfp, fdir || ">cobol_common_");
	call cobol_vdwf (cobol_ntfp, fdir || ">cobol_name_table_");
	call cobol_swf (cobol_m1fp, fdir || ">cobol_minpral-1_");
	call cobol_swf (cobol_m2fp, fdir || ">cobol_minpral-2_");
						/*[4.4-3]*/
	call cobol_swf (cobol_rwdd, fdir || ">rwdd.incl.cobol");
						/*[4.4-3]*/
	call cobol_swf (cobol_rwpd, fdir || ">rwpd.incl.cobol");
	call cobol_swf (cobol_rm2fp, fdir || ">cobol_rmin2_");
	call cobol_swf (cobol_dfp, fdir || ">cobol_diags_");
	call cobol_swf (cobol_pfp, fdir || ">cobol_print_");
	call cobol_swf (cobol_$initval_file_ptr, fdir || ">cobol_initval_");
	call cobol_vdwf_open (cobol_ntfp, ST);
	call cobol_vdwf_open (cobol_cmfp, ST);
	call cobol_vdwf_sput (cobol_cmfp, ST, addr (common), 4 * size (fixed_common), fcom_key);
						/* initialize fixed common */
	call cobol_vdwf_dget (cobol_cmfp, ST, cobol_com_ptr, fcom_ln, fcom_key);
						/* set external pointer to it */

	call cobol_version$set;

/*[4.4-0]*/
	if MODE ^= 0
	then call comp_env;



	if COMP_LEVEL ^= "5"
	then fixed_common.comp_level = COMP_LEVEL;

/*[4.0-1]*/
	fixed_common.levsv = LEVSV;
	fixed_common.compiler_id = 3;
	cobol_$obj_seg_name = enb;

	call cobol_init_ (fpath, rtbuff_ptr);

/*[4.0-4]*/
	call cobol_gns$set_table;

	if rtbuff_ptr = null ()
	then go to comp_term;

     end;

expand_phase:
     proc;

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

/* Following changes made in [4.1-1] */
/* begin changes */

	call hcs_$initiate_count (dpath, en_1, "", BC, 1, cobol_sfp, mcode);

/*[5.1-3]*/
	include_ptr (0) = pointer (cobol_sfp, 1);

	if cobol_sfp = null ()
	then do;

		call com_err_ (mcode, "cobol", "^a", tpb || ".cobol");

		goto comp_term;

	     end;					/* then */

/*[4.4-1]*/
	if BC = 0					/*[4.4-1]*/
	then do;
		call com_err_ (0, "cobol", "Zero length segment. ^a", tpb || ".cobol");

/*[4.4-1]*/
		go to comp_term;

/* zero length source segment */

/*[4.4-1]*/
	     end;

	if ^opts.fmt
	then if substr (first_source_line, 1, 6) ^= "      "
	     then do;

		     ch1 = substr (first_source_line, 1, 1);
						/*[5.0-1]*/
		     if ch1 > "9" | ch1 = "*" | ch1 = "/" | ch1 = "	"
		     then do;

			     if opts.card
			     then do;

				     call ioa_ (M1);
				     call ioa_ (M2);

				     go to comp_term;

				end;		/* then */

			     else call ioa_ (M1);

			     opts.fmt, fixed_common.options.fmt = "1"b;

			     call set_options (", (fmt);", 8);

			end;			/* then */

		end;				/* then */

	     else ;				/* do nothing */

	else do;

		if opts.card
		then do;

			call ioa_ (M2);

			go to comp_term;

		     end;				/* then */

	     end;					/* else */

	ecs = expand | opts.card | opts.fmt;


	if ecs & en_len > 9
	then if substr (en_1, en_len - 8) = ".ex.cobol"
	     then do;

		     call ioa_ (M4);
		     expand, opts.exp, opts.card, opts.fmt = "0"b;

		end;				/* then */

	call cobol_version$print;

/* end changes for [4.1-1] */

	if ecs
	then do;

/*[4.4-6]*/
		if opts.pst
		then call f_mess;

		if time
		then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

		save_sfp = cobol_sfp;
		ecs_info_ptr = addr (ecs_info_table);
		ecs_info_table.input_ptr = cobol_sfp;	/*[4.1-1]*/
		ecs_info_table.card_indicator = opts.card;
						/*[4.1-1]*/
		ecs_info_table.exp_indicator = expand;
		ecs_info_table.format_indicator = opts.fmt;
		ecs_info_table.compiler_level = fixed_common.comp_level;
		ecs_info_table.diag_indicators = "000"b;
		ecs_info_table.fatal_count = 0;	/*[4.0-1]*/
		ecs_info_table.levsv = fixed_common.levsv;

/*[4.1-1]*/
		ecs_info_table.dir = pdpath;		/*[4.1-1]*/
		ecs_info_table.ent = substr (ename, 1, len) || ".ex.cobol";

		call expand_cobol_source$expand (ecs_info_ptr, mcode);

		if mcode ^= 0
		then goto multics_error;

/*[5.1-2]*/
		BC = ecs_info_table.bc;

		cobol_sfp = ecs_info_table.output_ptr;
		fixed_common.fatal_no = fixed_common.fatal_no + ecs_info_table.fatal_count;

		if time
		then call timer ("EXPAND........");
	     end;					/* [3.0-8] */

/*[5.1-2]*/
	call cobol_merge$source_file_size (BC);

	entry_ptr = addr (branch_status);		/* [3.0-6] */

	call hcs_$fs_get_path_name (cobol_sfp, dn, i, en, mcode);
						/* [3.0-6] */

	if mcode ^= 0
	then goto multics_error;			/* [3.0-6] */

	call push_name (dn, en);			/* [3.0-6] */

     end;

lex:
     proc;

	call cobol_swf_open (cobol_m1fp, ST, tptr, tln, "ou");
	call cobol_swf_open (cobol_m2fp, ST, tptr, tln, "ou");
	call cobol_swf_open (cobol_pfp, ST, tptr, tln, "ou");

	fixed_common.descriptor = common.descriptor;

	call cobol_swf_open (cobol_dfp, ST, tptr, tln, "ou");

	save_m2fp = cobol_m2fp;

/* START LEX PHASE */

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	endlex_sw = "0"b;				/* 10-27-77 */
						/*[4.4-3]*/
	fixed_common.syntax_trace = trace.rw;

	call cobol_lex (enb);

/*[4.4-3]*/
	fixed_common.syntax_trace = "0"b;
	endlex_sw = "1"b;				/* 10-27-77 */
						/*[4-1.2]	cobol_m2fp = save_m2fp;*/
	fixed_common.last_print_rec = cobol_lpr;

	call cobol_swf_close (cobol_pfp, ST, tptr, 0);

	cobol_sfp = pointer (cobol_sfp, 0);		/* reset to start of source */

	if time
	then call timer ("LEX...........");

	if fixed_common.prog_name = "" | fixed_common.prog_name = substr (ename, 1, len)
	then tname = substr (ename, 1, len);
	else tname = substr (ename, 1, len) || "$" || fixed_common.prog_name;

	mcode = -3;				/* avoid stop run if only prog in run unit */

	call cobol_control_$cancel (tname, 0, 1, mcode);

/*[5.1-2]*/
	if MODE = 5
	then go to lex_quit;

     end;

ided:
     proc;

/*************************************/
/* POSITION FILES FOR ID/ED */

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	call cobol_swf_close (cobol_m1fp, ST, tptr, 0);
	call cobol_swf_open (cobol_m1fp, ST, tptr, tln, "in");

/* START ID/ED SYNTAX PHASE */

	cobol_com_fileno = cobol_cmfp;		/*{4.4-3]*/
	cobol_name_fileno, cobol_name_fileno_ptr = cobol_ntfp;
	cobol_min1_fileno = cobol_m1fp;
	fixed_common.syntax_trace = trace.id;

	call cobol_idedsyn;

	fixed_common.syntax_trace = "0"b;

	if fixed_common.prog_name = ""
	then fixed_common.prog_name = substr (ename, 1, len);
						/* PROGRAM-ID missing */

	if time
	then call timer ("ID/ED SYNTAX..");

     end;

dd:
     proc;

/*************************************/
/* START DD SYNTAX PHASE */

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	fixed_common.syntax_trace = trace.dd;

	call cobol_ddsyntax;

	fixed_common.syntax_trace = "0"b;

	if time
	then call timer ("DD SYNTAX.....");

	call cobol_swf_close (cobol_m1fp, ST, tptr, rel); /* close and release cobol_minpral-1_ */

     end;


ddalloc:
     proc;

/*************************************/
/* START DD ALLOCATION PHASE */

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	call cobol_swf_open (cobol_$initval_file_ptr, ST, tptr, tln, "ou");

	ddsyn_sw = "1"b;

	call cobol_init_$segs (mcode, tpath);		/* [3.0-2] */

	if mcode ^= 0
	then go to comp_term;

/*************************************/
/* GET LINK OFFSET FOR COBOL RUN TIME PACKAGE */
/*-04/08/76-*/
	linkoff = 0;

	call cobol_make_link_$type_4 (linkoff, "cobol_rts_");

	call cobol_ddalloc;

	if time
	then call timer ("DD ALLOCATION.");

     end;

replace:
     proc;

/*************************************/
/* POSITION FILES FOR REPLACEMENT */

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	call cobol_swf_close (cobol_$initval_file_ptr, ST, tptr, 0);
	call cobol_swf_close (cobol_m2fp, ST, tptr, 0);
	call cobol_vdwf_close (cobol_ntfp, ST, tptr, 0);
	call cobol_swf_open (cobol_m2fp, ST, tptr, tln, "in");
	call cobol_swf_open (cobol_rm2fp, ST, tptr, tln, "ou");
	call cobol_vdwf_open (cobol_ntfp, ST);

/*[4.4-3]*/
/*cobol_name_fileno_ptr = cobol_ntfp;*/

	cobol_curr_in = cobol_m2fp;
	cobol_curr_out = cobol_rm2fp;

/* START REPLACEMENT PHASE */

	mem_size = 1048575;				/* Number of bytes in 262143 words */

	call cobol_repl3 (mem_size, rtbuff_ptr);

	if time
	then call timer ("REPLACEMENT...");

	cobol_m2fp = cobol_curr_in;
	cobol_rm2fp = cobol_curr_out;

	call cobol_swf_close (cobol_m2fp, ST, tptr, rel); /* close and release input to replacement */
	call cobol_swf_close (cobol_rm2fp, ST, tptr, 0);	/* close and retain output from replacement */
	call cobol_swf (cobol_pdofp, fdir || ">cobol_pdout_");
	call cobol_swf_open (cobol_pdofp, ST, tptr, tln, "ou");

	repl_sw = "1"b;

     end;

db_corr:
     proc;

	call cobol_swf_open (cobol_rm2fp, ST, tptr, tln, "in");

/*[4.0-3]*/
	if fixed_common.corr | fixed_common.initl	/*[4.0-3]*/
	then do;
		call START;			/*OPEN(corrout_)*/

/*[4.0-3]*/
		call cobol_ci_phase;

/*[4.0-3]*/
		if fixed_common.debug		/*[4.0-3]*/
		then do;
			call START_DB;		/* OPEN(rmin2_) */

/*[4.0-3]*/
			fixed_common.syntax_trace = trace.db;
						/*[4.0-3]*/
			call cobol_db_phase;	/*[4.0-3]*/
			fixed_common.syntax_trace = "0"b;

/*[4.0-3]*/
			call FINISH_DB;		/* CLOSE(corrout_,rmin2_) */
						/*[4.0-3]*/
						/* OPEN(rmin2_) */
						/*[4.0-3]*/
		     end;				/*[4.4-9]*/
		else call FINISH ("CORRESPONDING.");

/*[4.0-3]*/
	     end;					/*[4.0-3]*/
	else if fixed_common.debug			/*[4.0-3]*/
	then do;
		call START;			/* OPEN(corrout_) */

/*[4.0-3]*/
		fixed_common.syntax_trace = trace.db;	/*[4.0-3]*/
		call cobol_db_phase;		/*[4.0-3]*/
		fixed_common.syntax_trace = "0"b;

/*[4.0-3]*/
		call FINISH ("DEBUG.........");	/* CLOSE(rmin2_,corrout_) */
						/*[4.0-3]*/
						/* OPEN(corrout_) */
						/*[4.0-3]*/
	     end;

     end;

print_diag:
     proc;

/*************************************/
/* START PRINT_DIAG PHASE */


	if fixed_common.fatal_no ^= 0
	then do;

		if fixed_common.fatal_no > 1
		then errorcon = "errors";
		else errorcon = "error";

		call ioa_ ("");

		if abort_sw
		then call com_err_ (0, "cobol", "^d other fatal ^a encountered in ^a to this point.",
			fixed_common.fatal_no, errorcon, enb);
		else call com_err_ (0, "cobol", "^d fatal ^a encountered in ^a.", fixed_common.fatal_no, errorcon,
			enb);

	     end;

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	if opts.exs
	then do;

		call delete_$path (pln, ln, "100111"b, "", mcode);
						/* [3.0-5] */

		wdir = get_wdir_ ();
		call cobol_cselfle (ST, cobol_hfp, enb || ".list", " ", 0, "h", ""b);
						/* open list file */

	     end;

	call cobol_swf_open (cobol_pfp, ST, tptr, tln, "in");
	call cobol_swf_open (cobol_dfp, ST, tptr, tln, "in");

	if fixed_common.options.exp = "0"b
	then ecs_info_table.diag_indicators = "000"b;	/* [3.0-10] */

	call cobol_print_diag;			/* [4.1-2] */

	call cobol_swf_close (cobol_pfp, ST, tptr, rel);	/* close and release cobol_print_ */
	call cobol_swf_close (cobol_dfp, ST, tptr, rel);	/* close and release cobol_diags_ */
	call cobol_swf_close (cobol_pdofp, ST, tptr, 0);

	if time
	then call timer ("PRINT DIAG....");

	call cobol_swf_close (cobol_rm2fp, ST, tptr, rel);/* close and release cobol_rmin2_ */

	if opts.exs
	then call cobol_cselfle (ST, cobol_hfp, " ", " ", 1, "k", "0"b);
						/* close list file setting bitcount */

	if opts.exs
	then do;

		segname = substr (cobol_$obj_seg_name, 1, index (cobol_$obj_seg_name, " ") - 1) || ".list";

		call hcs_$initiate_count (wdir, segname, "", BC, 01b, cobol_$list_ptr, mcode);

		if cobol_$list_ptr = null ()
		then go to multics_file_error;

		cobol_$list_off = divide (BC + 8, 9, 24, 0) + 1;

	     end;
	else cobol_$list_ptr = null ();

/*************************************/

	if fixed_common.fatal_no ^= 0 | ^opts.cu | abort_sw
	then do;

		if fixed_common.fatal_no ^= 0 & ^abort_sw
		then call com_err_ (error_table_$translation_failed, "cobol");
		else if ^opts.cu
		then call ioa_ ("cobol: No object program generated for ^a.", enb);

		if intact & ^time
		then call timer ("Front:");

		go to no_gen;

	     end;

	if intact & ^time
	then do;

		call timer ("Front:");
		call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	     end;


     end;


generator:
     proc;

/*************************************/
/*************************************/
/* START GENERATOR PHASE */

	cobol_$next_tag = fixed_common.spec_tag_counter + 1;
	segname = "cobol_pdout_";


	call hcs_$initiate (fpath, segname, "", 0b, 00b, cobol_$minpral5_ptr, mcode);

	if cobol_$minpral5_ptr = null ()
	then go to multics_file_error;

	if opts.pst | opts.obj | opts.m_map
	then cobol_$pd_map_sw = 1;
	else cobol_$pd_map_sw = 0;

	if opts.pst
	then do;

		call cobol_vdwf_close (cobol_ntfp, ST, tptr, 0);
		call cobol_vdwf_open (cobol_ntfp, ST);

	     end;

	gen_sw = "1"b;

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	call cobol_gen_driver_;

	if time
	then call timer ("GENERATOR.....");

	cobol_$constant_offset = cobol_$con_wd_off - mod (cobol_$con_wd_off, 2);

     end;

analyzer:
     proc;

/*************************************/
/* START ANALYZER PHASE */

	if opts.xrn & fixed_common.fatal_no = 0
	then do;					/*[3.0-1]*/

		if time
		then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

		call cobol_make_xref_;

		if time
		then call timer ("ANALYZER......");

	     end;

     end;

fixup:
     proc;

/*************************************/
/* START FIXUP PHASE */

	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

	call cobol_fix_driver_;

	if time
	then call timer ("FIXUP.........");

	if intact & ^time
	then call timer ("Back :");

     end;

finish_proc:
     proc;

/* FINISH UP */

	if repl_sw
	then call cobol_swf_close (cobol_pdofp, ST, tptr, rel);
						/* close and release cobol_pdout_ */

	if ddsyn_sw
	then call cobol_swf_close (cobol_$initval_file_ptr, ST, tptr, rel);
						/* close and release cobol_initval_ */

	call cobol_vdwf_close (cobol_cmfp, ST, tptr, rel);/* close and release cobol_common_ */

	call cobol_vdwf_close (cobol_ntfp, ST, tptr, rel);/* close and release cobol_name_table_ */

	if abort_sw
	then call com_err_ (error_table_$translation_aborted, "cobol");

	call CLEANUP;				/* [3.0-4] */

/* [3.0-9] */
	call finis;

	if time | intact
	then do;

		pb_tm = rb_tm;
		pb_pf = rb_pf;
		pb_pp = rb_pp;

		if time
		then call timer ("TOTAL:");
		else call timer ("Total:");

	     end;

     end;





/*[4.1-1]*/

get_length:
     proc (p, l, j);

declare	p		ptr,
	l		fixed bin,
	j		fixed bin,
	name		char (l) based (p);

	j = index (name, " ");

	if j = 0
	then j = l;
	else j = j - 1;

     end get_length;

/*[4.1-1]*/

set_options:
     proc (str, size);

declare	str		char (*),
	size		fixed bin;

	if substr (cobol_options, cobol_options_len, 1) = ";"
	then cobol_options_len = cobol_options_len - 1;

	substr (cobol_options, cobol_options_len + 1, 8) = substr (str, 1, size);

	cobol_options_len = cobol_options_len + size;

     end set_options;


/*[4.0-3]*/

START:
     proc;

/*[4.0-3]*/
/*[4.0-3]*/
	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

/*[4.0-3]*/
	call cobol_swf (cobol_m1fp, fdir || ">cobol_corrout_");
						/*[4.0-3]*/
	call cobol_swf_open (cobol_m1fp, ST, tptr, tln, "ou");
						/* output, corres or db */

/*[4.0-3]*/
	cobol_rmin2fp = cobol_rm2fp;			/* input, corres or db */
						/*[4.0-3]*/
	cobol_x3fp = cobol_m1fp;			/* output, corres or db */

     end;

/*[4.0-3]*/

FINISH:
     proc (ph_name);

/*[4.0-3]*/
/*[4.0-3]*/
dcl	ph_name		char (14);

/*[4.0-3]*/
	call cobol_swf_close (cobol_rm2fp, ST, tptr, 1);	/* input, corres or db */

/*[4.0-3]*/
	cobol_rm2fp = cobol_x3fp;			/* output of corres or db becomes input to pd */

/*[4.0-3]*/
	call cobol_swf_close (cobol_x3fp, ST, tptr, 0);	/* output, corres or db */
						/*[4.0-3]*/
	call cobol_swf_open (cobol_rm2fp, ST, tptr, tln, "in");
						/* input, pd */

/*[4.0-3]*/
	if time
	then call timer (ph_name);

     end;

/*[4.0-3]*/

START_DB:
     proc;

/*[4.0-3]*/
/*[4.0-3]*/
	if time
	then call hcs_$get_usage_values (pb_pf, pb_tm, pb_pp);

/*[4.4-9]*/
	call cobol_swf_close (cobol_m1fp, ST, tptr, 0);	/* output, corres */
						/*[4.4-9]*/
	call cobol_swf_close (cobol_rm2fp, ST, tptr, 0);	/* input, corres */

/*[4.0-3]*/
	cobol_rmin2fp = cobol_m1fp;			/* input, db */
						/*[4.0-3]*/
	cobol_x3fp = cobol_rm2fp;			/* output, db */

/*[4.4-9]*/
	call cobol_swf_open (cobol_m1fp, ST, tptr, tln, "in");
						/* input, db */
						/*[4.4-9]*/
	call cobol_swf_open (cobol_rm2fp, ST, tptr, tln, "ou");
						/* output, db */

     end;						/*[4.0-3]*/

FINISH_DB:
     proc;

/*[4.0-3]*/
/*[4.0-3]*/
	call cobol_swf_close (cobol_rmin2fp, ST, tptr, 1);/* input, db */

/*[4.0-3]*/
	cobol_rm2fp = cobol_x3fp;			/* output of db becomes input to pd */

/*[4.0-3]*/
	call cobol_swf_close (cobol_x3fp, ST, tptr, 0);	/* output, db */
						/*[4.0-3]*/
	call cobol_swf_open (cobol_rm2fp, ST, tptr, tln, "in");
						/* input, pd */

/*[4.0-3]*/
	if time
	then call timer ("DEBUG.........");

     end;						/*[4.0-3]*/

/*************************************/
/* TIMER PROCEDURE */

timer:
     proc (phase);

dcl	phase		char (14);
dcl	(temp, lp, rp)	fixed bin (35);

	call hcs_$get_usage_values (pe_pf, pe_tm, pe_pp);
	temp = pe_tm - pb_tm;
	pb_pf = pe_pf - pb_pf;
	pb_pp = pe_pp - pb_pp;
	lp = divide (temp, 1000000, 35, 0);
	rp = mod (temp, 1000000);
	rp = divide (rp, 1000, 35, 0);

	call ioa_ ("^a ^2d.^3d seconds,^3d pagefaults,^3d prepages.", phase, lp, rp, pb_pf, pb_pp);
	return;
     end timer;

/*[4.0-1]*/

setlev:
     proc (lv, sv);

/*[4.0-1]*/
dcl	(lv, sv)		char (1);

/*[4.0-1]*/
	if lv < "1" | lv > "5"
	then go to arg_error;

/*[4.0-1]*/
	COMP_LEVEL = lv;

/*[4.0-1]*/
	if sv = "1"
	then LEVSV = "100"b;			/*[4.0-1]*/
	else if sv = "2"
	then LEVSV = "010"b;			/*[4.0-1]*/
	else if sv = "3"
	then LEVSV = "001"b;			/*[4.0-1]*/
	else go to arg_error;

     end;

/*[4.0-1]*/

/*[4.0-2]*/

setsv:
     proc (sv);


/*[4.0-2]*/
dcl	sv		char (1);

/*[4.0-2]*/
	if sv < "1" | sv > "4"
	then go to arg_error;

/*[4.0-2]*/
	opts.m_obs = "1"b;

/*[4.2-4]*/
	if sv = "4"				/*[4.2-4]*/
	then opts.m_fat, opts.m_wn, opts.m_obs = "0"b;	/*[4.0-2]*/
	else if sv = "3"				/*[4.0-2]*/
	then opts.m_wn, opts.m_obs = "0"b;		/*[4.0-2]*/
	else if sv = "2"				/*[4.0-2]*/
	then opts.m_obs = "0"b;

     end;

/*[4.0-2]*/


/*************************************/
/* CLEANUP PROCEDURE FOR CLEANUP CONDITION */

CLEANUP:
     proc;					/* [3.0-4] */

	if ^recursion
	then return;				/* 10-27-77 */

	recursion = "0"b;
	revert cleanup;				/* [3.0-4] */

/*[5.1-3]*/
	if cobol_$include_cnt > 0
	then do i = 0 to cobol_$include_cnt;
		call cobol_cselfle (ST, include_ptr (i), " ", " ", 0, "k", "0"b);
	     end;

	if ^intact
	then do segname = "cobol_seg1_", "cobol_seg2_", "cobol_seg3_", "cobol_initval_", "cobol_ntbuff_",
		"cobol_minpral-1_", "cobol_minpral-2_", /*[4.4-3]*/
		"rwdd.incl.cobol", "rwpd.incl.cobol", "cobol_rmin2_", "cobol_r2min2_", "cobol_print_", "cobol_diags_",
		"cobol_pdout_", "cobol_corrout_",	/*[4.4-8]*/
		"cobol_pdout_",			/*[4.4-8]*/
		"cobol_initval_",			/*[4.4-8]*/
		"cobol_print_",			/*[4.4-8]*/
		"cobol_diags_",			/*[4.4-8]*/
		"cobol_rmin2_",			/*[4.4-8]*/
		"cobol_minpral-1_", "cobol_minpral-2_", /*[4.4-8]*/
		"cobol_name_table_", "cobol_common_", "cobol_name_table_", "cobol_format_temp_";
		call hcs_$truncate_file (fpath, segname, 0, mcode);
		call hcs_$terminate_file (fpath, segname, 0b, mcode);
						/*[4.4-8]*/
		call hcs_$set_bc (fpath, segname, 0, mcode);
	     end;

/* [3.0-9] */
	call finis;

	return;

     end CLEANUP;					/* [3.0-4] */

COND:
     proc (cond_name);				/* [3.0-4] */

declare	cond_name		char (*),
	code		fixed bin (35);		/* [3.0-4] */
declare	find_condition_info_
			entry (ptr, ptr, fixed bin (35));
						/* [3.0-4] */

	call find_condition_info_ (null (), addr (cond_info), code);
						/* [3.0-4] */

	call cobol_error (cond_name, cond_info.infoptr, "0"b);
						/* [3.0-4] */

/* [3.0-9] */
	call finis;

     end;


cobol_error:
     proc (cond_name, sptr, cont);			/* condition handler for compile time errors */

dcl	sptr		ptr;
dcl	cond_name		char (*);
dcl	cont		bit (1);
dcl	1 s		based (sptr),
	  2 name		char (32),
	  2 len		fixed bin,
	  2 string	char (0 refer (s.len));

dcl	1 io		based (sptr),
	  2 name		char (32),
	  2 code		fixed bin (35),
	  2 action	fixed bin,		/* 1 - init */
						/* 2 - open */
						/* 3 - get */
						/* 4 - put */
						/* 5 - dget */
						/* 6 - dput */
						/* 7 - close */
						/* 8 - bad cobol_cselfle type */
						/* 9 - bad open mode for sequential file */
	  2 iocb_ptr	ptr,
	  2 file_type	fixed bin,		/* 1 - source */
						/* 2 - copy */
						/* 3 - list */
						/* 4 - cobol_swf */
						/* 5 - cobol_vdwf */
	  2 key		char (5);			/* valid only for type 5, action 5 | 6 */

dcl	action_con	(7) char (10)
			init ("initialize", "open", "get", "put", "direct get", "direct put", "close");
dcl	attach_descrip	char (172) varying based (io.iocb_ptr -> iocb.attach_descrip_ptr);

start_error:
	if cond_name = "command_abort_" | cond_name = "command_abort"
						/* [3.0-4] */
	then if s.name = "cobol_io_"
	     then do;

		     if io.action > 7
		     then do;

			     if action = 8
			     then call com_err_ (error_table_$no_operation, "cobol", "Bad cobol_cselfle file type");
			     else call com_err_ (error_table_$no_operation, "cobol",
				     "Bad open mode for a sequential file");

			end;

		     else if io.file_type = 0 | io.file_type > 3
		     then do;

			     if io.file_type > 3
			     then do;

				     call com_err_ (error_table_$no_operation, "cobol",
					"Attempting to ^a internal work file at ^p", action_con (io.action),
					io.iocb_ptr);

				     if io.file_type = 5 & (io.action = 4 | io.action = 5)
				     then call com_err_ (0, "cobol", "Key is ^a", io.key);

				end;

			     else call com_err_ (error_table_$no_operation, "cobol", "Referencing ^p", io.iocb_ptr);

			     call com_err_ (error_table_$translation_aborted, "cobol");

			end;

		     else call com_err_ (io.code, "cobol", substr (attach_descrip, 7));
		     go to comp_term;

		end;

	     else do;

		     if substr (s.name, 1, 6) = "cobol_"
		     then call com_err_ (0, "cobol", "Unrecoverable code generator error (^a).  ^a.",
			     substr (s.name, 7), s.string);
		     else call com_err_ (0, "cobol", "Unrecoverable ^a error.  ^a.", s.name, s.string);

		end;

	else do;					/* other condition */

		call com_err_ (0, "cobol", "Unrecoverable error.  Unexpected condition signalled.");

		if ^restart
		then do;
			restart = "1"b;
			call cobol$restart;
		     end;

		cont = "1"b;

		return;

	     end;

	if ^intact
	then do;
		if abort_sw
		then go to finish;			/* recursion not allowed */
		else abort_sw = "1"b;

		if ^endlex_sw
		then go to finish;

		if endgen_sw
		then go to finish;
		else if gen_sw
		then go to no_gen;
		else go to start_print_diag;
	     end;
	else call cu_$cl;

	return;

     end cobol_error;


/*************************************/

print_options:
     proc;

dcl	message		char (80);

/*[4.2-2]*/

/*[4.2-3]*/
	call com_err_ (error_table_$noarg, "cobol");

	call cobol_version$print;

/*[4.2-3]*/
	call ioa_ ("Usage: cobol path {ctl_args}");	/*[4.2-3]*/
	call ioa_ ("Control arguments:-map -list -no_table -profile");
						/*[4.2-3]*/
	call ioa_ ("-brief -check -runtime_check -expand");
						/*[4.2-3]*/
	call ioa_ ("-format -card -temp_dir PATH");	/*[4.2-3]*/
	call ioa_ ("-severity N -level NM");

     end print_options;




init:
     proc;

/**/
/**/
	code = 0;					/**/
						/**/
	call get_temp_segments_ ("cobol", temp_ptr, code);/**/
						/**/
	if code ^= 0
	then return;				/**/
						/**/
	area_infop = addr (area_info_area);		/**/
						/**/
	area_info_area.version = area_info_version_1;	/**/
	area_info_area.owner = "cobol";		/**/
	area_info_area.areap = temp_ptr (1);		/**/
	area_info_area.size = sys_info$max_seg_size;	/**/
						/**/
	string (area_info_area.control) = "10001"b;	/**/
						/**/
	call define_area_ (area_infop, code);		/**/
						/**/
	if code ^= 0
	then return;				/**/
						/**/
	cobol_area_ptr = temp_ptr (1);		/**/
	c_name.last_name_ptr = null ();		/**/
	c_name.ct = 0;

     end;

/**/

finis:
     proc;

/**/
/**/
	if area_info_area.areap ^= null ()
	then call release_area_ (area_info_area.areap);	/**/
						/**/
	call release_temp_segments_ ("cobol", temp_ptr, code);

     end;

/* [3.0-9] */

f_mess:
     proc;

/*[4.4-6]*/
	call ioa_ (M3);

/*[4.4-6]*/
	call ioa_ ("cobol: " /*[4.4-6]*/
	     || /*[4.4-6]*/ "Compilation will take place using the source program [pd]>" /*[4.4-6]*/
	     || /*[4.4-6]*/ substr (ename, 1, len) /*[4.4-6]*/ || /*[4.4-6]*/ ".ex.cobol" /*[4.4-6]*/);

     end;

declare	DIRECTORY		fixed bin (2) static internal options (constant) init (2);

declare	1 stat		static,
	  2 (entry_ptr, save_m2fp, arg_ptr, p_ptr, e_ptr, tp_ptr, fd_ptr)
			ptr,
	  2 (tptr, rtbuff_ptr, save_sfp, format_sfp)
			ptr,
	  2 (cobol_area_ptr, source_name_ptr)
			ptr,
	  2 temp_ptr	(1) ptr,
	  2 (rb_pf, rb_pp, pb_pf, pb_pp, pe_pf, pe_pp)
			fixed bin,
	  2 (l_en, l_dn, linkoff, l, m, pc, i, MODE)
			fixed bin,
	  2 (ldp, ltp, len, fdlen, upto, en_len)
			fixed bin,
	  2 cc		fixed bin init (0),
	  2 (rb_tm, pb_tm, pe_tm)
			fixed bin (71),
	  2 (mcode, code)	fixed bin (35),
	  2 entry_type	fixed bin (2),
	  2 mem_size	fixed bin (31),
	  2 (fcom_ln, tln, rel)
			fixed bin (15),
	  2 BC		fixed bin (24),
	  2 recursion	bit (1) init ("0"b),
	  2 LEVSV		bit (3),
	  2 ST		bit (32),
	  2 (p_err, corr_sw, abort_sw, endlex_sw, gen_sw, endgen_sw, restart)
			bit (1),
	  2 (time, intact, expand, files_wd, temp_dir_sw)
			bit (1),
	  2 (repl_sw, ddsyn_sw, no_tbl_pres, tbl_pres, ecs)
			bit (1),
	  2 (lex_quit, comp_term)
			label,
	  2 answer	char (3) varying,
	  2 ename		char (32) aligned,
	  2 tpath		char (168) aligned,
	  2 fpath		char (168) init (""),
	  2 (tchar, COMP_LEVEL, ch1)
			char (1),
	  2 (segname, trace_arg, ln, en, en_1)
			char (32),
	  2 (pln, dn, dpath, pdpath, wdir)
			char (168),
	  2 arg		char (16),
	  2 errorcon	char (6),
	  2 tname		char (65),
	  2 fcom_key	char (5);


dcl	error_table_$noarg	fixed bin (35) ext static;
dcl	error_table_$badopt fixed bin (35) ext static;
dcl	error_table_$translation_failed
			fixed bin (35) ext static;
dcl	error_table_$not_act_fnc
			fixed bin (35) ext static;
dcl	error_table_$no_operation
			fixed bin (35) ext static;
dcl	error_table_$translation_aborted
			fixed bin (35) ext static;
dcl	error_table_$notadir
			fixed bin (35) ext static;
dcl	sys_info$max_seg_size
			fixed bin (35) ext static;

	/***.....	dcl Trace_Bit bit(1) static external;/**/
	/***.....	dcl Trace_Lev fixed bin static external;/**/
	/***.....	dcl Trace_Line char(60) static external;/**/
	/***.....   dcl ioa_$nnl entry options(variable);/**/

dcl	1 trace		static,
	  2 on		bit (1) init ("0"b),
	  2 id		bit (1) init ("0"b),
	  2 dd		bit (1) init ("0"b),
	  2 pd		bit (1) init ("0"b),
	  2 db		bit (1) init ("0"b),	/*[4.0-3]*/
	  2 rw		bit (1) init ("0"b);	/*[4.4-3]*/

dcl	01 ecs_info_table	automatic structure like ecs_info_table_;
dcl	1 area_info_area	aligned automatic structure like area_info;

dcl	1 common		static,			/* initial values of fixed_common */
	  2 prog_name	char (30) init (""),
	  2 compiler_rev_no char (25) init (""),
	  2 phase_name	char (6) init (""),
	  2 currency	char (1) init ("$"),
	  2 fatal_no	fixed bin (15) init (0),
	  2 warn_no	fixed bin (15) init (0),
	  2 proc_counter	fixed bin (15) init (0),
	  2 spec_tag_counter
			fixed bin (15) init (0),
	  2 file_count	fixed bin (7) init (0),
	  2 filedescr_offsets
			(20) char (5) init ((20) (5)"0"),
	  2 perf_alter_info char (5) init ("00000"),
	  2 another_perform_info
			char (5) init ("00000"),
	  2 sort_in_info	char (5) init ("00000"),
	  2 odo_info	char (5) init ("00000"),
	  2 size_seg	fixed bin (15) init (0),
	  2 size_offset	fixed bin (31) init (0),
	  2 size_perform_info
			char (5) init ("00000"),
	  2 rename_info	char (5) init ("00000"),
	  2 report_names	char (5) init ("00000"),
	  2 rw_buf_seg	fixed bin (15) init (0),
	  2 rw_buf_offset	fixed bin (31) init (0),
	  2 rw_buf_length	fixed bin (31) init (0),
	  2 file_keys	char (5) init ("00000"),
	  2 search_keys	char (5) init ("00000"),
	  2 dd_seg_size	fixed bin (31) init (65536),
	  2 pd_seg_size	fixed bin (31) init (0),
	  2 seg_limit	fixed bin (7) init (49),
	  2 number_of_dd_segs
			fixed bin (15) init (0),
	  2 seg_info	char (5) init ("00000"),
	  2 number_of_ls_pointers
			fixed bin (15) init (0),
	  2 link_sec_seg	fixed bin (15) init (0),
	  2 link_sec_offset fixed bin (31) init (0),
	  2 sra_clauses	fixed bin (15) init (0),
	  2 fix_up_info	char (5) init ("00000"),
	  2 linage_info	char (5) init ("00000"),
	  2 first_dd_item	char (5) init ("00000"),
	  2 sort_out_info	char (5) init ("00000"),
	  2 db_info	char (5) init ("00000"),
	  2 realm_info	char (5) init ("00000"),
	  2 rc_realm_info	char (5) init ("00000"),
	  2 last_file_key	char (5) init ("00000"),
	  2 prog_coll_seq	fixed bin (15) init (0),
	  2 sysin_fno	fixed bin (15) init (0),
	  2 sysout_fno	fixed bin (15) init (0),
	  2 dummy11	fixed bin (15) init (0),
	  2 dummy12	fixed bin (15) init (0),
	  2 dummy13	fixed bin (15) init (0),
	  2 dummy14	fixed bin (15) init (0),
	  2 dummy15	fixed bin (15) init (0),
	  2 opts,
	    3 cu		bit (1) unaligned,		/* produce a cu*/
	    3 pst		bit (1) unaligned,		/* produce a symbol table */
	    3 wn		bit (1) unaligned,		/* list warnings in listing*/
	    3 obs		bit (1) unaligned,		/* list observations in listing */
	    3 dm		bit (1) unaligned,		/* NA produce a data map*/
	    3 xrl		bit (1) unaligned,		/* NA list cross reference by line number*/
	    3 xrn		bit (1) unaligned,		/* list cross references by data name*/
	    3 src		bit (1) unaligned,		/* NA list original source */
	    3 obj		bit (1) unaligned,		/* list object code */
	    3 exs		bit (1) unaligned,		/* list expanded source*/
	    3 sck		bit (1) unaligned,		/* NA sequence check the source*/
	    3 rno		bit (1) unaligned,		/*NA renumber the output source*/
	    3 u_l		bit (1) unaligned,		/* convert lower case to upper case (1) or
				   convert upper case to lower case (0).
				   Only meaningful if cnv = 1. */
	    3 cnv		bit (1) unaligned,		/* do concobol_version specified in u_l. */
	    3 cos		bit (1) unaligned,		/* NA compile optional source statements */
	    3 fmt		bit (1) unaligned,		/* accept pseudo-free-form source */
	    3 profile	bit (1) unaligned,
	    3 nw		bit (1) unaligned,		/* observations and warnings not printed on output listing*/
						/*06-30-77*/
	    3 exp		bit (1) unaligned,		/* option to call cobol_expand_source_ */
	    3 card	bit (1) unaligned,		/*[4.1-1]*/
	    3 fil2	bit (5) unaligned,
	    3 m_map	bit (1) unaligned,		/* Produce a procedure division map*/
	    3 m_bf	bit (1) unaligned,		/* print brief diags on terminal */
	    3 m_fat	bit (1) unaligned,		/* print fatal diags on terminal */
	    3 m_wn	bit (1) unaligned,		/* print warnings on terminal */
	    3 m_obs	bit (1) unaligned,		/* print observations on terminal*/
	    3 pd		bit (1) unaligned,		/* print diags on terminal */
	    3 oc		bit (1) unaligned,		/* generate code for object time checking*/
	  2 supervisor	bit (1) init ("0"b),
	  2 dec_comma	bit (1) init ("0"b),
	  2 init_cd	bit (1) init ("0"b),
	  2 corr		bit (1) init ("0"b),
	  2 initl		bit (1) init ("0"b),
	  2 debug		bit (1) init ("0"b),
	  2 report	bit (1) init ("0"b),
	  2 sync_in_prog	bit (1) init ("0"b),
	  2 pd_section	bit (1) init ("0"b),
	  2 list_switch	bit (1) init ("1"b),
	  2 alpha_cond	bit (1) init ("0"b),
	  2 num_cond	bit (1) init ("0"b),
	  2 spec_sysin	bit (1) init ("0"b),
	  2 spec_sysout	bit (1) init ("0"b),
	  2 dummy16	bit (1) init ("0"b),
	  2 obj_dec_comma	bit (1) init ("0"b),
	  2 default_sign_type
			bit (3) init ("001"b),	/* trailing overpunch */
	  2 default_display bit (1) init ("0"b),
	  2 syntax_trace	bit (1) init ("0"b),
	  2 dummy17_1	bit (17) init (""b),
	  2 descriptor	bit (2) init ("10"b),
	  2 levsv		bit (3) init ("001"b),	/*[4.0-1]*/
	  2 dummy17	bit (5) init (""b),
	  2 lvl_rstr	bit (32) init (""b),
	  2 inst_rstr	bit (32) init (""b),
	  2 comp_level	char (1) init ("5"),
	  2 dummy18	char (30) init (""),
	  2 object_sign	char (1) init (""),
	  2 last_print_rec	char (5) init ("00000"),
	  2 coll_seq_info	char (5) init ("00000"),
	  2 sys_status_seg	fixed bin (15) init (0),
	  2 sys_status_offset
			fixed bin (31) init (0),
	  2 compiler_id	fixed bin (15) init (3),
	  2 date_comp_ln	fixed bin (15) init (0),
	  2 compile_mode	bit (36) init ("0"b),
	  2 default_temp	fixed bin (15) init (30),
	  2 dummy26	fixed bin (15) init (0),
	  2 display_device	fixed bin (15) init (0),
	  2 dummy28	fixed bin (15) init (0),
	  2 alphabet_offset fixed bin init (0);

declare	1 MESS		static,
	  2 M1		char (77)
			init ("cobol: The -fmt option is assumed since the file is apparently in free format"),
	  2 M2		char (60) init ("cobol: The -card option is inconsistant with the -fmt option"),
	  2 M3		char (102)
			init (
			"cobol: A run time symbol table was requested and one of the options -expand, -format or -card was used"
			),
	  2 M4		char (111)
			init (
			"cobol: The -exp option may not be used if the entry name of the source program ends in "".ex.cobol"""
			);

dcl	1 c_name		static,			/*[3.0-9]*/
	  2 ct		fixed bin,		/*[3.0-9]*/
	  2 size		fixed bin,		/*[3.0-9]*/
	  2 last_name_ptr	ptr,
	  2 pname		char (168) aligned,
	  2 uid		bit (36),
	  2 dtm		bit (36);

dcl	1 query_info	aligned static,
	  2 cobol_version	fixed bin init (2),
	  2 yes_or_no_sw	bit (1) unal init ("1"b),
	  2 suppress_name_sw
			bit (1) unal init ("0"b),
	  2 status_code	fixed bin (35) init (0),
	  2 query_code	fixed bin (35) init (0);

dcl	01 anarea		based (rtbuff_ptr) aligned,
	  02 dummy_ptr	ptr,
	  02 rtarea	char (82000);


dcl	argb		char (l) based (arg_ptr);
dcl	tpb		char (ltp) based (tp_ptr);	/* path name of source program (minus .cobol */
dcl	dpb		char (ldp) based (p_ptr);	/* path name of directory of source program */
dcl	enb		char (len) based (e_ptr);	/* name of object program */
dcl	first_source_line	char (32) based (cobol_sfp);	/*[5.1-3]*/
dcl	include_ptr	(0:1000) ptr based (cobol_$include_info_ptr);

/* [3.0-9] */
dcl	words		(alloc_size) fixed bin (35) based;
						/* [3.0-9] */
dcl	cobol_area	area based (cobol_area_ptr);
dcl	lname		char (len + 5) based (addr (ln));


dcl	1 source_name	based (source_name_ptr),	/* [3.0-9] */
	  2 prev_name_ptr	ptr,
	  2 sname		char (168) aligned,
	  2 uid		bit (36),
	  2 dtm		bit (36);

declare	fdir		char (fdlen) based (fd_ptr);	/* pathname or dir containing work files */


declare	(command_abort, command_abort_, cleanup)
			condition;		/* [3.0-4] */

/*[5.1-2]*/
declare	cobol$define_data	entry;

dcl	expand_cobol_source$expand
			entry (ptr, fixed bin (35));
dcl	hcs_$fs_get_path_name
			entry (ptr, char (*), fixed bin, char (*), fixed bin (35));
declare	hcs_$status_long	entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35));
						/* [3.0-6] */
declare	delete_$path	entry (char (*), char (*), bit (6), char (*), fixed bin (35));
						/* [3.0-5] */

dcl	(size, divide, index, mod, null, pointer, string, substr, addr)
			builtin;

dcl	cobol$restart	ext entry;
dcl	cobol_control_$cancel
			ext entry (char (*), fixed bin, fixed bin, fixed bin (35));
dcl	cobol_version$print entry;
dcl	cobol_make_link_$type_4
			entry (fixed bin, char (*));
dcl	cobol_version$set	entry;
dcl	cu_$cl		ext entry;
dcl	cobol_lex		ext entry (char (*));
dcl	cobol_repl3	ext entry (fixed bin (31), ptr);
dcl	cobol_print_diag	entry;

dcl	(cobol_pdstax, cobol_ddsyntax, cobol_ddalloc, cobol_idedsyn, cobol_ci_phase, cobol_db_phase, cobol_gen_driver_,
	cobol_fix_driver_, cobol_make_xref_)
			ext entry;


dcl	(cobol_generator, cobol_fixup)
			ext entry;
dcl	cobol_source_formatter_
			entry (ptr, ptr, fixed bin (15), fixed bin, fixed bin);
dcl	cobol_init_	ext entry (char (168), ptr);
dcl	cobol_init_$segs	ext entry (fixed bin (35), char (168) aligned);
						/* [3.0-2] */
dcl	condition_	entry (char (*), entry);
dcl	get_pdir_		entry returns (char (168) aligned);
dcl	get_wdir_		entry returns (char (168) aligned);

/*[4.4-8]*/
declare	hcs_$set_bc	entry (char (*), char (*), fixed bin (24), fixed bin (35));

dcl	hcs_$delentry_file	entry (char (*), char (*), fixed bin (35));
dcl	hcs_$truncate_file	entry (char (*), char (*), fixed bin, fixed bin (35));
dcl	hcs_$truncate_seg	entry (ptr, fixed bin, fixed bin (35));
dcl	hcs_$terminate_file entry (char (*), char (*), fixed bin (1), fixed bin (35));
dcl	hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35));
dcl	revert_cleanup_proc_
			entry;
dcl	establish_cleanup_proc_
			entry (entry);
dcl	hcs_$make_seg	entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl	hcs_$initiate	entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl	com_err_		entry options (variable);
dcl	hcs_$get_usage_values
			ext entry (fixed bin, fixed bin (71), fixed bin);
dcl	ioa_		entry options (variable);
dcl	ioa_$ioa_stream	entry options (variable);
dcl	cu_$arg_count	entry (fixed bin);
dcl	cu_$af_arg_count	entry (fixed bin, fixed bin (35));
dcl	cu_$arg_ptr	entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl	cobol_syntax_trace_$initialize
			entry (ptr);
dcl	cobol_syntax_trace_$reset_trace
			entry;
dcl	cobol_gns$set_table entry;


dcl	command_query_	entry options (variable);

dcl	cobol_cselfle	entry (bit (32), ptr, char (*), char (3), fixed bin (15), char (1), bit (8)) ext;
dcl	(cobol_swf, cobol_vdwf)
			entry (ptr, char (*)) ext;
dcl	cobol_vdwf_open	entry (ptr, bit (32)) ext;
dcl	(cobol_vdwf_dget, cobol_vdwf_sput)
			entry (ptr, bit (32), ptr, fixed bin (15), char (5));
dcl	cobol_swf_open	entry (ptr, bit (32), ptr, fixed bin (15), char (2)) ext;
dcl	(cobol_swf_close, cobol_vdwf_close)
			entry (ptr, bit (32), ptr, fixed bin (15)) ext;

declare	cobol_merge$source_file_size
			entry (fixed bin (24));

/* [3.0-9] */
dcl	get_temp_segments_	entry (char (*), (*) ptr, fixed bin (35));
						/* [3.0-9] */
dcl	release_temp_segments_
			entry (char (*), (*) ptr, fixed bin (35));
						/* [3.0-9] */
dcl	define_area_	entry (ptr, fixed bin (35));	/* [3.0-9] */
dcl	release_area_	entry (ptr);


dcl	expand_pathname_	entry (char (*), char (*), char (*), fixed bin (35)),
	absolute_pathname_	entry (char (*), char (*), fixed bin (35)),
	hcs_$status_minf	entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)),
	expand_pathname_$add_suffix
			entry (char (*), char (*), char (*), char (*), fixed bin (35));


%include cobol_;
%include cobol_fixed_common;
%include cobol_ext_;
%include cobol_fsb;
%include iocb;
%include cobol_ecs_info;
/* [3.0-8] */

/*[4.4-7]*/
declare	1 branch_status	aligned like status_branch;

%include status_structures;

%include area_info;
/* [3.0-9] */

declare	1 cond_info	static,
%include cond_info;
     end cobol;




		    cobol_IVAL.pl1                  05/24/89  1044.4rew 05/24/89  0833.1       78930



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_IVAL.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 08/24/76 by GM to fix problem with call to b_to_d in cobol_ddalloc. */
/* format: style3 */
cobol_IVAL:
     proc (dn_ptr);

declare	(mod, unspec, substr, addr, fixed)
			builtin;
dcl	name_ptr		ptr;
dcl	temp_val		fixed bin (15);

/*	This procedure  initializes a value  into a field
  described by the type 9 token.
*/

dcl	spaces		char (256);


	spaces = " ";
	tempptr = addr (temp);
	hg_ptr1 = null ();
	hg_field2 = 0;

/* process data name with valuse only */
	do while (data_name.type = 9 & initial_ptr ^= 0);

	     if data_name.numeric
	     then do;				/* code NUMERIC data extention. */
		     valueptr = addr (dn (initial_ptr));/* points to the numeric data extension */
		     if ascii_packed_dec_h
		     then return;			/* NOT CODED YET */
		     else if ascii_packed_dec
		     then return;			/* NOT CODED YET */
		     else if bin_16 | bin_18
		     then do;			/* comp-1 or comp-7 */
			     hg_field3 = 2;
			     hg_field4 = 3;
			     goto true_fixbin;
			end;
		     else if bin_32 | bin_36
		     then do;			/* comp-2 or comp-6 */
			     hg_field4 = 1;
			     hg_field3 = 4;
true_fixbin:
			     if numinit.figcon
			     then if numinit.sign = "-"
				then hg_field1 = hg_field2;
				else hg_field1 = 0;
			     else hg_field1 = cobol_ddalloc$b_to_d ((numinit.length), addr (numinit.literal));
			     hg_ptr1 = addr (hg_field1);
			     lnval = data_name.item_length;
			     value = substr (hg_field5, hg_field4, hg_field3);
			     goto CP;
			end;
		     if numinit.figcon = "1"b
		     then do;			/* 0 = only legal numeric figcon value */
			     numinit.length = 1;	/* make the input initial value extension */
			     numinit.literal = "0";	/* look like a valid figcon zero initial value */
			     numinit.ltdp = 1;
			     numinit.sign = " ";
			end;
		     work = numinit.literal;
		     substr (work, numinit.length + 1) = zeros;
		     if ebcdic_packed_dec
		     then do;			/*[comp3rtn:]*/
			     d_ptr = addr (substr (comp3init, 16, 1));
			     m = 18 + numinit.ltdp + data_name.places_right;
			     n = m - (data_name.places_left + data_name.places_right);
			     workptr = addr (substr (temp1, m, 1));
			     if numinit.sign = "-"
			     then substr (initchar, VC_5, 4) = "1101"b;
			     else substr (initchar, VC_1, 4) = "1011"b;
			     substr (initchar, VC_1, 4) = substr (lit_char, VC_5, 4);
			     i = 1;
loop_comp3init:
			     m = m - 1;
			     if m = n
			     then goto end_init;
			     workptr = addr (substr (temp1, m, 1));
			     d_ptr = addr (substr (temp1, m, 1));
			     initchar = "00000000"b;
			     substr (initchar, VC_5, 4) = substr (lit_char, VC_5, 4);
			     m = m - 1;
			     if m = n
			     then goto end_init;
			     workptr = addr (substr (temp1, m, 1));
			     substr (initchar, VC_1, 4) = substr (lit_char, VC_5, 4);
			     i = i + 1;
			     goto loop_comp3init;
end_init:
			     lnval = data_name.item_length;
			     value = substr (comp3init, 17 - data_name.item_length, data_name.item_length);
			     goto CP;
			end;
		     signptr =
			addr (substr (temp1, 18 + numinit.ltdp - data_name.places_left + data_name.item_length, 1));
		     lnval = data_name.item_length;
		     if item_signed
		     then value = numinit.sign || substr (temp1, 19 + numinit.ltdp - data_name.places_left, lnval);
		     else value = substr (temp1, 19 + numinit.ltdp - data_name.places_left, lnval);
CP:
		     numrep = 1;
		     temp_val = data_name.seg_num - 1;
		     res = substr (unspec (temp_val), 29, 8);
						/* enter seg no. as a sort key for finishrtn */
		     reladdinseg = substr (unspec (data_name.offset), 13, 24);
						/* enter offset of this value */

		     call st_val;
		     return;

		end;

aninitrtn:
	     valueptr = addr (dn (initial_ptr));	/* points to the non-numeric data extension. */
	     if alphainit.length > data_name.item_length
	     then alphainit.length = data_name.item_length;
	     if alphainit.figcon = "1"b
	     then do;				/*[figconrtn:]*/
		     alphainit.length = 1;		/* input contents for figcons is BAD. */
		     alphainit.string = figcon (fixed (figconindex, 7));
						/* set CORRECT value. */
		     goto allrtn;
		end;
	     else if alphainit.allit = "1"b
	     then do;
allrtn:
		     lnval = alphainit.length;	/* set length of value */
		     value = alphainit.string;	/* move data into initial value area */
		     numrep = divide (data_name.item_length, alphainit.length, 15, 0);
		     temp_val = data_name.seg_num - 1;
		     res = substr (unspec (temp_val), 29, 8);
						/* enter seg no. as a sort key for finishrtn */
		     reladdinseg = substr (unspec (data_name.offset), 13, 24);

		     call st_val;

		     lnval = mod (data_name.item_length, alphainit.length);
		     if lnval = 0
		     then return;			/* does it fit? */
		     numrep = 1;
		     temp_val = data_name.offset + data_name.item_length - lnval;
		     reladdinseg = substr (unspec (temp_val), 13, 24);

		     return;
		end;

	     lnval = alphainit.length;
	     value = alphainit.string;

	     temp_val = data_name.seg_num - 1;
	     res = substr (unspec (temp_val), 29, 8);
	     reladdinseg = substr (unspec (data_name.offset), 13, 24);
CP1:
	     if alphainit.length = data_name.item_length
	     then ;				/* fall through if space fill required */
	     else do;				/* make length = 1, and no of repetitions = no of spaces reqd */
		     lnval = data_name.item_length;
		     substr (value, 1, lnval) = spaces;
		     substr (value, 1, alphainit.length) = alphainit.string;
		     temp_val = data_name.seg_num - 1;
		     res = substr (unspec (temp_val), 29, 8);
		     temp_val = data_name.offset + alphainit.length;
		     reladdinseg = substr (unspec (temp_val), 13, 24);

		end;

	     call st_val;

	     return;
	end;					/* no type 9 */
	if data_name.level = 01 | data_name.level = 77
	then do;
		parea.lnval = data_name.item_length;
		call st_val;
	     end;

	return;					/* ======STORE VALUE============================== */

st_val:
     proc;

dcl	s		char (262144) aligned based (text_base_ptr),
	j		fixed bin,
	dummy		bit (36) based (addr (j)),
	p_ptr		ptr;


	substr (dummy, 19, 18) = rel (con_end_ptr);	/* mark the end of the text segment */
	j = j * 4;
	if data_name.level ^= 01 & data_name.level ^= 77
	then do;
		if data_name.offset > 0
		then do;
			substr (s, j - ((con_wd_off - 1) * 4) + 1 + data_name.offset, lnval) = value;
			target_ptr = addr (substr (s, j - ((con_wd_off - 1) * 4) + 1 + data_name.offset, lnval));
		     end;
		else do;
			substr (s, j - ((con_wd_off - 1) * 4) + 1, lnval) = value;
			target_ptr = addr (substr (s, j - ((con_wd_off - 1) * 4) + 1, lnval));
		     end;
		if data_name.ascii_packed_dec = "1"b
		     | (data_name.display = "1"b & data_name.item_signed = "1"b & data_name.sign_separate = "0"b)
		then call cobol_opch_is (dn_ptr, target_ptr);

		return;
	     end;
	temp_val = parea.lnval;
	if substr (unspec (temp_val), 35, 2) ^= "00"b
	then con_wd_off = con_wd_off + 1;
	con_wd_off = con_wd_off + (fixed (substr (unspec (temp_val), 1, 34), 36));
						/* set initial value in TEXT segment */
	if initial_ptr ^= 0
	then substr (s, j - ((con_wd_off - 1) * 4) + 1, lnval) = value;
	if data_name.ascii_packed_dec = "1"b
	     | (data_name.display = "1"b & data_name.item_signed = "1"b & data_name.sign_separate = "0"b)
	then do;
		target_ptr = addr (substr (s, j - ((con_wd_off - 1) * 4) + 1, lnval));
		call cobol_opch_is (dn_ptr, target_ptr);
	     end;
dcl	target_ptr	ptr;
dcl	cobol_opch_is	entry (ptr, ptr) ext;

	return;

     end st_val;

/* ======END STORE VALUE ===================== */

dcl	cobol_ddalloc$b_to_d
			entry (fixed bin (15), ptr) returns (fixed bin (31));

%include cobol_IVAL;
%include cobol_type9;
%include cobol_ext_nonnum;
%include cobol_ext_num;
%include cobol_;
     end cobol_IVAL;




		    cobol_allo_tm.pl1               05/24/89  1044.4rew 05/24/89  0833.1       41040



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_allo_tm.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* format: style3 */
%;
/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

/* 4/19/77, FCH, P7 exorcised */

cobol_allo_tm:
     proc (r_ptr, in_sz);

dcl	(in_sz, pi)	fixed bin (15);
dcl	(sz, szt)		fixed bin (15) static;
dcl	t_ptr		ptr static;
dcl	aptr		(10) ptr static;
dcl	asz		fixed bin (18) static;
dcl	(p_sw, ci)	fixed bin (15) static;
dcl	1 slot		based (cfa_ptr),
	  2 nfa_ptr	ptr,
	  2 na_ptr	ptr,
	  2 sz		fixed bin (17),
	  2 st		char (1);
dcl	(lfa_ptr, r_ptr)	ptr;
dcl	cfa_ptr		ptr static;

dcl	ioa_		entry options (variable);

declare	(divide, mod, null, addrel)
			builtin;


	if cobol_allo_init_sw = "1"b
	then do;
		cobol_allo_init_sw = "0"b;
		aptr (1) = cobol_$allo1_ptr;
		pi = 1;
		asz = cobol_$allo1_max;
		ci = 1;
		cfa_ptr = aptr (pi);
		slot.nfa_ptr = addrel (cfa_ptr, 2);
		cfa_ptr = slot.nfa_ptr;
		slot.na_ptr = null ();
		slot.nfa_ptr = null ();
		slot.sz = asz - 8;
		slot.st = "0";
	     end;
	sz = in_sz + 24;
	szt = mod (sz, 8);
	if szt ^= 0
	then sz = sz + 8 - szt;
	if sz <= 0
	then do;
		call ioa_ ("cobol-allo_tm: Item size is zero or negative.");
		go to cobol_lex_exit;
	     end;
	p_sw = 0;
	pi = 1;
recheck:
	cfa_ptr = aptr (ci);
	lfa_ptr = cfa_ptr;
next_slot:
	cfa_ptr = slot.nfa_ptr;
	if cfa_ptr = null ()
	then goto purge;
	if slot.sz >= sz
	then do;
		slot.st = "1";
		if slot.sz <= sz + 24
		then do;
			lfa_ptr -> slot.nfa_ptr = slot.nfa_ptr;
			r_ptr = addrel (cfa_ptr, 6);
			return;
		     end;
		t_ptr = addrel (cfa_ptr, divide (sz, 4, 17, 0));
		lfa_ptr -> slot.nfa_ptr = t_ptr;
		t_ptr -> slot.na_ptr = slot.na_ptr;
		t_ptr -> slot.nfa_ptr = slot.nfa_ptr;
		t_ptr -> slot.sz = slot.sz - sz;
		t_ptr -> slot.st = "0";
		slot.na_ptr = t_ptr;
		slot.sz = sz;
		r_ptr = addrel (cfa_ptr, 6);
		return;
	     end;
	lfa_ptr = cfa_ptr;
	goto next_slot;

purge:
	if p_sw = 1
	then do;
		p_sw = 0;
		pi = pi + 1;
		if pi > 10
		then do;
			call ioa_ ("cobol-allo_tm: Input size is too large for remaining allocatable areas.");
			go to cobol_lex_exit;
		     end;
		ci = pi;
	     end;

/* combine all freed up slots into allocatable slots in the current area */

	else p_sw = 1;
	lfa_ptr = aptr (ci);
	cfa_ptr = addrel (lfa_ptr, 2);
next_slot_p:
	if cfa_ptr = null ()
	then goto recheck;
	if slot.st = "1"
	then /* if allocated slot... */
	     do;
		cfa_ptr = slot.na_ptr;
		goto next_slot_p;
	     end;
	if slot.st = "2"
	then /* if freeable slot... */
	     do;
		slot.st = "0";
		slot.nfa_ptr = lfa_ptr -> slot.nfa_ptr;
		lfa_ptr -> slot.nfa_ptr = cfa_ptr;
next_slot_p3:
		lfa_ptr = cfa_ptr;
next_slot_p2:
		t_ptr = slot.na_ptr;
		if t_ptr = null ()
		then goto recheck;
		if t_ptr -> slot.st = "1"
		then do;
			cfa_ptr = t_ptr -> slot.na_ptr;
			goto next_slot_p;
		     end;
		slot.na_ptr = t_ptr -> slot.na_ptr;
		slot.sz = slot.sz + t_ptr -> slot.sz;
		if t_ptr -> slot.st = "0"
		then slot.nfa_ptr = t_ptr -> slot.nfa_ptr;
		goto next_slot_p2;
	     end;
	goto next_slot_p3;				/* unused slot */



free_tm:
     entry (r_ptr);

	cfa_ptr = addrel (r_ptr, -6);
	slot.st = "2";
	r_ptr = null ();
	return;

free_all:
     entry;

	if cobol_allo_init_sw = "1"b
	then return;
	cfa_ptr = aptr (ci);
	slot.nfa_ptr = addrel (cfa_ptr, 2);
	cfa_ptr = slot.nfa_ptr;
	slot.na_ptr = null ();
	slot.nfa_ptr = null ();
	slot.sz = asz - 4;
	slot.st = "0";
	return;

%include cobol_;
%include cobol_ext_lex;

     end cobol_allo_tm;




		    cobol_c_list.pl1                05/24/89  1044.4rew 05/24/89  0833.1       47448



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_c_list.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 06/13/79 by MHD, [4.0-3] , check for leveling diagnostic first */
/* Modified on 04/28/79 by FCH, [4.0-2], if leveling then suppress sev 1 ,2 */
/* Modified on 04/25/79 by FCH, [4.0-1],  debug phase added */
/* Modified since Version 4.0 */

/* format: style3 */
cobol_c_list:
     proc (message_ptr);

dcl	(i, sv)		fixed bin;
dcl	diag_text_ptr	ptr;
dcl	diag_text		char (100000) based (diag_text_ptr);

dcl	1 last_message	static,
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin,
	  2 run		fixed bin init (0),
	  2 number	fixed bin,
	  2 info		bit (9),
	  2 module	bit (27),
	  2 image_size	fixed bin,
	  2 image		char (256);

dcl	phase_con		(10) char (13) static
			init ("lexical", "ID/ED syntax", "DD syntax", "RW syntax", "PD syntax", "replacement",
			"report writer", "corresponding",
						/*[4.0-1]*/
			"leveling",		/*[4.0-1]*/
			"debug");

dcl	signal_		entry (char (*), ptr, ptr);
dcl	cobol_swf_put	entry (ptr, bit (32), ptr, fixed bin);
dcl	st		bit (32);


/*************************************/
	if message_ptr ^= null ()
	then if message.type = 5
	     then do;

/******************************************************************************/
/*    Modified on 6/13/79 by MHD.  This modification is to aid in the readibility */
/*  of this program.  The first check is checking if the diagonistic is a      */
/*  leveling diagnostic error.  If not then it checks the severity of the error */
/******************************************************************************/

/*[4.0-3]*/
		     if message.run = 9		/*[4.0-3]*/
		     then do;			/*[4.0-3]*/
			     call cobol_swf_put (cobol_ext_$cobol_dfp, st, message_ptr, message.size);
						/*[4.0-3]*/
			     if substr (fixed_common.levsv, 3, 1)
						/*[4.0-3]*/
						/*[4.0-3]*/
			     then fixed_common.fatal_no = fixed_common.fatal_no + 1;
						/*[4.0-3]*/
						/*[4.0-3]*/
			     else /* do nothing */
				;

/*[4.0-3]*/
			     return;
			end /* then do */;

		     i = diag_file.run_table.base (message.run) + message.number;

/*[4.0-2]*/
		     sv = diag_file.diag_table.d_type (i);
						/*[4.0-2]*/
		     if fixed_common.comp_level < "5"	/*[4.0-2]*/
		     then if sv = 1 | sv = 2
			then return;

		     if sv ^= 1
		     then do;

			     call cobol_swf_put (cobol_ext_$cobol_dfp, st, message_ptr, message.size);

			     if sv = 3
			     then do;
				     fixed_common.fatal_no = fixed_common.fatal_no + 1;
				end;
			     else if sv = 4
			     then do;

				     error_info.name = phase_con (message.run);
				     error_info.message_len = diag_file.diag_table.d_len (i);
				     diag_text_ptr = addr (diag_file.diag_table (diag_file.d_t_size + 1));
				     error_info.message = substr (diag_text, d_start (i), d_len (i));
				     message.run = 1;
				     message.number = 32;

/* Syntax checking discontinued good */

				     call cobol_swf_put (cobol_ext_$cobol_dfp, st, message_ptr, message.size);
				     call signal_ ("command_abort_", null (), addr (error_info));

				end;

			end;

		     else do;

			     if (message.run = 1 & message.number = 11) | (message.run = 2 & message.number = 104)
				| (message.run = 3 & message.number = 152)
				| (message.run = 5 & message.number = 164)
				| (message.run = 8 & message.number = 7)
			     then last_message = message;

			     else if (message.run = 1 & message.number = 12)
				| (message.run = 2 & message.number = 89)
				| (message.run = 3 & message.number = 154)
				| (message.run = 5 & message.number = 165)
				| (message.run = 8 & message.number = 8)
			     then if (message.line ^= last_message.line | message.column ^= last_message.column)
				     & last_message.run ^= 0
				then do;

					call cobol_swf_put (cobol_ext_$cobol_dfp, st, addr (last_message),
					     last_message.size);
					call cobol_swf_put (cobol_ext_$cobol_dfp, st, message_ptr, message.size)
					     ;

					last_message.run = 0;
				     end;

				else ;

			     else call cobol_swf_put (cobol_ext_$cobol_dfp, st, message_ptr, message.size);

			end;

		end;


/*************************************/
/* INCLUDE FILES */
%include cobol_error_info;
%include cobol_diag_file;
%include cobol_type5;
%include cobol_;
%include cobol_ext_;
%include cobol_fixed_common;

     end cobol_c_list;




		    cobol_ci_phase.pl1              05/24/89  1044.4rew 05/24/89  0833.1      538614



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_ci_phase.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 05/06/81 by FCH, [4.4-2], cobol_ciphase_data.incl.pl1 changed, BUG482(TR9781) */
/* Modified on 05/15/79 by FCH, [4.0-1], table size decreased */
/* Modified on 05/26/78 by FCH, [3.0-1], table size increased */
/* Modified since Version 3.0 */

/*{*/

/* format: style3 */
cobol_ci_phase:
     proc;

/*	This procedure scans rmin2 looking for initialize statements and statements
	containing the corresponding option. These statements are expanded and written
	into corrout							*/

/*}*/
/*[4.0-2]*/
dcl	size		builtin;			/*[4.0-2]*/
dcl	cobol$alloc	entry (fixed bin (35)) returns (ptr) ext;
						/*[4.0-2]*/
						/*[4.0-2]*/
	dir_ptr = cobol$alloc (size (dir_struct));

	infp = cobol_rmin2fp;
	outfp = cobol_x3fp;
	table1_2_size = 22000;			/*[4.0-1]*/
	on = "1"b;
	off = "0"b;
	eof = "0"b;
	dir_ptr1 = addr (dir1);
	dir_ptr2 = addr (dir2);
	initlz_tbl_ptr = addr (table1);
	input_ptr = null ();
	output_ptr = null ();
	gen_item_allocated = "0"b;
	initlz_items_allocated = "0"b;
	new_seg_bit = "0"b;
	poss_prior_err = "1"b;
	without_on_bit = "0"b;			/*  syntax  ON SIZE ERROR  witout  ON  */
	fixed_common.phase_name = "CORRES";
	err_num = 0;
	substr (err_image, 1, 1) = "*";

find_bos:
	if err_num ^= 0
	then do;
		go to err (err_num);

err (1):
		poss_prior_err = "0"b;
		go to err_end;

err (2):
		err_image = "identifier*";
		go to err_end;

err (3):
		err_image = "(*";
		go to err_end;

err (4):
		poss_prior_err = "0"b;
		go to err_end;

err (5):
		go to err_end;

err (6):
		go to err_end;

err (7):
		go to err_end;

err (8):
		go to err_end;

err (9):
		go to err_end;

err (10):
		err_image = "illegal level number*";
		poss_prior_err = "0"b;
		go to err_end;

err (11):
		go to err_end;

err (12):
		go to err_end;

err (13):
		poss_prior_err = "0"b;
		go to err_end;

err (14):
		go to err_end;

err (15):
		call err_pro;
		return;

err (16):
		poss_prior_err = "0"b;
		go to err_end;

err (17):
		poss_prior_err = "0"b;
		go to err_end;

err (18):
		poss_prior_err = "0"b;
		go to err_end;

err (19):
		poss_prior_err = "0"b;
		go to err_end;

err (20):
		poss_prior_err = "0"b;
		go to err_end;

err (21):
		poss_prior_err = "0"b;
		go to err_end;

err (22):
		err_image = "occurs depending on*";
		poss_prior_err = "0"b;
		go to err_end;

err (23):
		go to err_end;

err (24):
		go to err_end;

err (25):
		poss_prior_err = "0"b;
		go to err_end;

err (26):
		poss_prior_err = "0"b;
		go to err_end;

err (27):
		poss_prior_err = "0"b;
		go to err_end;

err (28):
		poss_prior_err = "0"b;
		go to err_end;

err (29):
		err_image = "numeric literal or identifier*";
		err_num = 2;
		poss_prior_err = "0"b;
		go to err_end;

err (30):
		err_image = "proper index name*";
		err_num = 2;
		poss_prior_err = "0"b;
		go to err_end;

err (31):
		err_image = """+"",""-"", numeric literal or indexname*";
		err_num = 2;
		go to err_end;

err (32):
		err_image = "numeric_literal*";
		err_num = 2;
		go to err_end;

err (33):
		err_image = "proper subscript*";
		err_num = 2;
		go to err_end;

err (34):
		err_image = "identifier, literal or proper figurative constant*";
		err_num = 2;
		go to err_end;

err (35):
		err_image = "from*";
		err_num = 3;
		go to err_end;

err (36):
		err_image = "to*";
		err_num = 3;
		go to err_end;

err (37):
		err_image = ")*";
		err_num = 3;
		go to err_end;

err (38):
		err_image = "data or by*";
		err_num = 3;
		go to err_end;

err (39):
		err_image = "by*";
		err_num = 3;
		go to err_end;

err (40):
		err_image = "usage is index*";
		err_num = 22;
		poss_prior_err = "0"b;
		go to err_end;
err (41):
		err_image = "usage is index*";
		err_num = 10;
		poss_prior_err = "0"b;
		go to err_end;
err (42):
		poss_prior_err = "0"b;
		err_num = 29;
		go to err_end;
err (43):
		poss_prior_err = "0"b;
		err_num = 30;
		go to err_end;
err_end:
		recov = "1"b;
		call err_pro;

		if eof
		then return;

		err_num = 0;

	     end;

	else do;

		curr_dim = 1;
		fixbin15 = 0;

		fixbin_diff = "0"b;			/** initialize for statement **/
		lk_ahd_index = 0;
		ose_exists = "0"b;
		recovering = "0"b;
		begin_i = 1;
		top_token_stack = 1;
		sending_op = "1"b;
		code = 1;
		next_free_column = 8;

		call corr_in;			/*read until beginning of a statment is recognized --
			    corr_in looks for add, subtract, or move verb */

		if eof
		then return;

		if initlz_swt
		then call initialize_statement;
		else do;

			call add_token;

			gen_ptr (1) = token_stack_ptr;
			end_i = 2;		/*skip 1 to store sending operand */
			code = 0;

			call corr_in;


			if eof
			then return;

			if reserved_word.type = 1 & reserved_word.key = 524
						/* corresponding */
			then do;
				if fixed_common.comp_level ^= "5" & fixed_common.comp_level < "3"
				then do;
					message.number = 19;
					message.line = reserved_word.line;
					message.column = reserved_word.column;
					message.size = 32;
					message.run = 9;

					call cobol_c_list (addr (message));

					message.run = 8;
				     end;
				recursive_bit = "0"b;
				call corres_option (0);
			     end;

			else do;

				output_ptr = token_stack_ptr;

				call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size);


				call remove_token;

				output_ptr = input_ptr;

				call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size);


				call corr_in;

				if eof
				then return;

			     end;

		     end;

	     end;

	go to find_bos;



corres_option:
     proc (mode);

declare	mode		fixed bin;

more:
	if mode = 0
	then do;

		nu_line = reserved_word.line;		/* add for numerot.line in output */
		first_pair = "1"b;

		call corr_in;

		if eof
		then do;
			err_num = 15;
			return;
		     end;

	     end;

	if data_name.type ^= 9			/* user word */
	then do;

		err_num = 2;
		return;
	     end;

	if data_name.elementary
	then do;
		err_num = 16;			/*MUST BE GROUP NAME*/
		return;
	     end;

	if data_name.level > 49 & data_name.level ^= 66	/* illegal level number */
	then do;
		err_num = 10;
		return;
	     end;

	if data_name.usage_index			/*USAGE IS INDEX*/
	then do;
		err_num = 41;
		return;
	     end;

	if data_name.subscripted			/*OCCURS*/
	then do;
		ptr1 = addr (any_item (data_name.occurs_ptr));
		orig_dimen = ptr1 -> occurs.dimensions;
	     end;
	else orig_dimen = 0;

	if sending_op
	then do;
		curr_tbl_ptr = addr (table1);		/* sending operand */
		curr_dir_ptr = addr (dir1);
		dir_num = 0;
	     end;
	else do;
		curr_tbl_ptr = addr (table2);		/* receiving operand */
		curr_dir_ptr = addr (dir2);
		dir_num = 1;
	     end;

	main_item_ptr = input_ptr;

	curr_dir_index = 0;
	curr_tbl_index = 1;
	curr_stk_index = 1;

	rdf_illegal = ^data_name.s_of_rdf;

get_next_group_member:
	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if data_name.type = 9
	then /* user word */
	     do;

		if data_name.filler_item | (rdf_illegal & data_name.s_of_rdf)
		     | (^move_swt & data_name.elementary & ^data_name.numeric) | data_name.usage_index
		then go to get_next_group_member;

		if data_name.subscripted
		then do;
			ptr1 = addr (any_item (data_name.occurs_ptr));

			if ptr1 -> occurs.dimensions > orig_dimen
			then go to get_next_group_member;
		     end;

		if curr_dir_index = 512		/*[4.0-2]*/
		then do;
			err_num = 21;
			return;
		     end;

		curr_dir_index = curr_dir_index + 1;

		tbl_item_ptr = addr (curr_table (curr_tbl_index));
		substr (tbl_item_ptr -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize);
		curr_dir.tbl (curr_dir_index) = curr_tbl_index;
		curr_dir.dir (curr_dir_index) = 0;
		curr_level = data_name.level;

/*[4.0-2]*/
		if curr_tbl_index + recsize + mod (-recsize, 4) > 100000
						/*  */
		then do;
			err_num = 19;
			return;
		     end;

		curr_tbl_index = curr_tbl_index + recsize + mod (-recsize, 4);

		if curr_dir_index = 1
		then do;
			stack.level (1) = curr_level;
			stack.stk_to_dir (1) = 1;

		     end;

		else if curr_level > stack.level (curr_stk_index)
		then do;

			if curr_stk_index = 10
			then do;
				err_num = 20;
				return;
			     end;
			curr_stk_index = curr_stk_index + 1;
			stack.stk_to_dir (curr_stk_index) = curr_dir_index;
			stack.level (curr_stk_index) = curr_level;

		     end;

		else do;
			call set_links;

			if err_num ^= 0
			then return;

		     end;


		go to get_next_group_member;

	     end;



	if curr_stk_index > 1
	then do;
		curr_level = stack.level (1);
		curr_dir_index = curr_dir_index + 1;

		curr_dir.tbl (curr_dir_index) = 0;
		curr_dir.dir (curr_dir_index) = 0;

		call set_links;

		if err_num ^= 0
		then return;


		if dir_num = 0
		then curr_dir.dir (stack_loc) = 0;

	     end;

	if orig_dimen > 0
	then do;					/* subscripting required */

		call res_test (187, 3);
		if err_num ^= 0
		then return;

		call begin_subscripts;

		if err_num ^= 0
		then return;

		call corr_in;

		if eof
		then do;
			err_num = 15;
			return;
		     end;

	     end;
	if reserved_word.type ^= 26
	then do;
		err_num = 11;
		return;
	     end;

	if ^sending_op
	then do;
		call check_for_further;

		if err_num ^= 0
		then return;

		if check_res = 0
		then return;

		go to get_next_group_member;

	     end;

	end_dir1_index = curr_dir_index;

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if subtract_swt
	then do;
		call res_test (111, 35);
		if err_num ^= 0
		then return;
	     end;

	else do;
		call res_test (170, 36);
		if err_num ^= 0
		then return;
	     end;



	call add_token;

	end_i = end_i + 1;
	gen_ptr (end_i) = token_stack_ptr;
	end_i = end_i + 1;
	recv_i = end_i;
	sending_op = "0"b;
	mode = 0;

	go to more;

     end;

res_test:
     proc (resnum, errnum);

declare	(resnum, errnum)	fixed bin;

	if reserved_word.type ^= 1
	then do;
		err_num = errnum;
		return;
	     end;

	if reserved_word.key ^= resnum
	then do;
		err_num = errnum;
		return;
	     end;

	err_num = 0;
     end;

set_links:
     proc;

	do while (curr_level < stack.level (curr_stk_index));

	     curr_dir.dir (stack.stk_to_dir (curr_stk_index)) = stack.stk_to_dir (curr_stk_index - 1);
	     curr_stk_index = curr_stk_index - 1;

	end;

	if curr_level = stack.level (curr_stk_index)
	then do;
		stack_loc = stack.stk_to_dir (curr_stk_index);
		curr_dir.dir (stack_loc) = curr_dir_index;
		stack.stk_to_dir (curr_stk_index) = curr_dir_index;
		stack.level (curr_stk_index) = curr_level;
	     end;
	else do;
		err_num = 13;
		err_image = "sending*";
		return;
	     end;
     end;

begin_subscripts:
     proc;

	indexname_subscr_sw = "0"b;
	dataname_subscr_sw = "0"b;

	call add_token;				/*leftparen*/

	if ^initlz_swt
	then do;
		end_i = end_i + 1;
		gen_ptr (end_i) = token_stack_ptr;
	     end;
	else subscr_directory.tokn_ptr (subscr_dir_index) = token_stack_ptr;

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	subscr_cnt = 0;

pick_up_subscr:
	if numeric_lit.type = 2
	then do;

		if numeric_lit.sign = "-"
		then do;
			err_num = 17;
			return;
		     end;

		subscr_cnt = subscr_cnt + 1;

add_subscript:
		call add_token;

		if ^initlz_swt
		then do;
			end_i = end_i + 1;
			gen_ptr (end_i) = token_stack_ptr;
		     end;

		call corr_in;

		if eof
		then do;
			err_num = 15;
			return;
		     end;

test_subscr_cnt:
		if reserved_word.type = 1 & reserved_word.key = 188
		then rparen = "1"b;
		else rparen = "0"b;

		if subscr_cnt = ptr1 -> occurs.dimensions
		then do;

test_rparen:
			if rparen
			then do;

				call add_token;

				if ^initlz_swt
				then do;
					end_i = end_i + 1;
					gen_ptr (end_i) = token_stack_ptr;
				     end;
				else do;

					call corr_in;

					if eof
					then err_num = 15;
				     end;
				return;
			     end;

			err_num = 37;
			return;
		     end;

		else do;
			if rparen
			then do;
				err_num = 42;
				return;
			     end;
			go to pick_up_subscr;
		     end;

	     end;




	if data_name.type = 9
	then do;

		if indexname_subscr_sw
		then do;
			err_num = 4;
			return;
		     end;
		else dataname_subscr_sw = "1"b;
	     end;

	else if index_name.type = 10
	then do;

		if ^(main_item_ptr -> data_name.indexed_by)
						/*INDEXING NOT ALLOWED*/
		then do;
			err_num = 2;
			return;
		     end;				/*test is this the right index name for this dimension*/

		if ptr1 -> occurs.level.indexedno (subscr_cnt + 1) ^= index_name.index_no
		then do;
			err_num = 28;
			return;
		     end;

		if dataname_subscr_sw
		then do;
			err_num = 4;
			return;
		     end;

		indexname_subscr_sw = "1"b;

		if initlz_swt
		then subscr_directory.index_ct (subscr_dir_index) = subscr_directory.index_ct (subscr_dir_index) + 1;

	     end;

	else do;
		err_num = 33;
		return;
	     end;

	subscr_cnt = subscr_cnt + 1;

	call add_token;

	if ^initlz_swt
	then do;
		token_stack_ptr -> index_name.searched = "0"b;
		token_stack_ptr -> index_name.duplicate = "0"b;
		end_i = end_i + 1;
		gen_ptr (end_i) = token_stack_ptr;
	     end;

/*	if ^initlz_swt then if ^sending_op then

		do while(reserved_word.type ^= 26);
		
			call corr_in;
	
			if eof then	do;	err_num = 15;
						return;
					end;
		
		end;	*/

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if dataname_subscr_sw
	then go to test_subscr_cnt;

	if reserved_word.type ^= 1
	then do;

		if subscr_cnt = ptr1 -> occurs.dimensions
		then do;
			err_num = 37;
			return;
		     end;
		go to pick_up_subscr;
	     end;

	if reserved_word.key ^= 182 /*+*/ & reserved_word.key ^= 183
						/*-*/
	then do;

		if subscr_cnt = ptr1 -> occurs.dimensions
		then do;
			if reserved_word.key = 188
			then rparen = "1"b;
			else rparen = "0"b;
			go to test_rparen;
		     end;

		err_num = 30;
		return;
	     end;

	if ^initlz_swt
	then do;

		call add_token;

		end_i = end_i + 1;
		gen_ptr (end_i) = token_stack_ptr;
	     end;

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if numeric_lit.type ^= 2
	then do;
		err_num = 32;
		return;
	     end;

	if input_ptr -> numeric_lit.sign ^= " "
	then do;
		err_num = 18;
		return;
	     end;
	go to add_subscript;

     end;

check_for_further:
     proc;

	check_res = 0;

/* look for rounded, on size error */

	if move_swt
	then do;
		call commence_search;
		return;
	     end;

	call corr_in;

	if eof
	then do;
		call commence_search;
		return;
	     end;

	if data_name.type = 9
	then do;
		recursive_bit = "1"b;
		check_res = 1;
		return;
	     end;					/*  on  ADD  or  SUBTRACT  */

	if reserved_word.type ^= 1
	then do;
		call commence_search;
		return;
	     end;


	if reserved_word.key = 156
	then do;					/*rounded*/

		call add_token;

		end_i = end_i + 1;
		gen_ptr (end_i) = token_stack_ptr;

		call corr_in;

		if eof
		then do;
			call commence_search;
			return;
		     end;

		if reserved_word.type ^= 1
		then do;
			call commence_search;
			return;
		     end;

	     end;

	if reserved_word.key ^= 134
	then do;					/*on*/
		without_on_bit = "1"b;
		xst = 1;
	     end;

	else do;

		call add_token;

		lk_ahd_index = 1;
		lk_ahd_ptr (1) = token_stack_ptr;

		call corr_in;

		if eof
		then do;
			call commence_search;
			return;
		     end;

		xst = 2;

		if reserved_word.type ^= 1
		then do;
			call commence_search;
			return;
		     end;

	     end;

	if reserved_word.key ^= 161
	then do;					/*size*/

		without_on_bit = "0"b;

		call commence_search;
		return;

	     end;

	call add_token;

	lk_ahd_index = xst;
	lk_ahd_ptr (xst) = token_stack_ptr;

	call corr_in;

	if eof | reserved_word.type ^= 1
	then do;
		call commence_search;
		return;
	     end;


	if reserved_word.key ^= 3
	then do;
		call commence_search;
		return;
	     end;


	if without_on_bit
	then without_on_bit = "0"b;
	else call remove_token;


	call remove_token;

	lk_ahd_index = 0;

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	ose_exists = "1"b;				/* APPEND gen_item TO NAME TABLE FILE */

	if ^gen_item_allocated & ^initlz_items_allocated
	then do;
		fixbin24 = gen_item_t1.size;

		call allocate_item (fixbin24, 0, 0, off, off, off, on, off, off, alloc_seg, alloc_offset);

		gen_item_t1.seg_num = alloc_seg;
		gen_item_t1.offset = alloc_offset;
		gen_item_allocated = "1"b;
	     end;

	if initlz_items_allocated
	then do;
		gen_item_t1.length = 1;
		gen_item_t1.places_left = 1;
	     end;

	call commence_search;

     end;



commence_search:
     proc;

	if end_dir1_index = 0 | curr_dir_index = 0
	then do;
		call error1;
		call emit;
		return;
	     end;

	loc1 = 1;
	loc2 = 1;
	null_match = "1"b;

after_initialization:
	tbl_item_ptr1 = addr (table1 (dir1.tbl (loc1)));

	name1 = blank_name;

	substr (name1, 1, tbl_item_ptr1 -> data_name.name_size) =
	     substr (tbl_item_ptr1 -> data_name.name, 1, tbl_item_ptr1 -> data_name.name_size);

	trial = 0;

set_name2:
	tbl_item_ptr2 = addr (table2 (dir2.tbl (loc2)));

	name2 = blank_name;

	substr (name2, 1, tbl_item_ptr2 -> data_name.name_size) =
	     substr (tbl_item_ptr2 -> data_name.name, 1, tbl_item_ptr2 -> data_name.name_size);

	if name1 = name2
	then do;

		if (tbl_item_ptr1 -> data_name.elementary & tbl_item_ptr2 -> data_name.elementary)
		     | ((tbl_item_ptr1 -> data_name.elementary | tbl_item_ptr2 -> data_name.elementary)
		     & move_swt = "1"b)
		then do;

			if first_pair
			then do;
				fixbin15 = tbl_item_ptr1 -> data_name.column;
				cv_string = bin_to_char (fixbin15, cvindex);
				cvbd_1 = substr (cv_string, 7, 4);
				dcl_col (loc1) = substr (cvbd_1, 2, 3);
				fixbin15 = tbl_item_ptr1 -> data_name.line;
				cv_string = bin_to_char (fixbin15, cvindex);
				cvbd_1 = substr (cv_string, 7, 4);
				dcl_line (loc1) = cvbd_1;
			     end;

			gen_ptr (2) = tbl_item_ptr1;
			gen_ptr (recv_i) = tbl_item_ptr2;
						/*... CORROUTPUT ALGORITHM...*/

/* GENERATE MINPRAL TOKEN STREAM */

			if ose_exists
			then do;

				if null_match
				then do;		/*first time through */

/*GENERATE STREAM: move zero to generated field*/

					end_i = end_i + 1;
					begin_i = end_i;
					ose_gen_begin_i = begin_i;
					gen_ptr (end_i) = addr (res_wd_move);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (num_lit_zero);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (res_wd_to);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (gen_item_t1);

					call stream_gen;

				     end;

				end_i = ose_gen_begin_i - 1;
				begin_i = 1;

			     end;

/* GENERATE SOURCE LINE IMAGE */
			set_new_col = "1"b;

			call stream_gen;

			if ose_exists
			then do;			/*GENERATE STREAM: on size error move 1 to generated_field*/

				if null_match
				then do;		/*set up gen_ptrs*/
					begin_i = end_i + 1;
					ose_gen_begin_i = begin_i;
					end_i = begin_i;

					gen_ptr (end_i) = addr (res_wd_on);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (res_wd_size);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (res_wd_error);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (res_wd_move);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (num_lit_one);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (res_wd_to);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (gen_item_t1);
					end_i = end_i + 1;
					gen_ptr (end_i) = addr (res_wd_dot);
				     end;
				else do;
					begin_i = ose_gen_begin_i;
					end_i = begin_i + 7;
				     end;

				call stream_gen;

				end_i = begin_i - 1;
			     end;

			null_match = "0"b;

			if ^recursive_bit
			then do;

				if tbl_item_ptr1 -> data_name.searched
				then do;
					err_num = 13;
					err_image = "sending*";
					return;

				     end;
				else tbl_item_ptr1 -> data_name.searched = "1"b;

				if tbl_item_ptr2 -> data_name.searched
				then do;
					err_num = 13;
					err_image = "receiving*";
					return;

				     end;
				else tbl_item_ptr2 -> data_name.searched = "1"b;

			     end;

			trial = 1;

			go to find_new_match;

		     end;

		if tbl_item_ptr1 -> data_name.elementary | tbl_item_ptr2 -> data_name.elementary
		then go to find_new_match;

/* if here, then neither was elementary */
		loc1 = loc1 + 1;
		loc2 = loc2 + 1;

		go to after_initialization;

	     end;					/* end of matching names */

find_new_match:
	link2 = dir2.dir (loc2);

	if link2 > loc2
	then do;
		loc2 = link2;

		if dir2.tbl (loc2) ^= 0
		then go to set_name2;
		else link2 = dir2.dir (loc2);
	     end;

	if trial = 0
	then do;
		trial = 1;
		loc2 = link2 + 1;
		go to set_name2;
	     end;

	link1 = dir1.dir (loc1);
	ln = link1 - loc1;
declare	ln		fixed bin (24);

	if ln > 0
	then do;
		loc1 = link1;
		loc2 = link2 + 1;
		go to after_initialization;
	     end;
	else do while (link1 < loc1);

		if link1 ^= 0
		then do;
			loc1 = link1;
			link1 = dir1.dir (loc1);
		     end;

		if link1 = 0
		then do;

			if null_match
			then call error1;

			call emit;

			return;

		     end;
	     end;

	loc1 = link1;

	do while (link2 < loc2);

	     loc2 = link2;
	     link2 = dir2.dir (loc2);

	end;

	loc2 = link2;

	go to after_initialization;

     end;


error1:
     proc;

	err_num = 1;
	poss_prior_err = "0"b;
	recov = "0"b;

	call err_pro;

     end;

emit:
     proc;

	if move_swt
	then do;

		call corr_in;

		if eof
		then return;

		if data_name.type = 9
		then do;
			null_match = "1"b;
			first_pair = "0"b;

			do n = 1 to end_dir1_index;
			     tbl_item_ptr1 = addr (table1 (dir1.tbl (n)));
			     tbl_item_ptr1 -> data_name.searched = "0"b;
			end;

			end_i = recv_i;
			call corres_option (1);
		     end;

	     end;

	else do;

		if ose_exists & ^null_match = "1"b
		then do;

/*GENERATE STREAM: if gen_item = 1 then*/

			begin_i = 1;
			end_i = 4;

			gen_ptr (1) = addr (res_wd_if);
			gen_ptr (2) = addr (gen_item_t1);
			res_wd_greater.key = 102;
			gen_ptr (3) = addr (res_wd_greater);
			gen_ptr (4) = addr (num_lit_one);

			call stream_gen;

		     end;

	     end;
     end;



initialize_statement:
     proc;

	err_num = 0;

	nu_line = reserved_word.line;
	n_array = 1;
	gen_label_def.def_line = nu_line;
	gen_label_ref.def_line = nu_line;
	gen_label_def.name = "NONAME0000";
	gen_label_ref.name = "NONAME0000";
	gen_label_def.section_num = section_number;
	gen_label_ref.section_num = section_number;
	second_time = "0"b;
	array_init_bit = "0"b;
	relecture = "0"b;
	sending_op = "0"b;
	end_initlz_tbl_index = 1;
	subscr_dir_index = 0;
	code = 0;

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if data_name.type ^= 9
	then do;
		err_num = 2;
		return;
	     end;

check_main_initlz_traits:
	if data_name.usage_index
	then do;					/* USAGE IS INDEX */
		err_num = 40;
		return;
	     end;

	if data_name.subscripted
	then do;					/* OCCURS */
		main_item_subscripted = "1"b;

		if data_name.occurs_do
		then do;				/* OCCURS DEPENDING ON  */
			err_num = 22;
			return;
		     end;

/* add item to subscript directory */

		if subscr_dir_index = 100
		then do;
			err_num = 28;
			return;
		     end;

		subscr_dir_index = subscr_dir_index + 1;
		subscr_directory.index_ct (subscr_dir_index) = 0;
		subscr_directory.tokn_ptr (subscr_dir_index) = null ();
		subscr_directory.sufx_ptr (subscr_dir_index) = null ();
	     end;

	else main_item_subscripted = "0"b;

/*add item to initlz_item_tbl*/

	main_item_ptr = addr (initlz_item_tbl (end_initlz_tbl_index));
	recsize2 = recsize + mod (-recsize, 4);

	if end_initlz_tbl_index + recsize2 >= table1_2_size
	then do;
		err_num = 27;
		return;
	     end;

	main_item_index = end_initlz_tbl_index;
	end_initlz_tbl_index = end_initlz_tbl_index + recsize2;
	substr (main_item_ptr -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize);

	if main_item_subscripted
	then do;
		req_sub = main_item_ptr -> occurs.dimensions;
		ptr1 = addr (main_item_ptr -> any_item (main_item_ptr -> data_name.occurs_ptr));
		subscr_directory.sufx_ptr (subscr_dir_index) = ptr1;
	     end;
	else req_sub = 0;

	if data_name.elementary
	then do;
		main_item_ptr -> data_name.searched = "1"b;

		call corr_in;

		if eof
		then do;
			err_num = 15;
			return;
		     end;
		if reserved_word.type = 1
		then go to sub_ref;

		if reserved_word.type ^= 26
		then do;

			if data_name.type = 9
			then do;

				if data_name.subscripted
				then n_array = n_array + 1;
				go to get1;

			     end;

			err_num = 23;
			return;
		     end;
		go to got_end_initlz_opnd;

	     end;

	main_item_ptr -> data_name.searched = "0"b;

get_nxt_initlz_member:
	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if data_name.type ^= 9
	then do;
		if reserved_word.type = 1
		then go to sub_ref;

		if reserved_word.type ^= 26
		then go to get_nxt_initlz_member;
		else go to got_end_initlz_opnd;
	     end;

get1:
	if data_name.occurs_do
	then do;					/*OCCURS DEPENDING ON*/

		if main_item_subscripted
		then subscr_dir_index = subscr_dir_index - 1;

		end_initlz_tbl_index = main_item_index;
		go to get_nxt_initlz_member;


	     end;

	if ^data_name.usage_index & ^data_name.filler_item & ^data_name.s_of_rdf
	then do;

		ptr2 = addr (initlz_item_tbl (end_initlz_tbl_index));
		recsize2 = recsize + mod (-recsize, 4);
		end_initlz_tbl_index = end_initlz_tbl_index + recsize2;

		if end_initlz_tbl_index >= table1_2_size
		then do;
			err_num = 27;
			return;
		     end;

		substr (ptr2 -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize);

	     end;

	go to get_nxt_initlz_member;

sub_ref:
	if reserved_word.key ^= 187			/* ( */
	then do;
		err_num = 28;
		return;
	     end;

sub_ref_1:
	call begin_subscripts;

	if err_num ^= 0
	then return;

got_end_initlz_opnd:
	ptr2 = addr (initlz_item_tbl (end_initlz_tbl_index));
	recsize2 = recsize + mod (-recsize, 4);
	end_initlz_tbl_index = end_initlz_tbl_index + recsize2;

	if end_initlz_tbl_index >= table1_2_size
	then do;
		err_num = 27;
		return;
	     end;					/* type 26 token delimits group */

	substr (ptr2 -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize);

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if data_name.type = 9
	then do;
		n_array = n_array + 1;
		array_init_bit = "1"b;
		go to check_main_initlz_traits;
	     end;

second_half_initlz:					/* assumes token already retrieved */
						/* this type_26 token, immediately following the last group terminator token
   which was also a type_26 token, signals the end of the table */
						/* if no items were entered in table, it contains only this type_26 token
   signalling an empty table */
	ptr2 = addr (initlz_item_tbl (end_initlz_tbl_index));
	recsize2 = type_26_token.size;
	ptr1 = addr (type_26_token);
	recsize2 = recsize2 + mod (-recsize2, 4);
	end_initlz_tbl_index = end_initlz_tbl_index + recsize2;

	if end_initlz_tbl_index >= table1_2_size
	then do;
		err_num = 27;
		return;
	     end;

	substr (ptr2 -> record2, 1, recsize2) = substr (ptr1 -> record2, 1, recsize2);
	ptr2 = addr (initlz_item_tbl (1));

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if reserved_word.type ^= 1 | reserved_word.key ^= 152
						/*REPLACING*/
	then do;
		defaults = "1"b;

/* want not to retrieve another token for bos */

		subscr_dir_index = 0;
		go to gen_initlz_code;
	     end;

	defaults = "0"b;
	sending_op = "1"b;

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if reserved_word.type ^= 1
	then do;
		err_num = 23;
		return;
	     end;

	if reserved_word.key = 131			/*NUMERIC*/
	then category = 18;

	else if reserved_word.key = 132		/*NUMERIC-EDITED*/
	then category = 19;

	else if reserved_word.key = 75		/*ALPHANUMERIC*/
	then category = 20;

	else if reserved_word.key = 76		/*ALPHANUMERIC-EDITED*/
	then category = 21;

	else if reserved_word.key = 74		/*ALPHABETIC*/
	then category = 22;

	else do;
		err_num = 23;
		return;
	     end;


	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if reserved_word.type ^= 1
	then do;
		err_num = 38;
		return;
	     end;

	if reserved_word.key = 196
	then do;					/*DATA*/

		call corr_in;

		if eof
		then do;
			err_num = 15;
			return;
		     end;

		if reserved_word.type ^= 1
		then do;
			err_num = 39;
			return;
		     end;
	     end;

	if reserved_word.key ^= 82			/*BY*/
	then do;
		err_num = 39;
		return;
	     end;

	call corr_in;

	if eof
	then do;
		err_num = 15;
		return;
	     end;

	if reserved_word.type = 1
	then do;

		if reserved_word.key = 73
		then do;				/* lit. preceded by ALL key word */

			call corr_in;

			if eof
			then do;
				err_num = 15;
				return;
			     end;

			if reserved_word.type = 3
			then do;
				input_ptr -> alphanum_lit.all_lit = "1"b;
				go to tst_alph_cat;
			     end;
		     end;
	     end;

	if numeric_lit.type = 2
	then do;

tst_num_cat:
		if category ^= 18 & category ^= 19
		then do;
			err_num = 26;
			return;
		     end;
store_send_op:
		call add_token;

		send_op_ptr = token_stack_ptr;

		call corr_in;

		if eof
		then do;
			err_num = 15;
			return;
		     end;

		if reserved_word.key = 189
		then do;
			call corr_in;
			if eof
			then do;
				err_num = 15;
				return;
			     end;
		     end;

		subscr_dir_index = 0;

		go to gen_initlz_code;

	     end;

	if reserved_word.type = 3
	then do;					/*alphanumeric literal*/

tst_alph_cat:
		if category = 18 | category = 19
		then do;
			err_num = 26;
			return;
		     end;
		go to store_send_op;
	     end;

	if data_name.type = 9
	then do;
		descr_ptr = addr (data_name.file_section);

		if ^(description (category))
		then do;
			err_num = 26;
			return;
		     end;

		if ^(data_name.subscripted)		/*occurs*/
		then go to store_send_op;

		subscr_dir_index = subscr_dir_index + 1;

/*not used, but prevents overlaying of prev area by subscript processing*/

		call add_token;

		send_op_ptr = token_stack_ptr;

		call corr_in;

		if eof
		then do;
			err_num = 15;
			return;
		     end;

		if reserved_word.type = 1
		then if reserved_word.key = 187	/* ( */
		     then go to sub_ref_1;

		     else do;
			     err_num = 3;
			     return;
			end;
	     end;

	if reserved_word.type = 1
	then do;

		if reserved_word.key = 180		/*zeroes*/
		then go to tst_num_cat;
		if reserved_word.key = 192		/*spaces*/
		then go to tst_alph_cat;
	     end;

	err_num = 34;

	return;

gen_initlz_code:
	if subscr_cnt ^= req_sub
	then do;
		err_num = 43;
		return;
	     end;

	array_init_bit = "0"b;

more_code:
	if ptr2 -> reserved_word.type = 26
	then return;				/*  was  end_of_initlz_tbl_fnd  */

	null_match = "1"b;

	if ptr2 -> data_name.subscripted
	then do;					/* OCCURS */
		subscr_dir_index = subscr_dir_index + 1;
		main_item_subscripted = "1"b;
	     end;
	else main_item_subscripted = "0"b;

test_item_elementary:
	if (ptr2 -> data_name.elementary)
	then do;

		if defaults
		then do;

			if match_cat ()
			then call gen_assign;

		     end;
		else do;
			descr_ptr = addr (ptr2 -> data_name.file_section);
			if description (category)
			then call gen_assign;
			else n_array = n_array - 1;
		     end;


	     end;

	n = ptr2 -> reserved_word.size;
	n = n + mod (-n, 4);
	ptr2 = addr (ptr2 -> any_item (n + 1));

	if ptr2 -> reserved_word.type = 26
	then do;					/* group terminator */

		if null_match
		then do;
			err_num = 25;
			poss_prior_err = "0"b;

			call err_pro;

		     end;

		n = ptr2 -> reserved_word.size;
		n = n + mod (-n, 4);
		ptr2 = addr (ptr2 -> any_item (n + 1));

		go to more_code;

	     end;

	go to test_item_elementary;

     end;



setup_gen_lit:
     proc;

declare	fixbin15		fixed bin;		/* fills in fields in generated numeric literal tokens for perform control values */

	gen_num_lit_mindim.size = 36;
	fixbin15 = ptr1 -> occurs.level.max (curr_dim);
	cv_string = bin_to_char (fixbin15, cvindex);
	gen_num_lit_mindim.places = 10 - cvindex;

	substr (gen_num_lit_mindim.literal, 1, gen_num_lit_mindim.places) =
	     substr (cv_string, cvindex + 1, gen_num_lit_mindim.places);

	gen_num_lit_mindim.size = gen_num_lit_mindim.size + gen_num_lit_mindim.places;
	gen_num_lit_mindim.places_left = gen_num_lit_mindim.places;

     end;








dcl	1 message		internal static,
	  2 size		fixed bin init (0),
	  2 line		fixed bin init (0),
	  2 column	fixed bin init (0),
	  2 type		fixed bin init (5),
	  2 run		fixed bin init (8),
	  2 number	fixed bin init (0),
	  2 infobits,
	    3 info1	bit (1) init ("0"b),
	    3 info2	bit (1) init ("0"b),
	    3 info3	bit (6) init ("0"b),
	  2 length	fixed bin init (0),
	  2 image		char (200);



err_pro:
     proc;
	if poss_prior_err & ^eof
	then do;

		if reserved_word.type = 5		/*message from earlier phase caused error*/
		then call cobol_swf_put (outfp, fst, input_ptr, reserved_word.size);

	     end;

	message.number = err_num;
	message.length = index (err_image, "*");

	if message.length > 0
	then message.length = message.length - 1;

	output_ptr = addr (message);

	if message.length = 0
	then do;
		message.info1 = "0"b;
	     end;
	else do;
		substr (message.image, 1, message.length) = substr (err_image, 1, message.length);
		substr (err_image, 1, 1) = "*";
		message.info1 = "1"b;
	     end;

	message.infobits.info2 = "0"b;
	message.line = reserved_word.line;
	message.column = reserved_word.column;
	message.size = 32 + message.length;

	call cobol_swf_put (outfp, fst, output_ptr, message.size);

	poss_prior_err = "1"b;

	if ^recov
	then return;

	if reserved_word.terminator /*period or verb*/ | reserved_word.end_cobol = "1"b
						/*special generated end-cobol token*/
	then do;
		recov = "0"b;
		return;
	     end;

	message.number = 7;				/* syntax checking discontinued message */
	message.size = 28;
	message.info1 = "0"b;
	message.infobits.info2 = "1"b;
	recovering = "1"b;

	call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size);

	code = 2;

	call corr_in;

	recovering = "0"b;

	if eof
	then return;

	if reserved_word.key = 98 & reserved_word.terminator & reserved_word.end_cobol
	then do;					/* special end_cobol token */

		call cobol_swf_put (outfp, fst, input_ptr, recsize);

		eof = "1"b;
		recov = "0"b;
		return;

	     end;

	message.number = 8;				/*syntax checking resumed message */
	message.line = reserved_word.line;
	message.column = reserved_word.column;

	call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size);

	recov = "0"b;
     end;



corr_in:
     proc;


dcl	first_time_in_get_1 bit (1);



dcl	1 message		based (input_ptr),
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin,
	  2 run		fixed bin,
	  2 number	fixed bin,
	  2 infobits,
	    3 info1	bit (1),
	    3 info2	bit (1),
	    3 info3	bit (6);


dcl	1 debug_token	based (input_ptr),
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin,
	  2 index		fixed bin,
	  2 switch	bit (1);



	first_time_in_get_1 = "1"b;

	go to get (code);

get (0):						/*any token except type 6 */
						/*or type 5 with info(2) off */
	call cobol_swf_get (infp, fst, input_ptr, recsize);


	if substr (fst, 17, 16) = "0000000000100111"b
	then do;
		eof = "1"b;
		recovering = "0"b;
		return;
	     end;

	if message.type = 5
	then do;

		if code = 0
		then do;

			if message.infobits.info2
			then return;
			go to get (0);
		     end;

		else go to write_tok;
	     end;

	if debug_token.type = 24
	then go to write_tok;

	if data_name.type = 9
	then do;
		inf_ptr = addr (data_name.searched);
		inf = "0"b;
	     end;

	return;

get (1):						/* add, subtract, or move */
	if first_time_in_get_1
	then do;

		if lk_ahd_index > 0
		then do n = 1 to lk_ahd_index;
			output_ptr = lk_ahd_ptr (n);
			recsize = output_ptr -> reserved_word.size;

			call cobol_swf_put (outfp, fst, output_ptr, recsize);

		     end;

		add_swt = "0"b;
		subtract_swt = "0"b;
		move_swt = "0"b;
		initlz_swt = "0"b;
		first_time_in_get_1 = "0"b;
		if input_ptr ^= null ()
		then go to test_token_get1;

		call cobol_swf_get (infp, fst, input_ptr, recsize);

		if substr (fst, 17, 16) = "0000000000100111"b
		then do;
			eof = "1"b;
			return;
		     end;

		if reserved_word.type = 1 & reserved_word.key = 189
						/* . */
		then do;
			call cobol_swf_get (infp, fst, input_ptr, recsize);
			if substr (fst, 17, 16) = "0000000000100111"b
			then do;
				eof = "1"b;
				return;
			     end;
		     end;
	     end;
	else call cobol_swf_get (infp, fst, input_ptr, recsize);

	if substr (fst, 17, 16) = "0000000000100111"b
	then do;
		eof = "1"b;
		return;
	     end;

test_token_get1:
	if proc_def.type = 7
	then do;
		section_number = proc_def.section_num;
	     end;

	if debug_token.type = 24
	then go to write_tok;

	if reserved_word.type = 1
	then do;

		if reserved_word.key = 2
		then do;
			add_swt = "1"b;
			return;
		     end;

		if reserved_word.key = 11
		then do;
			subtract_swt = "1"b;
			return;
		     end;

		if reserved_word.key = 18
		then do;
			move_swt = "1"b;
			return;
		     end;

		if reserved_word.key = 13
		then do;
			initlz_swt = "1"b;
			return;
		     end;
	     end;

	go to passover;

get (2):						/* statement terminator */
	call cobol_swf_get (infp, fst, input_ptr, recsize);

	if substr (fst, 17, 16) = "0000000000100111"b
	then eof = "1"b;

	if eof
	then return;

	if reserved_word.type = 1
	then if reserved_word.terminator
	     then return;

passover:
	if message.type = 5
	then if code = 0
	     then do;

		     if message.infobits.info2
		     then return;
		     go to get (0);
		end;

	if ^recovering
	then go to write_tok;

	if message.type = 5
	then go to write_tok;

	if debug_token.type = 24
	then go to write_tok;
	go to get (code);

write_tok:
	if data_name.type ^= 26
	then call cobol_swf_put (outfp, fst, input_ptr, recsize);

	go to get (code);

     end;



add_token:
     proc;

	/*** adds token to token_stack -- for later output order ***/

	token_stack_ptr = addr (token_stack (top_token_stack));
	substr (token_stack_ptr -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize);
	n = token_stack_ptr -> reserved_word.size;
	top_token_stack = top_token_stack + n + mod (-n, 4);
     end;



remove_token:
     proc;

	/***pops token stack -- when token added prematurely ***/


	recsize2 = token_stack_ptr -> reserved_word.size;
	recsize2 = recsize2 + mod (-recsize2, 4);
	top_token_stack = top_token_stack - recsize2;
     end;



stream_gen:
     proc;

	/***generates stream of minpral tokens from gen_ptr(begin_i) to gen_ptr(end_i) ***/

	do i = begin_i to end_i;

	     output_ptr = gen_ptr (i);

	     if output_ptr -> reserved_word.line = 0
	     then output_ptr -> reserved_word.line = nu_line;

	     call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size);

	     output_ptr -> reserved_word.line = 0;
	end;

     end;





bin_to_char:
     proc (value_sent, cv_index) returns (char (10));



dcl	dec_digits	char (10) internal static init ("0123456789");
dcl	bin_val		fixed bin;
dcl	value_sent	fixed bin;
dcl	cv_index		fixed bin;
dcl	cv_string		char (10);
dcl	remainder		fixed bin;



	bin_val = value_sent;
	cv_string = (10)" ";
	cv_index = 10;


	if bin_val = 0
	then do;
		substr (cv_string, 10, 1) = "0";
		cv_index = 9;
	     end;
	else do while (bin_val > 0);
		remainder = mod (bin_val, 10);
		substr (cv_string, cv_index, 1) = substr (dec_digits, remainder + 1, 1);
		bin_val = divide (bin_val, 10, 15, 0);
		cv_index = cv_index - 1;
	     end;

	return (cv_string);

     end;





gen_assign:
     proc;


	/***   sets up gen_ptr stack values for an INITIALIZE pair   ***/

dcl	sub_level		fixed bin;
dcl	ind_level		fixed bin;
dcl	perform_bit	bit (1);




	null_match = "0"b;
	perform_bit = "0"b;
	fixbin_diff = "0"b;

	if ptr2 -> data_name.subscripted
	then do;					/* this item is array */
		ptr1 = addr (ptr2 -> any_item (ptr2 -> data_name.occurs_ptr));

		if main_item_subscripted
		then do;
			ptr4 = subscr_directory.sufx_ptr (subscr_dir_index);

			if ptr4 -> occurs.dimensions < ptr1 -> occurs.dimensions
			then do;

/* this item has more dimensions than main item */

				sub_level = ptr4 -> occurs.dimensions + 1;
				go to perform_reqd;
			     end;

			if array_init_bit
			then do;
				sub_level = 1;

			     end;
		     end;

/* array within non-array */

		else do;
			sub_level = 1;
			go to perform_reqd;
		     end;
	     end;

/* no additional dimensions in this item over main item's */

	gen_ptr (1) = addr (res_wd_move);

	if defaults
	then do;

		if category < 20
		then gen_ptr (2) = addr (res_wd_zeroes);
		else gen_ptr (2) = addr (res_wd_spaces);
	     end;

	else gen_ptr (2) = send_op_ptr;

	gen_ptr (3) = addr (res_wd_to);
	gen_ptr (4) = ptr2;
	end_i = 4;

	if main_item_subscripted
	then do;
		gen_ptr (5) = addr (res_wd_lparen);
		ptr3 = subscr_directory.tokn_ptr (subscr_dir_index);

stk_subscr_tokns:
		end_i = end_i + 1;
		gen_ptr (end_i) = ptr3;


		if ptr3 -> reserved_word.type = 1
		then if ptr3 -> reserved_word.key = 188
		     then /* ) */
			do;
			     call stream_gen;
			     n_array = n_array - 1;
			     array_init_bit = "1"b;
			     return;
			end;

		n = ptr3 -> reserved_word.size;
		n = n + mod (-n, 4);
		ptr3 = addr (ptr3 -> any_item (n + 1));

		go to stk_subscr_tokns;

	     end;

	call stream_gen;
	second_time = "0"b;
	array_init_bit = "0"b;
	n_array = n_array - 1;
	return;

perform_reqd:
	perform_bit = "1"b;

	if fixbin15 ^= 0
	then if (fixbin15 - 1) ^= ptr1 -> occurs.level.min (curr_dim)
	     then do;
		     second_time = "0"b;
		     fixbin_diff = "1"b;
		end;

	if second_time
	then do;
		i = 1;
		go to several_time;
	     end;

	if ^initlz_items_allocated
	then do;

		save_the_key = "1"b;

		if gen_item_allocated
		then go to allocate_t2;

		fixbin24 = gen_item_t1.size;

		call allocate_item (fixbin24, 0, 0, off, off, off, on, off, off, alloc_seg, alloc_offset);

		gen_item_t1.seg_num = alloc_seg;
		gen_item_t1.offset = alloc_offset;

allocate_t2:					/*  allocation du deuxieme article  */
		fixbin24 = gen_item_t2.size;

		call allocate_item (fixbin24, 0, 0, off, off, off, on, off, off, alloc_seg, alloc_offset);

		gen_item_t2.seg_num = alloc_seg;
		gen_item_t2.offset = alloc_offset;
		fixbin24 = gen_item_t3.size;

		call allocate_item (fixbin24, 0, 0, off, off, off, on, off, off, alloc_seg, alloc_offset);

		gen_item_t3.seg_num = alloc_seg;
		gen_item_t3.offset = alloc_offset;
		initlz_items_allocated = "1"b;
	     end;

	else save_the_key = "0"b;

/* either main item had no dimensions or main item had 1 or 2 dimensions;
		   in either case, this item has more dimensions than main item */

	fixed_common.spec_tag_counter = fixed_common.spec_tag_counter + 1;
	gen_label_ref.proc_num = fixed_common.spec_tag_counter;
	gen_label_def.proc_num = fixed_common.spec_tag_counter;

	gen_ptr (1) = addr (gen_label_def);

	call write_gen_label (gen_ptr (1));		/*   added  to  give  a  name  to  label  */

	if main_item_subscripted
	then do;

		ptr3 = subscr_directory.tokn_ptr (subscr_dir_index);

		if subscr_directory.index_ct (subscr_dir_index) > 0
		then do;

/* main item's subscript string includes indices */
						/** generate code to SET index value(s) to non-index variables for loop **/

			ind_level = 1;

set_main_indices:
			if ptr3 -> index_name.type = 10
			then do;

				if ^(ptr3 -> index_name.searched)
				then do;
					gen_ptr (2) = addr (gen_item_t1);
					ptr3 -> index_name.searched = "1"b;
				     end;
				else do;
					gen_ptr (2) = addr (gen_item_t2);
					ptr3 -> index_name.duplicate = "1"b;
				     end;

				gen_ptr (1) = addr (res_wd_set);
				gen_ptr (3) = addr (res_wd_to);
				gen_ptr (4) = ptr3;
				end_i = 4;

				call stream_gen;

				n = ptr3 -> reserved_word.size;
				n = n + mod (-n, 4);
				ptr3 = addr (ptr3 -> any_item (n + 1));

				if ptr3 -> reserved_word.type = 1
				then do;

					if ptr3 -> reserved_word.key = 182
					then /* + */
					     do;
						gen_ptr (1) = addr (res_wd_add);

gen_rest:
						gen_ptr (4) = gen_ptr (2);
						n = ptr3 -> reserved_word.size;
						n = n + mod (-n, 4);
						gen_ptr (2) = addr (ptr3 -> any_item (n + 1));

						call stream_gen;

						ptr3 -> reserved_word.type = 0;
						gen_ptr (2) -> reserved_word.type = 0;
						n = gen_ptr (2) -> reserved_word.size;
						n = n + mod (-n, 4);
						ptr3 = addr (gen_ptr (2) -> any_item (n + 1));
					     end;

					else if ptr3 -> reserved_word.key = 183
					then /* - */
					     do;
						gen_ptr (1) = addr (res_wd_subtract);
						gen_ptr (3) = addr (res_wd_from);
						go to gen_rest;
					     end;
				     end;
			     end;

			else do;
				n = ptr3 -> reserved_word.size;
				n = n + mod (-n, 4);
				ptr3 = addr (ptr3 -> any_item (n + 1));
				go to set_main_indices;
			     end;

			if ind_level ^= subscr_directory.index_ct (subscr_dir_index)
			then do;
				ind_level = ind_level + 1;
				go to set_main_indices;
			     end;

		     end;
	     end;

						/** generate PERFORM **/

	if fixbin_diff
	then do;
		gen_label_def.proc_num = gen_label_def.proc_num - 1;
		gen_ptr (1) = addr (res_wd_dot);
		gen_ptr (2) = addr (gen_label_def);

		call write_gen_label (gen_ptr (2));

		gen_ptr (3) = addr (res_wd_dot);
		end_i = 3;

		call stream_gen;

		fixbin_diff = "0"b;
	     end;

	gen_ptr (1) = addr (res_wd_perform);
	gen_ptr (2) = addr (gen_label_ref);

	call write_gen_label (gen_ptr (2));

	gen_ptr (3) = addr (res_wd_varying);
	end_i = 3;
	res_wd_greater.key = 113;

	if sub_level = 3
	then go to level3_gen;

	if sub_level = 2
	then go to level2_gen;

	curr_dim = 1;

	call setup_gen_lit;

	gen_item_t1.length = gen_num_lit_mindim.places;
	gen_item_t1.places_left = gen_num_lit_mindim.places;

	gen_ptr (4) = addr (gen_item_t1);
	gen_ptr (5) = addr (res_wd_from);
	gen_ptr (6) = addr (num_lit_one);
	gen_ptr (7) = addr (res_wd_by);
	gen_ptr (8) = addr (num_lit_one);
	gen_ptr (9) = addr (res_wd_until);
	gen_ptr (10) = addr (gen_item_t1);
	gen_ptr (11) = addr (res_wd_greater);
	gen_ptr (12) = addr (gen_num_lit_mindim);
	end_i = 12;

	call stream_gen;

	if ptr1 -> occurs.dimensions = 1
	then go to gen_move_label;

	gen_ptr (1) = addr (res_wd_after);
	end_i = 1;

level2_gen:
	curr_dim = 2;

	call setup_gen_lit;

	end_i = end_i + 1;
	gen_item_t2.length = gen_num_lit_mindim.places;
	gen_item_t2.places_left = gen_num_lit_mindim.places;

	gen_ptr (end_i) = addr (gen_item_t2);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_from);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (num_lit_one);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_by);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (num_lit_one);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_until);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (gen_item_t2);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_greater);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (gen_num_lit_mindim);

	call stream_gen;

	if ptr1 -> occurs.dimensions = 2
	then go to gen_move_label;

	gen_ptr (1) = addr (res_wd_after);
	end_i = 1;

level3_gen:
	curr_dim = 3;

	call setup_gen_lit;

	end_i = end_i + 1;
	gen_item_t3.length = gen_num_lit_mindim.places;
	gen_item_t3.places_left = gen_num_lit_mindim.places;

	gen_ptr (end_i) = addr (gen_item_t3);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_from);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (num_lit_one);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_by);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (num_lit_one);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_until);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (gen_item_t3);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_greater);
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (gen_num_lit_mindim);

	call stream_gen;

gen_move_label:
	fixed_common.spec_tag_counter = fixed_common.spec_tag_counter + 1;
	gen_label_ref.proc_num = fixed_common.spec_tag_counter;
	gen_label_def.proc_num = fixed_common.spec_tag_counter;
	gen_ptr (1) = addr (res_wd_go);
	gen_ptr (2) = addr (res_wd_to);
	gen_ptr (3) = addr (gen_label_ref);

	call write_gen_label (gen_ptr (3));

	gen_ptr (4) = addr (res_wd_dot);
	gen_label_def.proc_num = gen_label_def.proc_num - 1;

	gen_ptr (5) = addr (gen_label_def);

	call write_gen_label (gen_ptr (5));

	gen_ptr (6) = addr (res_wd_dot);
	gen_ptr (7) = addr (res_wd_move);

	i = 8;

	if defaults
	then do;
		if category < 20
		then gen_ptr (i) = addr (res_wd_zeroes);
		else gen_ptr (i) = addr (res_wd_spaces);
	     end;

	else do;

		gen_ptr (i) = send_op_ptr;

		if send_op_ptr -> data_name.type = 9
		then do;

			if send_op_ptr -> data_name.subscripted
						/*OCCURS*/
			then do;
nxt_send_op_subscr:
				n = gen_ptr (i) -> data_name.size;
				n = n + mod (-n, 4);
				i = i + 1;
				gen_ptr (i) = addr (gen_ptr (i - 1) -> any_item (n + 1));

				if gen_ptr (i) -> reserved_word.type = 1
				then do;
					if gen_ptr (i) -> reserved_word.key = 188
					then go to end_send_op_gen;
				     end;
				go to nxt_send_op_subscr;
			     end;
end_send_op_gen:
		     end;

	     end;

	i = i + 1;
	gen_ptr (i) = addr (res_wd_to);
	i = i + 1;

several_time:
	gen_ptr (i) = ptr2;
	end_i = i;

	call stream_gen;

/*	if array_init_bit
	then	do;
		          array_init_bit = "0"b;
		          go to gen_lpar;
	          end;	*/

	if main_item_subscripted
	then do;

/* give subscripts from subscript area */

		ptr3 = subscr_directory.tokn_ptr (subscr_dir_index);
		end_i = 0;

test_subscr_type:
		if ptr3 -> reserved_word.type = 0
		then go to get_nxt_subscript;		/*
		/* this was from index +_ literal for main item -- replaced by SET and ADD or SUBTRACT */

		if ptr3 -> index_name.type = 10
		then do;
			end_i = end_i + 1;

			if ptr3 -> index_name.searched
			then gen_ptr (end_i) = addr (gen_item_t1);
			else gen_ptr (end_i) = addr (gen_item_t2);

			ptr3 -> index_name.searched = "0"b;
			ptr3 -> index_name.duplicate = "0"b;
		     end;
		else do;
			if ptr3 -> reserved_word.type = 1
			then if ptr3 -> reserved_word.key = 188
			     then go to test_extra_subscr;
			end_i = end_i + 1;
			gen_ptr (end_i) = ptr3;
		     end;

get_nxt_subscript:
		n = ptr3 -> reserved_word.size;
		n = n + mod (-n, 4);
		ptr3 = addr (ptr3 -> any_item (n + 1));

		go to test_subscr_type;

	     end;

test_extra_subscr:					/* there is always at least one */
	if ^main_item_subscripted
	then do;
gen_lpar:
		end_i = 1;
		gen_ptr (1) = addr (res_wd_lparen);
	     end;

	if sub_level = 3
	then go to gen_level3;

	if sub_level = 2
	then go to gen_level2;

	end_i = end_i + 1;
	gen_ptr (end_i) = addr (gen_item_t1);

	if ptr1 -> occurs.dimensions = 1
	then go to gen_rparen;

gen_level2:
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (gen_item_t2);

	if ptr1 -> occurs.dimensions = 2
	then go to gen_rparen;

gen_level3:
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (gen_item_t3);

gen_rparen:
	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_rparen);

	end_i = end_i + 1;
	gen_ptr (end_i) = addr (res_wd_dot);

	call stream_gen;

	call genlabel;

	if n_array > 1
	then do;

		second_time = "0"b;
		n_array = n_array - 1;
		array_init_bit = "1"b;

	     end;

	return;



genlabel:
     proc;

	if perform_bit
	then do;
		perform_bit = "0"b;
		gen_label_def.proc_num = gen_label_def.proc_num + 1;
		gen_ptr (1) = addr (gen_label_def);

		call write_gen_label (gen_ptr (1));

		gen_ptr (2) = addr (res_wd_dot);
		end_i = 2;

		call stream_gen;

	     end;

     end;

     end;

write_gen_label:
     proc (label_ptr);

dcl	label_ptr		ptr;

dcl	1 general_label	based (label_ptr),
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin,
	  2 string_ptr	ptr,
	  2 prev_rec	ptr,
	  2 info		bit (8),
	  2 priority	char (2),			/* 1 multics char(1), */
	  2 repl_bit	bit (8),
	  2 section_num	fixed bin,
	  2 proc_num	fixed bin,
	  2 def_line	fixed bin,
	  2 length	fixed bin,
	  2 name		char (10);
dcl	string_ctr	char (10);
dcl	scale		fixed bin;



	string_ctr = bin_to_char (label_ptr -> general_label.proc_num, scale);
	substr (general_label.name, scale + 1, 10 - scale) = substr (string_ctr, scale + 1, 10 - scale);

     end;



match_cat:
     proc returns (bit (1));

	do category = 18 to 22 by 1;
	     descr_ptr = addr (ptr2 -> data_name.file_section);
	     if description (category)
	     then return ("1"b);
	end;

	return ("0"b);

     end;



/*    merge  allocate_item  in  internal   */

allocate_item:
     proc (al_size, al_elem_offset, al_occ_offset, al_read_only, al_bitt, al_byte, al_half_word, al_word, al_double_word,
	al_rec_seg, al_rec_off);

/* pointers */
/*  suppress cobol_com_ptr declared in begining cobol_ci_phase  
	dcl cobol_com_ptr ptr ext;    */
/* pointer to fixed common, set by driver */
dcl	ft_ptr		ptr;			/* pointer to current file table record in common */
dcl	seg_ptr		ptr;			/* pointer to segment-information entry in common */
dcl	prev_seg_ptr	ptr;			/* previous value of seg_ptr saved here by allocate_item */
						/*  cobol_cmfp  external  pointer  must  be  declared  in  cobol_ci_phase
	dcl cobol_cmfp ptr ext;
	                                                                        */
						/*   cobol_vdwf_dput  and  dget  are  declared  in  cobol_ci_phase      
	dcl cobol_vdwf_dget ext entry(ptr,bit(32),ptr,fixed bin,char(5));
	dcl cobol_vdwf_dput ext entry(ptr,bit(32),ptr,fixed bin,char(5));
	                                                                     */
						/* description of data division segment information table in common */
dcl	1 dd_segment	based (seg_ptr),
	  2 next		char (5),			/* record number in common of next segment information record */
	  2 seg_no	fixed bin (7),
	  2 next_avail_loc	fixed bin (24),
	  2 duplicate_next_loc
			fixed bin (24),
	  2 read_only	bit (1);			/* character string work fields */
dcl	work_area		char (25),
	seg_size		fixed bin;		/* fixed binary work fields */
dcl	common_recsize	fixed bin;		/* size of record just read from common file */
dcl	common_key	char (5);			/* record number of common record just read or to be read */
dcl	elem_offset_limit	fixed bin (24);
dcl	occ_offset_limit	fixed bin (24);
dcl	second_occ_limit	fixed bin (24);		/* 2**15 + 2**12 - 1 */
dcl	next_loc_used	fixed bin (24);		/* work area used by allocate_item */
dcl	work31		fixed bin (24);
dcl	double_word_slack	fixed bin (7);
dcl	word_slack	fixed bin (7);
dcl	half_word_slack	fixed bin (7);		/* bit strings */

dcl	common_eof	bit (1);			/* set on if end-of-file encountered on read of common file */
dcl	al_size		fixed bin (24);		/* size of item to be allocated */
dcl	al_elem_offset	fixed bin (24);		/* largest offset of any contained elementary item not in a table */
dcl	al_occ_offset	fixed bin (24);		/* largest offset of any contained table item */
dcl	al_rec_seg	fixed bin;		/* segment number assigned to item */
dcl	al_rec_off	fixed bin (24);		/* offset assigned to item */
dcl	al_read_only	bit (1);			/* read only requirement of the item */
dcl	al_bitt		bit (1);			/* boundary requirement of the item */
dcl	al_byte		bit (1);
dcl	al_half_word	bit (1);
dcl	al_word		bit (1);
dcl	al_double_word	bit (1);



	seg_size = 21;
	elem_offset_limit = 262144;
	occ_offset_limit = 262144;
	second_occ_limit = 262144;

	if new_seg_bit = off
	then do;					/* have any segments been started yet? */

		if fixed_common.seg_info = "00000" | al_size ^< fixed_common.dd_seg_size
		then go to new_segment_needed;
	     end;

	common_key = fixed_common.seg_info;

	call cobol_vdwf_dget (cobol_cmfp, status, seg_ptr, common_recsize, fixed_common.seg_info);

/* can the item be allocated in this segment? */

check_this_segment:
	if dd_segment.read_only ^= al_read_only
	then go to check_next_segment;

	next_loc_used = dd_segment.next_avail_loc;

	if al_bitt
	then go to boundary_ok;

	if al_byte
	then go to boundary_ok;

	if al_half_word
	then go to incr_to_half_word;

	if al_word
	then go to incr_to_word;			/* double-word boundary required for this item */
	double_word_slack = mod (next_loc_used, 8);

	if double_word_slack ^= 0
	then next_loc_used = next_loc_used + 8 - double_word_slack;

	go to boundary_ok;				/* word boundary required for this item */

incr_to_word:
	word_slack = mod (next_loc_used, 4);

	if word_slack ^= 0
	then next_loc_used = next_loc_used + 4 - word_slack;

	go to boundary_ok;				/* half-word boundary required for this item */

incr_to_half_word:
	half_word_slack = mod (next_loc_used, 2);
	next_loc_used = next_loc_used + half_word_slack;

boundary_ok:
	work31 = next_loc_used + al_size - 1;

	if work31 > fixed_common.dd_seg_size
	then go to check_next_segment;

	if al_elem_offset ^< elem_offset_limit
	then go to first_occ_check;

	work31 = next_loc_used + al_elem_offset - 1;

	if work31 ^< elem_offset_limit
	then go to check_next_segment;

first_occ_check:
	work31 = next_loc_used + al_occ_offset - 1;

	if al_occ_offset > (occ_offset_limit - 1)
	then go to second_occ_check;

	if work31 ^< occ_offset_limit
	then go to check_next_segment;

	go to this_seg_ok;

second_occ_check:
	if work31 ^< second_occ_limit
	then go to check_next_segment;		/* yes, item can be allocated in this segment */

this_seg_ok:
	al_rec_seg = dd_segment.seg_no;
	al_rec_off = next_loc_used;
	dd_segment.next_avail_loc = next_loc_used + al_size;
	dd_segment.duplicate_next_loc = dd_segment.next_avail_loc;

	call cobol_vdwf_dput (cobol_cmfp, status, seg_ptr, common_recsize, common_key);

	return;

check_next_segment:
	if new_seg_bit
	then go to this_seg_ok;

	common_key = dd_segment.next;

	call cobol_vdwf_dget (cobol_cmfp, status, seg_ptr, common_recsize, dd_segment.next);

	if dd_segment.next ^= "00000"
	then go to check_this_segment;		/* build new segment entry in work area, then write it out to common */

new_segment_needed:
	seg_ptr = addr (work_area);
	dd_segment.next = "00000";

	if ^new_seg_bit
	then fixed_common.number_of_dd_segs = fixed_common.number_of_dd_segs + 2;

	new_seg_bit = "1"b;
	dd_segment.seg_no = fixed_common.number_of_dd_segs;
						/* start with segment number 2 */
	dd_segment.next_avail_loc = 0;
	dd_segment.duplicate_next_loc = 0;
	dd_segment.read_only = al_read_only;

	call cobol_vdwf_dput (cobol_cmfp, status, seg_ptr, seg_size, common_key);


/* save old value of seg_ptr to fill next field if another segment is created */

	if fixed_common.seg_info ^= "00000"
	then fixed_common.seg_info = common_key;

	next_loc_used = 0;

	go to this_seg_ok;

     end;

declare	(mod, divide, substr, index, addr)
			builtin;

declare	cobol_c_list	entry (ptr);

declare	(descr_ptr, inf_ptr)
			ptr;
declare	description	(64) bit (1) based (descr_ptr);
declare	inf		bit (8) based (inf_ptr);
declare	1 indicators,
	  2 rdf_illegal	bit (1),
	  2 rparen	bit (1);
declare	(trial, req_sub)	fixed bin (24);
declare	(dir_num, stack_loc)
			fixed bin (24);
declare	(link1, link2)	fixed bin (24);

declare	(section_number, check_res)
			fixed bin;

%include cobol_ext_;
%include cobol_io_info;
declare	1 reserved_word	based (input_ptr),
%include cobol_TYPE1;

declare	1 numeric_lit	based (input_ptr),
%include cobol_TYPE2;

declare	1 data_name	based (input_ptr),
%include cobol_TYPE9;

%include cobol_occurs;

declare	1 index_name	based (input_ptr),
%include cobol_TYPE10;

declare	1 proc_def	based (input_ptr),
%include cobol_TYPE7;

declare	1 alphanum_lit	based (input_ptr),
%include cobol_TYPE3;

%include cobol_ciphase_data;

%include cobol_fixed_common;
%include cobol_common_data;
     end cobol_ci_phase;




		    cobol_class_table_.alm          11/11/82  1507.2rew 11/11/82  1030.5      172377



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

	name	cobol_class_table_
	entry	cobol_class_table_
cobol_class_table_:	save
	epp2	cobol_class_table_
	spri2	ap|2,*
	return
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_18-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_61-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_2-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_16-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_21-cobol_class_table_
          vfd 18/c_23-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_30-cobol_class_table_
          vfd 18/c_29-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_33-cobol_class_table_
          vfd 18/c_0,18/c_34-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_36-cobol_class_table_,18/c_37-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_38-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_40-cobol_class_table_,18/c_0
          vfd 18/c_44-cobol_class_table_,18/c_46-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_50-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_67-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_1-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_13-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_3-cobol_class_table_
          vfd 18/c_0,18/c_4-cobol_class_table_
          vfd 18/c_9-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_20-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_31-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_35-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_43-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_49-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_53-cobol_class_table_,18/c_0
          vfd 18/c_55-cobol_class_table_,18/c_56-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_62-cobol_class_table_,18/c_0
          vfd 18/c_64-cobol_class_table_,18/c_65-cobol_class_table_
          vfd 18/c_66-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_14-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_59-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_45-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_5-cobol_class_table_,18/c_6-cobol_class_table_
          vfd 18/c_0,18/c_7-cobol_class_table_
          vfd 18/c_0,18/c_8-cobol_class_table_
          vfd 18/c_0,18/c_10-cobol_class_table_
          vfd 18/c_0,18/c_11-cobol_class_table_
          vfd 18/c_12-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_15-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_17-cobol_class_table_,18/c_19-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_22-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_24-cobol_class_table_,18/c_26-cobol_class_table_
          vfd 18/c_25-cobol_class_table_,18/c_0
          vfd 18/c_27-cobol_class_table_,18/c_28-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_32-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_39-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_41-cobol_class_table_,18/c_42-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_47-cobol_class_table_,18/c_48-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_51-cobol_class_table_,18/c_52-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_54-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_57-cobol_class_table_,18/c_58-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_60-cobol_class_table_,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_63-cobol_class_table_
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
          vfd 18/c_0,18/c_0
                  equ c_0,0
c_1:
        vfd 9/1,9/0,9/1,9/0,9/0,9/0
c_2:
        vfd 9/0,9/0,9/0,9/0,9/5,9/0
c_3:
        vfd 9/0,9/0,9/7,9/0,9/0,9/0
c_4:
        vfd 9/0,9/0,9/0,9/0,9/0,9/19
c_5:
        vfd 9/0,9/0,9/0,9/5,9/0,9/0
c_6:
        vfd 9/0,9/0,9/0,9/3,9/0,9/0
c_7:
        vfd 9/2,9/0,9/0,9/0,9/0,9/0
c_8:
        vfd 9/0,9/0,9/10,9/0,9/0,9/0
c_9:
        vfd 9/0,9/0,9/0,9/0,9/0,9/15
c_10:
        vfd 9/0,9/0,9/0,9/0,9/0,9/3
c_11:
        vfd 9/3,9/0,9/0,9/10,9/0,9/0
c_12:
        vfd 9/3,9/0,9/0,9/0,9/0,9/0
c_13:
        vfd 9/0,9/0,9/0,9/0,9/0,9/10
c_14:
        vfd 9/0,9/0,9/0,9/0,9/0,9/20
c_15:
        vfd 9/0,9/0,9/0,9/4,9/0,9/0
c_16:
        vfd 9/0,9/0,9/0,9/0,9/0,9/18
c_17:
        vfd 9/0,9/0,9/0,9/11,9/0,9/0
c_18:
        vfd 9/0,9/0,9/5,9/0,9/0,9/0
c_19:
        vfd 9/0,9/0,9/0,9/0,9/0,9/2
c_20:
        vfd 9/0,9/0,9/0,9/0,9/0,9/24
c_21:
        vfd 9/0,9/0,9/0,9/0,9/0,9/12
c_22:
        vfd 9/0,9/0,9/0,9/0,9/0,9/8
c_23:
        vfd 9/0,9/2,9/0,9/0,9/0,9/0
c_24:
        vfd 9/0,9/4,9/0,9/0,9/0,9/0
c_25:
        vfd 9/0,9/0,9/8,9/0,9/0,9/0
c_26:
        vfd 9/0,9/1,9/0,9/0,9/0,9/0
c_27:
        vfd 9/0,9/0,9/0,9/0,9/0,9/9
c_28:
        vfd 9/0,9/0,9/0,9/0,9/0,9/1
c_29:
        vfd 9/0,9/0,9/0,9/0,9/0,9/7
c_30:
        vfd 9/0,9/0,9/5,9/0,9/0,9/0
c_31:
        vfd 9/0,9/0,9/9,9/0,9/0,9/0
c_32:
        vfd 9/0,9/3,9/0,9/0,9/0,9/0
c_33:
        vfd 9/0,9/0,9/15,9/0,9/0,9/0
c_34:
        vfd 9/0,9/0,9/2,9/0,9/0,9/0
c_35:
        vfd 9/0,9/0,9/0,9/0,9/0,9/14
c_36:
        vfd 9/0,9/0,9/0,9/0,9/2,9/0
c_37:
        vfd 9/0,9/0,9/3,9/0,9/0,9/0
c_38:
        vfd 9/0,9/0,9/0,9/0,9/4,9/0
c_39:
        vfd 9/0,9/0,9/0,9/0,9/0,9/5
c_40:
        vfd 9/4,9/0,9/0,9/9,9/0,9/0
c_41:
        vfd 9/0,9/0,9/0,9/6,9/0,9/0
c_42:
        vfd 9/0,9/0,9/0,9/2,9/0,9/0
c_43:
        vfd 9/0,9/0,9/11,9/0,9/0,9/0
c_44:
        vfd 9/0,9/0,9/0,9/0,9/1,9/0
c_45:
        vfd 9/0,9/0,9/6,9/0,9/0,9/0
c_46:
        vfd 9/0,9/0,9/0,9/0,9/0,9/17
c_47:
        vfd 9/0,9/0,9/0,9/0,9/0,9/26
c_48:
        vfd 9/0,9/0,9/0,9/0,9/0,9/22
c_49:
        vfd 9/0,9/0,9/0,9/8,9/0,9/16
c_50:
        vfd 9/0,9/0,9/0,9/0,9/0,9/25
c_51:
        vfd 9/0,9/0,9/0,9/7,9/0,9/0
c_52:
        vfd 9/0,9/0,9/0,9/1,9/0,9/0
c_53:
        vfd 9/0,9/0,9/0,9/0,9/0,9/23
c_54:
        vfd 9/0,9/0,9/0,9/0,9/0,9/21
c_55:
        vfd 9/0,9/0,9/15,9/0,9/0,9/0
c_56:
        vfd 9/0,9/0,9/12,9/0,9/0,9/0
c_57:
        vfd 9/0,9/0,9/0,9/0,9/0,9/4
c_58:
        vfd 9/0,9/0,9/0,9/0,9/0,9/6
c_59:
        vfd 9/0,9/0,9/0,9/0,9/0,9/11
c_60:
        vfd 9/0,9/0,9/14,9/0,9/0,9/0
c_61:
        vfd 9/0,9/0,9/0,9/0,9/0,9/27
c_62:
        vfd 9/0,9/0,9/15,9/0,9/0,9/0
c_63:
        vfd 9/0,9/0,9/4,9/0,9/0,9/0
c_64:
        vfd 9/0,9/0,9/5,9/0,9/0,9/0
c_65:
        vfd 9/0,9/0,9/13,9/0,9/0,9/0
c_66:
        vfd 9/0,9/0,9/0,9/0,9/0,9/13
c_67:
        vfd 9/0,9/0,9/0,9/0,9/3,9/0
	end




		    cobol_cmnio.pl1                 05/24/89  1044.4rew 05/24/89  0833.0       26487



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_cmnio.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Created on 02/09/77 by ORN */

/* format: style3 */
cobol_cmnio:
     proc;

dcl	rp		ptr parameter;
dcl	rk		char (5) aligned parameter;
dcl	rl		fixed bin parameter;
dcl	eof		fixed bin parameter;
dcl	eof1		fixed bin parameter;

dcl	rkb		fixed bin based (addr (rk));
dcl	str		char (rl) based;
dcl	vp		ptr;
dcl	vstr		char (rl) based (vp);

dcl	1 vhdr		based (cobol_ext_$cobol_cmfp) aligned,
	  2 fill		char (8),
	  2 next_get	fixed bin,
	  2 next_put	fixed bin,
	  2 code		fixed bin;


/*************************************/
dget:
     entry (rp, rl, rk);
	rp = pointer (cobol_ext_$cobol_cmfp, rkb);
	vhdr.next_get = rkb + 1 + divide (rl + 11, 4, 35, 0);
	return;

/**************************************/
sget:
     entry (rp, rl, eof);
	vp = pointer (cobol_ext_$cobol_cmfp, vhdr.next_get);
	if length (vstr) <= 0
	then eof = 1;
	else do;
		rp = addrel (vp, 1);
		rl = length (vstr);
		vhdr.next_get = vhdr.next_get + divide (rl + 11, 4, 35, 0);
	     end;
	return;

/**************************************/
sget_key:
     entry (rp, rl, rk, eof1);
	vp = pointer (cobol_ext_$cobol_cmfp, vhdr.next_get);
	if length (vstr) <= 0
	then eof = 1;
	else do;
		rp = addrel (vp, 1);
		rl = length (vstr);
		rk = "";
		rkb = vhdr.next_get;
		vhdr.next_get = vhdr.next_get + divide (rl + 11, 4, 35, 0);
	     end;
	return;

/**************************************/
dput:
     entry (rp, rl, rk);
	pointer (cobol_ext_$cobol_cmfp, rkb) -> str = rp -> str;
	return;

/**************************************/
sput:
     entry (rp, rl);
	pointer (cobol_ext_$cobol_cmfp, vhdr.next_put) -> str = rp -> str;
	vhdr.next_put = vhdr.next_put + divide (rl + 11, 4, 35, 0);
	return;

/**************************************/
sput_key:
     entry (rp, rl, rk);
	pointer (cobol_ext_$cobol_cmfp, vhdr.next_put) -> str = rp -> str;
	rk = "";
	rkb = vhdr.next_put;
	vhdr.next_put = vhdr.next_put + divide (rl + 11, 4, 35, 0);
	return;

%include cobol_ext_;

     end cobol_cmnio;




		    cobol_compare_values.pl1        05/24/89  1044.4rew 05/24/89  0833.0      100800



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_compare_values.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 08/02/76 by ORN to allow for user-defined alphabets */
/* Modified on 2/3/76 by John O'Neil to make ascii the default collating sequence and eliminate call to
	cobol_est_cs_table (routine no longer needed). */

/* format: style3 */
cobol_compare_values:
     proc (v1ptr, v2ptr, dnlength, char_tbl_ptr) returns (fixed bin (15));

/* This procedure compares two initial value extensions on a level 88 item
   to determine that the second is greater than the first */




dcl	cobol_read_rand_$fixed_bin
			entry (fixed bin, fixed bin, ptr);

/*************************************/
start:
	status = 0;
	first = "1"b;
	first_is_zero = "0"b;
	first_is_num = "0"b;
	coll_seq_on = "0"b;
	if fixed_common.prog_coll_seq ^= 0
	then do;					/* if not native, i.e. ASCII */
						/*-08/02/76-*/
		call cobol_read_rand_$fixed_bin (2, fixed_common.prog_coll_seq, alpha_name_ptr);
						/*-08/02/76-*/
		cst_ptr = addr (alphabet_name.table);	/*-08/02/76-*/
		coll_seq_on = "1"b;
	     end;
	if substr (v1ptr -> any_init.type, 1, 1)
	then do;
		first_is_num = "1"b;
		goto setup_num;
	     end;
	if substr (v1ptr -> any_init.type, 3, 1) & substr (v1ptr -> any_init.info, 2, 7) = "0000001"b
	then first_is_zero = "1"b;

get_second:
	first = "0"b;
	if substr (v2ptr -> any_init.type, 1, 1)
	then do;
		if first_is_num | first_is_zero
		then goto comp_num;
		else goto retrn;
	     end;
	if substr (v2ptr -> any_init.type, 3, 1) & substr (v2ptr -> any_init.info, 2, 7) = "0000001"b
	then do;
		if substr (v1ptr -> any_init.type, 1, 1)
		     | (substr (v1ptr -> any_init.type, 3, 1) & substr (v1ptr -> any_init.info, 2, 7) = "0000001"b)
		then goto comp_num;
	     end;

	if substr (v2ptr -> any_init.type, 2, 1)
	then do;
		if ^first_is_num
		then goto comp_non_num;
		else goto retrn;
	     end;

comp_non_num:
	first_time_in_compare = "1"b;
	rcode = "0"b;

get_call:
	call get_char;

/********************/
get_char:
     proc;

/*This procedure gets the next characters to be compared in a
comparison between a pair of condition values. Operands
may be alphanumeric literals or figurative constants*/

dcl	max_sofar		fixed bin (31);		/*maximum number of characters that have to be
			   compared*/
dcl	sofar		fixed bin (31);		/*number of characters that have been compared*/
dcl	item_index	fixed bin (15);		/*in the following dcl, implicit ptr qualification
			  is required for references to the string subfield*/
dcl	1 a_init		based (v3ptr),
	  2 type		bit (8),
	  2 info		bit (8),
	  2 length	fixed bin (15),
	  2 string	char (a_init.length);

dcl	l		fixed bin (7);

	if first_time_in_compare
	then do;
		if substr (v1ptr -> a_init.type, 4, 1)
		then goto all_1;
		if substr (v1ptr -> a_init.type, 3, 1)
		then goto fig_1;
		goto alpha_1;

alpha_1:
		if substr (v2ptr -> a_init.type, 4, 1)
		then goto alpha_all;
		if substr (v2ptr -> a_init.type, 3, 1)
		then goto alpha_fig;
		goto alpha_alpha;

fig_1:
		if substr (v2ptr -> a_init.type, 4, 1)
		then goto fig_all;
		if substr (v2ptr -> a_init.type, 3, 1)
		then goto fig_fig;
		goto fig_alpha;

all_1:
		if substr (v2ptr -> a_init.type, 4, 1)
		then goto all_all;
		if substr (v2ptr -> a_init.type, 3, 1)
		then goto all_fig;
		goto all_alpha;

all_alpha:
		;
alpha_all:
		;
alpha_alpha:
		if v1ptr -> a_init.length > v2ptr -> a_init.length
		then max_sofar = v1ptr -> a_init.length;
		else max_sofar = v2ptr -> a_init.length;
		goto out;

alpha_fig:
		;
all_fig:
		max_sofar = v1ptr -> a_init.length;
		goto out;


fig_alpha:
		;
fig_all:
		max_sofar = v2ptr -> a_init.length;
		goto out;

fig_fig:
		max_sofar = 1;
		goto out;

all_all:
		max_sofar = v1ptr -> a_init.length * v2ptr -> a_init.length;

out:
		sofar = 0;
		item.field_index (1) = 0;
		item.field_index (2) = 0;
		if ^substr (v1ptr -> a_init.type, 3, 1)
		then item.length (1) = v1ptr -> a_init.length;
		if ^substr (v2ptr -> a_init.type, 3, 1)
		then item.length (2) = v2ptr -> a_init.length;
	     end;
	if sofar > max_sofar
	then do;
		rcode = "1"b;
		goto retrn;
	     end;
	sofar = sofar + 1;

	v3ptr = v1ptr;
	item_ptr1 = addr (item (1));

start:
	if substr (v3ptr -> a_init.type, 4, 1)
	then goto all_lit;
	if substr (v3ptr -> a_init.type, 2, 1)
	then goto alpha;

fig_con:
	if first_time_in_compare
	then do;
		l = fixed (substr (v3ptr -> any_init.info, 2, 7), 15);
		itemb.char = char_tbl (l);
	     end;
	goto got_char;

all_lit:
	if itemb.field_index = itemb.length
	then itemb.field_index = 0;
	itemb.field_index = itemb.field_index + 1;
	itemb.char = substr (v3ptr -> a_init.string, itemb.field_index, 1);
	goto got_char;

alpha:
	if itemb.field_index = itemb.length
	then do;
		itemb.char = " ";
		goto got_char;
	     end;
	itemb.field_index = itemb.field_index + 1;
	itemb.char = substr (v3ptr -> a_init.string, itemb.field_index, 1);
	goto got_char;

got_char:
	if v3ptr = v1ptr
	then do;
		v3ptr = v2ptr;
		item_ptr1 = addr (item (2));
		goto start;
	     end;

retrn:
     end get_char;
/********************/

	first_time_in_compare = "0"b;
	if rcode
	then goto issue_equal_diag;
	if item.char (1) = item.char (2)
	then goto get_call;
	if coll_seq_on
	then do;
		item.char (1) = coll_seq_tbl (fixed (unspec (item.char (1)), 17));
		item.char (2) = coll_seq_tbl (fixed (unspec (item.char (2)), 17));
	     end;
	if item.char (1) > item.char (2)
	then goto issue_lt_diag;
	goto retrn;

setup_num:					/*set up num struc for first operand*/
	call make_num (v1ptr, 1);
	goto get_second;

comp_num:
	call make_num (v2ptr, 2);
	if first_is_zero
	then call make_num (v1ptr, 1);

/********************/
make_num:
     proc (v4ptr, num_index);

/*This procedure sets up the work structure num from an
initial value extension for numeric literal or fig con zero */

dcl	v4ptr		ptr;			/*in the following dcl, implicit ptr qualification
			  is required for references to the string subfield*/
dcl	1 n_init		based (v4ptr),
	  2 type		bit (8),
	  2 info		bit (8),
	  2 sign		char (1),
	  2 expsign	char (1),
	  2 explaces	fixed bin (7),
	  2 places_left	fixed bin (7),
	  2 places_right	fixed bin (7),
	  2 length	fixed bin (7),
	  2 string	char (n_init.length);

dcl	lit_count		fixed bin (15);
dcl	fld_count		fixed bin (15);
dcl	num_index		fixed bin (15);
dcl	pnt		bit (1);
dcl	sigdig		bit (1);



	num_ptr1 = addr (num (num_index));

	num_ptr1 -> numb.sign = "+";
	num_ptr1 -> numb.exp = 0;
	num_ptr1 -> numb.compfld = "000000000000000000000000000000";

	if substr (v4ptr -> n_init.type, 1, 1)
	then goto numeric_ext;			/*fig con zero*/
	if num_index = 1
	then num_ptr2 = addr (num (2));
	else num_ptr2 = addr (num (1));
	num_ptr1 -> numb.sign = num_ptr2 -> numb.sign;
	num_ptr1 -> numb.exp = num_ptr2 -> numb.exp;
	goto retrn;

numeric_ext:
	lit_count = 1;
	fld_count = 1;
	pnt = "0"b;
	sigdig = "0"b;
	num_ptr1 -> numb.sign = v4ptr -> n_init.sign;
	if num_ptr1 -> numb.sign = " "
	then num_ptr1 -> numb.sign = "+";

select_char:
	if substr (v4ptr -> n_init.string, lit_count, 1) >= "1" & substr (v4ptr -> n_init.string, lit_count, 1) <= "9"
	then do;
		sigdig = "1"b;
		if ^pnt
		then num_ptr1 -> numb.exp = num_ptr1 -> numb.exp + 1;
		substr (num_ptr1 -> numb.compfld, fld_count, 1) = substr (v4ptr -> n_init.string, lit_count, 1);
		fld_count = fld_count + 1;
		goto increment_count;
	     end;
	if substr (v4ptr -> n_init.string, lit_count, 1) = "0"
	then do;
		if sigdig
		then do;
			substr (num_ptr1 -> numb.compfld, fld_count, 1) = "0";
			if ^pnt
			then num_ptr1 -> numb.exp = num_ptr1 -> numb.exp + 1;
			fld_count = fld_count + 1;
		     end;
		else if pnt
		then num_ptr1 -> numb.exp = num_ptr1 -> numb.exp + 1;
		goto increment_count;
	     end;
	if substr (v4ptr -> n_init.string, lit_count, 1) = "."
	then do;
		pnt = "1"b;
		goto increment_count;
	     end;

/*falls through if not a "0123456789."*/
increment_count:
	lit_count = lit_count + 1;
	if lit_count > v4ptr -> n_init.length
	then goto retrn;
	goto select_char;

retrn:
	;
     end make_num;
/********************/

	if num.sign (1) ^= num.sign (2)
	then do;
		if num.sign (2) ^= "+"
		then goto issue_lt_diag;		/*signs are different and opnd 2 is positive*/
		goto retrn;
	     end;
	if num.sign (1) = "+"
	then do;
		num_index1 = 1;
		num_index2 = 2;
	     end;
	else do;
		num_index1 = 2;
		num_index2 = 1;
	     end;
	if num.exp (num_index2) < num.exp (num_index1)
	then goto issue_lt_diag;
	if num.exp (num_index2) > num.exp (num_index1)
	then goto retrn;				/*exponents are equal, signs are equal, num_index1  indexes whichever
should be the lesser of the pair according to the sign*/
	if num.compfld (num_index2) > num.compfld (num_index1)
	then goto retrn;
issue_equal_diag:
	;
issue_lt_diag:
	status = 181;
	goto retrn;
retrn:
	return (status);



dcl	v1ptr		ptr;			/*ads->first extension*/
dcl	v2ptr		ptr;			/*ads->second extension*/
dcl	v3ptr		ptr;			/*ads->init val ext for get_char*/
dcl	first		bit (1);
dcl	first_is_zero	bit (1);
dcl	first_is_num	bit (1);
dcl	dnlength		fixed bin (31);		/*input: length of conditional variable (bytes)*/
dcl	char_tbl_ptr	ptr;
dcl	char_tbl		(7) char (1) based (char_tbl_ptr);
dcl	1 any_init	based (v3ptr),
	  2 type		bit (8),
	  2 info		bit (8);
dcl	1 a_init		based (v3ptr),
	  2 type		bit (8),
	  2 info		bit (8),
	  2 length	fixed bin (15),
	  2 string	char (a_init.length);
dcl	num_index1	fixed bin (15);
dcl	num_index2	fixed bin (15);
dcl	first_time_in_compare
			bit (1);
dcl	status		fixed bin (15);		/*return value: zero or diag number*/
dcl	rcode		bit (1);
dcl	1 num		(2),
	  2 sign		char (1),
	  2 exp		fixed bin (15),
	  2 compfld	char (30);

dcl	num_ptr1		ptr,
	num_ptr2		ptr;
dcl	1 numb		based (num_ptr1),
	  2 sign		char (1),
	  2 exp		fixed bin (15),
	  2 compfld	char (30);

dcl	1 item		(2),
	  2 length	fixed bin (31),
	  2 field_index	fixed bin (31),
	  2 char		char (1);
dcl	item_ptr1		ptr,
	item_ptr2		ptr;
dcl	1 itemb		based (item_ptr1),		/*not always*/
	  2 length	fixed bin (31),
	  2 field_index	fixed bin (31),
	  2 char		char (1);
dcl	cst_ptr		ptr;
dcl	coll_seq_tbl	(0:511) char (1) based (cst_ptr);
dcl	coll_seq_on	bit (1);

dcl	addr		builtin;
dcl	fixed		builtin;
dcl	null		builtin;
dcl	substr		builtin;
dcl	unspec		builtin;


%include cobol_ext_;
%include cobol_fixed_common;
%include cobol_type40;

     end cobol_compare_values;




		    cobol_db.alm                    05/24/89  1044.4rew 05/24/89  0837.3      971478



" ***********************************************************
" *                                                         *
" * Copyright, (C) BULL HN Information Systems Inc., 1989   *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1985 *
" *                                                         *
" ***********************************************************

" HISTORY COMMENTS:
"  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8082),
"     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
"     MCR8082 cobol_db.alm Fix wild array subscript.
"                                                      END HISTORY COMMENTS


name	cobol_db
	entry	cobol_db
cobol_db:	save
	epp2	cobol_db
	spri2	ap|2,*
	return
		equ i_r,0
		equ i_c,1
		equ i_s,3
		equ i_n,2
		equ i_k,4
		equ i_K,5
		equ l_org,*-5
	fake1:	vfd a36/    ,36/i_n,36/0,36/(accept-l_org)/5,36/0
	fake2:	vfd a36/    ,36/i_n,36/0,36/(add-l_org)/5,36/0
	fake3:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake4:	vfd a36/    ,36/i_n,36/0,36/(alter-l_org)/5,36/0
	fake5:	vfd a36/    ,36/i_n,36/0,36/(call-l_org)/5,36/0
	fake6:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake7:	vfd a36/    ,36/i_n,36/0,36/(cancel-l_org)/5,36/0
	fake8:	vfd a36/    ,36/i_n,36/0,36/(close-l_org)/5,36/0
	fake9:	vfd a36/    ,36/i_n,36/0,36/(divide-l_org)/5,36/0
	fake10:	vfd a36/    ,36/i_n,36/0,36/(multiply-l_org)/5,36/0
	fake11:	vfd a36/    ,36/i_n,36/0,36/(subtract-l_org)/5,36/0
	fake12:	vfd a36/    ,36/i_n,36/0,36/(exit-l_org)/5,36/0
	fake13:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake14:	vfd a36/    ,36/i_n,36/0,36/(go-l_org)/5,36/0
	fake15:	vfd a36/    ,36/i_n,36/0,36/(merge-l_org)/5,36/0
	fake16:	vfd a36/    ,36/i_n,36/0,36/(initiate-l_org)/5,36/0
	fake17:	vfd a36/    ,36/i_n,36/0,36/(inspect-l_org)/5,36/0
	fake18:	vfd a36/    ,36/i_n,36/0,36/(move-l_org)/5,36/0
	fake19:	vfd a36/    ,36/i_n,36/0,36/(open-l_org)/5,36/0
	fake20:	vfd a36/    ,36/i_n,36/0,36/(perform-l_org)/5,36/0
	fake21:	vfd a36/    ,36/i_n,36/0,36/(read-l_org)/5,36/0
	fake22:	vfd a36/    ,36/i_n,36/0,36/(delete-l_org)/5,36/0
	fake23:	vfd a36/    ,36/i_n,36/0,36/(receive-l_org)/5,36/0
	fake24:	vfd a36/    ,36/i_n,36/0,36/(release-l_org)/5,36/0
	fake25:	vfd a36/    ,36/i_n,36/0,36/(return-l_org)/5,36/0
	fake26:	vfd a36/    ,36/i_n,36/0,36/(search-l_org)/5,36/0
	fake27:	vfd a36/    ,36/i_n,36/0,36/(rewrite-l_org)/5,36/0
	fake28:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake29:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake30:	vfd a36/    ,36/i_n,36/0,36/(send-l_org)/5,36/0
	fake31:	vfd a36/    ,36/i_n,36/0,36/(set-l_org)/5,36/0
	fake32:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake33:	vfd a36/    ,36/i_n,36/0,36/(stop-l_org)/5,36/0
	fake34:	vfd a36/    ,36/i_n,36/0,36/(string-l_org)/5,36/0
	fake35:	vfd a36/    ,36/i_n,36/0,36/(suspend-l_org)/5,36/0
	fake36:	vfd a36/    ,36/i_n,36/0,36/(terminate-l_org)/5,36/0
	fake37:	vfd a36/    ,36/i_n,36/0,36/(unstring-l_org)/5,36/0
	fake38:	vfd a36/    ,36/i_n,36/0,36/(write-l_org)/5,36/0
	fake39:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake40:	vfd a36/    ,36/i_n,36/0,36/(compute-l_org)/5,36/0
	fake41:	vfd a36/    ,36/i_n,36/0,36/(disable-l_org)/5,36/0
	fake42:	vfd a36/    ,36/i_n,36/0,36/(display-l_org)/5,36/0
	fake43:	vfd a36/    ,36/i_n,36/0,36/(enable-l_org)/5,36/0
	fake44:	vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake45:	vfd a36/    ,36/i_n,36/0,36/(generate-l_org)/5,36/0
	fake46:	vfd a36/    ,36/i_n,36/0,36/(hold-l_org)/5,36/0
	fake47:	vfd a36/    ,36/i_n,36/0,36/(if-l_org)/5,36/0
	fake48:	vfd a36/    ,36/i_n,36/0,36/(process-l_org)/5,36/0
	fake49:	vfd a36/    ,36/i_n,36/0,36/(sort-l_org)/5,36/0
	fake50:	vfd a36/    ,36/i_n,36/0,36/(examine-l_org)/5,36/0
	fake51:	vfd a36/    ,36/i_n,36/0,36/(transform-l_org)/5,36/0
	fake52:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake53:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake54:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake55:	vfd a36/s   ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	fake56:	vfd a36/    ,36/i_n,36/0,36/(start-l_org)/5,36/0
	fake57:	vfd a36/    ,36/i_n,36/0,36/(suppress-l_org)/5,36/0
	fake58:	vfd a36/    ,36/i_n,36/0,36/(purge-l_org)/5,36/0
l_1:		vfd a36/s   ,36/i_r,36/r_procedure,36/(l_2-l_org)/5,36/a_34
		vfd a36/    ,36/i_n,36/0,36/(r_1-l_org)/5,36/0
l_2:		vfd a36/s   ,36/i_r,36/r_division,36/(l_3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_1-l_org)/5,36/0
l_3:		vfd a36/s   ,36/i_r,36/r_using,36/(l_4-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_per,36/(decl-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(decl-l_org)/5,36/0
l_4:		vfd a36/s   ,36/i_c,36/c_lident,36/(l_5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_1-l_org)/5,36/0
l_5:		vfd a36/s   ,36/i_c,36/c_lident,36/(l_5-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_per,36/(l_6-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_6-l_org)/5,36/0
l_6:	decl:	vfd a36/    ,36/i_n,36/0,36/(l_7-l_org)/5,36/a_eos
l_7:		vfd a36/s   ,36/i_n,36/0,36/(l_8-l_org)/5,36/a_35
l_8:		vfd a36/s   ,36/i_r,36/r_declaratives,36/(l_9-l_org)/5,36/a_106
		vfd a36/    ,36/i_n,36/0,36/(nodecl-l_org)/5,36/a_107
l_9:		vfd a36/s   ,36/i_r,36/r_per,36/(l_10-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_10-l_org)/5,36/0
l_10:		vfd a36/    ,36/i_n,36/0,36/(l_11-l_org)/5,36/a_eos
l_11:		vfd a36/s   ,36/i_c,36/c_enddec,36/(l_12-l_org)/5,36/a_107
		vfd a36/    ,36/i_s,36/(decl_sect-l_org)/5,36/(nodecl-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_6-l_org)/5,36/0
l_12:		vfd a36/s   ,36/i_n,36/0,36/(l_13-l_org)/5,36/0
l_13:	nodecl:	vfd a36/    ,36/i_c,36/c_sechdr,36/(nod_1-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_paranm,36/(nod_3-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_endcob,36/(l_14-l_org)/5,36/a_24
		vfd a36/    ,36/i_n,36/0,36/(r_3-l_org)/5,36/0
l_14:	endcob:	vfd a36/s   ,36/i_n,36/0,36/(l_15-l_org)/5,36/0
l_15:		vfd a36/s   ,36/i_r,36/r_per,36/(l_16-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_16-l_org)/5,36/0
l_16:		vfd a36/    ,36/i_n,36/0,36/(l_17-l_org)/5,36/a_eos
l_17:		vfd a36/    ,36/i_c,36/c_cktp25,36/(l_18-l_org)/5,36/a_25
l_18:		vfd a36/    ,36/i_n,36/0,36/(l_18-l_org)/5,36/a_endjob
	nod_1:	vfd a36/    ,36/i_s,36/(sechdr-l_org)/5,36/(l_19-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_3-l_org)/5,36/0
l_19:		vfd a36/    ,36/i_s,36/(para-l_org)/5,36/(l_19-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_sechdr,36/(nod_1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_endcob,36/(l_20-l_org)/5,36/a_24
		vfd a36/    ,36/i_n,36/0,36/(r_3-l_org)/5,36/0
l_20:		vfd a36/    ,36/i_n,36/0,36/(endcob-l_org)/5,36/a_eos
	nod_3:	vfd a36/    ,36/i_s,36/(para-l_org)/5,36/(nod_3-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_sechdr,36/(nod_1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_endcob,36/(endcob-l_org)/5,36/a_24
		vfd a36/    ,36/i_n,36/0,36/(r_3-l_org)/5,36/0
	decl_sect:	vfd a36/    ,36/i_c,36/c_sechdr,36/(ds_2-l_org)/5,36/a_62
		vfd a36/s   ,36/i_c,36/c_enddec,36/(ds_1-l_org)/5,36/a_23
		vfd a36/    ,36/i_c,36/c_endcob,36/(l_21-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_4-l_org)/5,36/0
l_21:		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/a_eos
	ds_2:	vfd a36/    ,36/i_s,36/(sechdr-l_org)/5,36/(l_22-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_4-l_org)/5,36/0
l_22:		vfd a36/    ,36/i_s,36/(decl_sent-l_org)/5,36/(l_23-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_4-l_org)/5,36/0
l_23:		vfd a36/    ,36/i_s,36/(para-l_org)/5,36/(l_23-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(decl_sect-l_org)/5,36/0
	ds_1:	vfd a36/s   ,36/i_n,36/0,36/(l_24-l_org)/5,36/0
l_24:		vfd a36/s   ,36/i_r,36/r_per,36/(l_25-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_25-l_org)/5,36/0
l_25:		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/a_eos
	sechdr:	vfd a36/s   ,36/i_c,36/c_sechdr,36/(l_26-l_org)/5,36/a_12
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_26:		vfd a36/s   ,36/i_r,36/r_section,36/(l_27-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_27:		vfd a36/s   ,36/i_c,36/c_numlit,36/(l_28-l_org)/5,36/0
l_28:		vfd a36/s   ,36/i_r,36/r_per,36/(l_29-l_org)/5,36/0
l_29:		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/a_eos
	para:	vfd a36/s   ,36/i_c,36/c_paranm,36/(l_30-l_org)/5,36/a_14
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_30:		vfd a36/s   ,36/i_r,36/r_per,36/(l_31-l_org)/5,36/0
l_31:		vfd a36/    ,36/i_n,36/0,36/(l_32-l_org)/5,36/a_eos
l_32:		vfd a36/s   ,36/i_r,36/r_go,36/(goto-l_org)/5,36/a_61
		vfd a36/s   ,36/i_r,36/r_exit,36/(ex-l_org)/5,36/a_61
		vfd a36/    ,36/i_c,36/c_verb,36/(para_1-l_org)/5,36/0
	para_2:	vfd a36/    ,36/i_c,36/c_paranm,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_sechdr,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_enddec,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_endcob,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_7-l_org)/5,36/0
	para_1:	vfd a36/    ,36/i_s,36/(verb-l_org)/5,36/(l_33-l_org)/5,36/0
l_33:		vfd a36/s   ,36/i_r,36/r_per,36/(l_34-l_org)/5,36/a_18
l_34:		vfd a36/    ,36/i_n,36/0,36/(l_35-l_org)/5,36/a_eos
l_35:		vfd a36/    ,36/i_c,36/c_verb,36/(para_1-l_org)/5,36/0
	para_3:	vfd a36/s   ,36/i_r,36/r_per,36/(l_36-l_org)/5,36/a_18
		vfd a36/    ,36/i_n,36/0,36/(l_36-l_org)/5,36/0
l_36:		vfd a36/    ,36/i_n,36/0,36/(para_2-l_org)/5,36/a_eos
	goto:	vfd a36/s   ,36/i_r,36/r_to,36/(l_37-l_org)/5,36/0
l_37:		vfd a36/s   ,36/i_c,36/c_prnm,36/(l_38-l_org)/5,36/a_122
		vfd a36/    ,36/i_n,36/0,36/(para_4-l_org)/5,36/a_19
l_38:		vfd a36/s   ,36/i_c,36/c_prnm,36/(l_39-l_org)/5,36/a_122
		vfd a36/    ,36/i_n,36/0,36/(para_4-l_org)/5,36/a_58
l_39:		vfd a36/s   ,36/i_c,36/c_prnm,36/(l_39-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_depending,36/(l_40-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_5-l_org)/5,36/0
l_40:		vfd a36/s   ,36/i_r,36/r_on,36/(l_41-l_org)/5,36/0
l_41:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(para_4-l_org)/5,36/a_20
		vfd a36/    ,36/i_n,36/0,36/(r_5-l_org)/5,36/0
	ex:	vfd a36/s   ,36/i_r,36/r_program,36/(para_4-l_org)/5,36/a_21
		vfd a36/    ,36/i_n,36/0,36/(para_4-l_org)/5,36/a_21
	para_4:	vfd a36/    ,36/i_n,36/0,36/(para_3-l_org)/5,36/a_eos
	decl_sent:	vfd a36/    ,36/i_r,36/r_use,36/(l_42-l_org)/5,36/a_26
		vfd a36/    ,36/i_n,36/0,36/(r_5-l_org)/5,36/0
l_42:		vfd a36/s2  ,36/i_n,36/219,36/(l_43-l_org)/5,36/11
l_43:		vfd a36/s   ,36/i_r,36/r_after,36/(ds_5-l_org)/5,36/a_55
		vfd a36/s   ,36/i_r,36/r_before,36/(ds_6-l_org)/5,36/a_55
		vfd a36/    ,36/i_r,36/r_debugging,36/(ds_10-l_org)/5,36/a_17
		vfd a36/s   ,36/i_r,36/r_for,36/(l_44-l_org)/5,36/a_17
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_44:		vfd a36/    ,36/i_r,36/r_debugging,36/(l_45-l_org)/5,36/a_88
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_45:	ds_10:	vfd a36/s   ,36/i_n,36/0,36/(l_46-l_org)/5,36/0
l_46:		vfd a36/s   ,36/i_r,36/r_on,36/(l_47-l_org)/5,36/0
l_47:		vfd a36/    ,36/i_s,36/(dbt-l_org)/5,36/(l_48-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_48:		vfd a36/    ,36/i_s,36/(dbt-l_org)/5,36/(l_48-l_org)/5,36/0
	ds_14:	vfd a36/s   ,36/i_r,36/r_per,36/(l_49-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_49-l_org)/5,36/0
l_49:		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/a_eos
	ds_5:	vfd a36/s   ,36/i_r,36/r_standard,36/(l_50-l_org)/5,36/0
l_50:		vfd a36/s   ,36/i_r,36/r_error,36/(l_51-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_exception,36/(l_51-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_51:		vfd a36/s   ,36/i_r,36/r_procedure,36/(l_52-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_52:	ds_8:	vfd a36/s   ,36/i_r,36/r_on,36/(l_53-l_org)/5,36/0
l_53:		vfd a36/s   ,36/i_c,36/c_filenm,36/(l_54-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_input,36/(ds_14-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_output,36/(ds_14-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_i_o,36/(ds_14-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_extend,36/(ds_14-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_54:		vfd a36/s   ,36/i_c,36/c_filenm,36/(l_54-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(ds_14-l_org)/5,36/0
	ds_6:	vfd a36/s   ,36/i_r,36/r_reporting,36/(ds_7-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_beginning,36/(l_55-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_ending,36/(l_55-l_org)/5,36/0
l_55:		vfd a36/s   ,36/i_r,36/r_reel,36/(l_56-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_unit,36/(l_56-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_file,36/(l_56-l_org)/5,36/0
l_56:		vfd a36/s   ,36/i_r,36/r_label,36/(l_57-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_57:		vfd a36/s   ,36/i_r,36/r_procedure,36/(ds_8-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	ds_7:	vfd a36/s   ,36/i_c,36/c_dana,36/(ds_7-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(ds_14-l_org)/5,36/0
	dbt:	vfd a36/    ,36/i_n,36/0,36/(l_58-l_org)/5,36/a_54
l_58:		vfd a36/    ,36/i_c,36/c_cdname,36/(dbt_1-l_org)/5,36/a_51
		vfd a36/    ,36/i_c,36/c_prnm,36/(dbt_5-l_org)/5,36/a_51
		vfd a36/    ,36/i_c,36/c_file,36/(dbt_3-l_org)/5,36/a_51
		vfd a36/    ,36/i_c,36/c_dana,36/(dbt_4-l_org)/5,36/a_51
		vfd a36/s   ,36/i_r,36/r_all,36/(l_59-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_59:		vfd a36/    ,36/i_r,36/r_procedures,36/(dbt_6-l_org)/5,36/a_53
		vfd a36/s   ,36/i_r,36/r_references,36/(l_60-l_org)/5,36/0
l_60:		vfd a36/s   ,36/i_r,36/r_of,36/(l_61-l_org)/5,36/0
l_61:		vfd a36/    ,36/i_c,36/c_dana,36/(dbt_4-l_org)/5,36/a_52
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	dbt_1:	vfd a36/s3  ,36/i_n,36/83,36/(l_62-l_org)/5,36/12
l_62:	dbt_2:	vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/0
	dbt_3:	vfd a36/s3  ,36/i_n,36/84,36/(dbt_2-l_org)/5,36/12
	dbt_4:	vfd a36/s3  ,36/i_n,36/85,36/(dbt_2-l_org)/5,36/12
	dbt_5:	vfd a36/s   ,36/i_n,36/0,36/(dbt_2-l_org)/5,36/0
	dbt_6:	vfd a36/s   ,36/i_n,36/0,36/(dbt_2-l_org)/5,36/0
	accept:	vfd a36/s   ,36/i_r,36/r_accept,36/(l_63-l_org)/5,36/0
l_63:		vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(l_64-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_incdnm,36/(acc1-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_64:	acc3:	vfd a36/s   ,36/i_r,36/r_from,36/(l_65-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
l_65:		vfd a36/s   ,36/i_c,36/c_acc_dev,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_date,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_time,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_day,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_day_of_week,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	acc1:	vfd a36/s   ,36/i_r,36/r_message,36/(l_66-l_org)/5,36/0
l_66:		vfd a36/s   ,36/i_r,36/r_count,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	add:	vfd a36/s   ,36/i_r,36/r_add,36/(l_67-l_org)/5,36/a_13
l_67:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_68-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_68:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_68-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_to,36/(l_69-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_giving,36/(l_69-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_69:		vfd a36/s   ,36/i_s,36/(edalel-l_org)/5,36/(l_70-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_70:	add1:	vfd a36/s   ,36/i_r,36/r_rounded,36/(l_71-l_org)/5,36/0
l_71:		vfd a36/s   ,36/i_s,36/(edalel-l_org)/5,36/(add1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_not,36/(l_72-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/a_96
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/a_96
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_72:		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	alter:	vfd a36/s   ,36/i_r,36/r_alter,36/(l_73-l_org)/5,36/a_112
l_73:	alt1:	vfd a36/s   ,36/i_c,36/c_prnm,36/(l_74-l_org)/5,36/a_108
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_74:		vfd a36/s   ,36/i_r,36/r_to,36/(l_75-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_75:		vfd a36/s   ,36/i_r,36/r_proceed,36/(l_76-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(alt2-l_org)/5,36/0
l_76:		vfd a36/s   ,36/i_r,36/r_to,36/(l_77-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_77:	alt2:	vfd a36/s   ,36/i_c,36/c_prnm,36/(l_78-l_org)/5,36/a_113
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_78:		vfd a36/    ,36/i_c,36/c_prnm,36/(alt1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	call:	vfd a36/s   ,36/i_r,36/r_call,36/(l_79-l_org)/5,36/a_28
l_79:		vfd a36/    ,36/i_c,36/c_nonumlit,36/(l_80-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_nonumdn,36/(call6-l_org)/5,36/a_59
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_80:		vfd a36/s   ,36/i_c,36/c_cklit,36/(call7-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_cklit1,36/(call7-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_mcobol,36/(l_81-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_81:		vfd a36/s   ,36/i_c,36/c_cklit2,36/(call7-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	call6:	vfd a36/s   ,36/i_s,36/(ident-l_org)/5,36/(l_82-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_82:	call7:	vfd a36/s   ,36/i_r,36/r_using,36/(l_83-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(call1-l_org)/5,36/0
l_83:		vfd a36/s   ,36/i_c,36/c_useid,36/(l_84-l_org)/5,36/a_59
		vfd a36/s   ,36/i_c,36/c_is_user_word,36/(l_84-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_84:		vfd a36/s   ,36/i_c,36/c_useid,36/(l_84-l_org)/5,36/a_59
		vfd a36/s   ,36/i_c,36/c_is_user_word,36/(l_84-l_org)/5,36/0
	call1:	vfd a36/s   ,36/i_r,36/r_not,36/(l_85-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_ov-l_org)/5,36/a_98
		vfd a36/s   ,36/i_r,36/r_overflow,36/(o_ov1-l_org)/5,36/a_98
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_85:		vfd a36/s   ,36/i_r,36/r_on,36/(o_ov-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_overflow,36/(o_ov1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	cancel:	vfd a36/s   ,36/i_r,36/r_cancel,36/(l_86-l_org)/5,36/0
l_86:		vfd a36/s   ,36/i_s,36/(nonumid-l_org)/5,36/(l_87-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_87:		vfd a36/s   ,36/i_s,36/(nonumid-l_org)/5,36/(l_87-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	close:	vfd a36/s   ,36/i_r,36/r_close,36/(l_88-l_org)/5,36/0
l_88:		vfd a36/s   ,36/i_c,36/c_nsfilnm,36/(l_89-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_89:	clos_ss1:	vfd a36/s   ,36/i_r,36/r_reel,36/(clos_ss4-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_unit,36/(clos_ss4-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_with,36/(clos_ss9-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_no,36/(clos_ss8-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_lock,36/(l_90-l_org)/5,36/0
l_90:	clos_ss2:	vfd a36/s   ,36/i_c,36/c_nsfilnm,36/(l_91-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
l_91:	clos_ss4:	vfd a36/s   ,36/i_r,36/r_with,36/(clos_ss7-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_for,36/(clos_ss6-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_no,36/(clos_ss8-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_removal,36/(clos_ss2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(clos_ss2-l_org)/5,36/0
	clos_ss6:	vfd a36/s   ,36/i_r,36/r_removal,36/(clos_ss2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	clos_ss7:	vfd a36/s   ,36/i_r,36/r_no,36/(l_92-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_92:	clos_ss8:	vfd a36/s   ,36/i_r,36/r_rewind,36/(clos_ss2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	clos_ss9:	vfd a36/s   ,36/i_r,36/r_no,36/(clos_ss8-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_lock,36/(clos_ss2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	compute:	vfd a36/s   ,36/i_r,36/r_compute,36/(l_93-l_org)/5,36/a_13
l_93:		vfd a36/s   ,36/i_s,36/(edalel-l_org)/5,36/(l_94-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_94:	com1:	vfd a36/s   ,36/i_r,36/r_rounded,36/(l_95-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_95-l_org)/5,36/0
l_95:		vfd a36/s   ,36/i_s,36/(edalel-l_org)/5,36/(com1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_from,36/(l_96-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_eq,36/(l_96-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_equals,36/(l_96-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_96:		vfd a36/    ,36/i_s,36/(arithexp-l_org)/5,36/(l_97-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_97:		vfd a36/s   ,36/i_r,36/r_not,36/(l_98-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/a_96
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/a_96
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_98:		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	disable:	vfd a36/s   ,36/i_r,36/r_disable,36/(l_99-l_org)/5,36/0
l_99:	dis_3:	vfd a36/s   ,36/i_r,36/r_input,36/(l_100-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_output,36/(dis_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_100:		vfd a36/s   ,36/i_r,36/r_terminal,36/(l_101-l_org)/5,36/0
l_101:		vfd a36/s   ,36/i_c,36/c_incdnm,36/(dis_2-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	dis_1:	vfd a36/s   ,36/i_c,36/c_outcdnm,36/(l_102-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_102:	dis_2:	vfd a36/s   ,36/i_r,36/r_with,36/(l_103-l_org)/5,36/0
l_103:		vfd a36/s   ,36/i_r,36/r_key,36/(l_104-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_104:		vfd a36/s   ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	display:	vfd a36/s   ,36/i_r,36/r_display,36/(l_105-l_org)/5,36/0
l_105:		vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(disp3-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_lit,36/(disp3-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(disp3-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_xnm,36/(r_2-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(xdname-l_org)/5,36/(r_2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	disp3:	vfd a36/s   ,36/i_r,36/r_upon,36/(disp4-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(disp3-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_lit,36/(disp3-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(disp3-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_xnm,36/(r_2-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(xdname-l_org)/5,36/(r_2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	disp4:	vfd a36/    ,36/i_c,36/c_disp_dev,36/(disp1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	disp1:	vfd a36/s   ,36/i_c,36/c_disp_dev,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	divide:	vfd a36/s   ,36/i_r,36/r_divide,36/(l_106-l_org)/5,36/a_13
l_106:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_107-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_107:		vfd a36/s   ,36/i_r,36/r_into,36/(l_108-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_by,36/(div5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_108:		vfd a36/    ,36/i_c,36/c_nlit,36/(div8-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_all,36/(div8-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_zero,36/(div8-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(l_109-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_109:		vfd a36/s   ,36/i_r,36/r_giving,36/(div4-l_org)/5,36/a_57
	div3:	vfd a36/s   ,36/i_r,36/r_rounded,36/(l_110-l_org)/5,36/0
l_110:	div1:	vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(div3-l_org)/5,36/0
	div2:	vfd a36/s   ,36/i_r,36/r_not,36/(l_111-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/a_96
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/a_96
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_111:	div9:	vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	div4:	vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(l_112-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_112:		vfd a36/s   ,36/i_r,36/r_rounded,36/(l_113-l_org)/5,36/0
l_113:		vfd a36/s   ,36/i_r,36/r_remainder,36/(div7-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_not,36/(div9-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/a_96
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/a_96
		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(div3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
	div7:	vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(div2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	div5:	vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_114-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_114:	div6:	vfd a36/s   ,36/i_r,36/r_giving,36/(div4-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	div8:	vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(div6-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(div6-l_org)/5,36/0
	enable:	vfd a36/s   ,36/i_r,36/r_enable,36/(dis_3-l_org)/5,36/0
	exit:	vfd a36/s   ,36/i_r,36/r_exit,36/(l_115-l_org)/5,36/0
l_115:		vfd a36/s   ,36/i_r,36/r_program,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	generate:	vfd a36/s   ,36/i_r,36/r_generate,36/(l_116-l_org)/5,36/0
l_116:		vfd a36/s   ,36/i_c,36/c_rpid,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	go:	vfd a36/s   ,36/i_r,36/r_go,36/(l_117-l_org)/5,36/0
l_117:		vfd a36/s   ,36/i_r,36/r_to,36/(l_118-l_org)/5,36/0
l_118:		vfd a36/s   ,36/i_c,36/c_prnm,36/(l_119-l_org)/5,36/a_122
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
l_119:		vfd a36/s   ,36/i_c,36/c_prnm,36/(l_120-l_org)/5,36/a_122
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
l_120:		vfd a36/s   ,36/i_r,36/r_depending,36/(l_121-l_org)/5,36/a_20
		vfd a36/s   ,36/i_c,36/c_prnm,36/(l_120-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_121:	go6:	vfd a36/s   ,36/i_r,36/r_on,36/(l_122-l_org)/5,36/0
l_122:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	hold:	vfd a36/s   ,36/i_r,36/r_hold,36/(l_123-l_org)/5,36/0
l_123:		vfd a36/s   ,36/i_r,36/r_all,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_descnm,36/(l_124-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_124:		vfd a36/s   ,36/i_c,36/c_descnm,36/(l_124-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	if:	vfd a36/s   ,36/i_r,36/r_if,36/(l_125-l_org)/5,36/a_15
l_125:		vfd a36/    ,36/i_s,36/(condition-l_org)/5,36/(l_126-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_126:		vfd a36/s   ,36/i_r,36/r_then,36/(l_127-l_org)/5,36/0
l_127:		vfd a36/    ,36/i_n,36/0,36/(l_128-l_org)/5,36/a_eos
l_128:		vfd a36/    ,36/i_s,36/(ns-l_org)/5,36/(if6-l_org)/5,36/a_eos
		vfd a36/    ,36/i_s,36/(verb-l_org)/5,36/(l_129-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_129:	if3:	vfd a36/s   ,36/i_r,36/r_else,36/(l_130-l_org)/5,36/a_32
		vfd a36/    ,36/i_n,36/0,36/(if7-l_org)/5,36/0
l_130:		vfd a36/    ,36/i_n,36/0,36/(l_131-l_org)/5,36/a_eos
l_131:		vfd a36/    ,36/i_s,36/(ns-l_org)/5,36/(if5-l_org)/5,36/a_49
l_132:		vfd a36/    ,36/i_n,36/0,36/(l_133-l_org)/5,36/a_eos
l_133:		vfd a36/    ,36/i_n,36/0,36/(l_134-l_org)/5,36/a_48
l_134:	if4:	vfd a36/    ,36/i_s,36/(verb-l_org)/5,36/(if2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	if5:	vfd a36/    ,36/i_r,36/r_else,36/(if2-l_org)/5,36/0
	if1:	vfd a36/    ,36/i_r,36/r_end_if,36/(if2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb2-l_org)/5,36/0
	if6:	vfd a36/s   ,36/i_r,36/r_else,36/(l_135-l_org)/5,36/a_50
		vfd a36/    ,36/i_n,36/0,36/(if1-l_org)/5,36/0
l_135:		vfd a36/    ,36/i_n,36/0,36/(l_136-l_org)/5,36/a_eos
l_136:		vfd a36/    ,36/i_s,36/(ns-l_org)/5,36/(if5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(if4-l_org)/5,36/0
	if2:	vfd a36/    ,36/i_c,36/c_nestedif,36/(l_137-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(if3-l_org)/5,36/0
l_137:	if7:	vfd a36/s   ,36/i_r,36/r_end_if,36/(l_138-l_org)/5,36/a_74
		vfd a36/    ,36/i_n,36/0,36/(verb2-l_org)/5,36/0
l_138:		vfd a36/    ,36/i_r,36/r_else,36/(if3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb2-l_org)/5,36/0
	ns:	vfd a36/s   ,36/i_r,36/r_next,36/(l_139-l_org)/5,36/a_30
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_139:		vfd a36/s   ,36/i_r,36/r_sentence,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	initiate:	vfd a36/s   ,36/i_r,36/r_initiate,36/(l_140-l_org)/5,36/0
l_140:		vfd a36/s   ,36/i_r,36/r_all,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_repnm,36/(l_141-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_141:		vfd a36/s   ,36/i_c,36/c_repnm,36/(l_141-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	inspect:	vfd a36/s   ,36/i_r,36/r_inspect,36/(l_142-l_org)/5,36/0
l_142:		vfd a36/s   ,36/i_s,36/(usagid-l_org)/5,36/(l_143-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_143:		vfd a36/s   ,36/i_r,36/r_tallying,36/(l_144-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_replacing,36/(ins7-l_org)/5,36/a_57
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_144:		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(l_145-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_145:	ins1:	vfd a36/s   ,36/i_r,36/r_for,36/(l_146-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_146:		vfd a36/s   ,36/i_r,36/r_all,36/(l_147-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_leading,36/(l_147-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_characters,36/(ins3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_147:	ins2:	vfd a36/s   ,36/i_s,36/(elusid-l_org)/5,36/(l_148-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_148:	ins3:	vfd a36/s   ,36/i_r,36/r_before,36/(l_149-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_after,36/(l_149-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(ins4-l_org)/5,36/0
l_149:		vfd a36/s   ,36/i_r,36/r_initial,36/(l_150-l_org)/5,36/0
l_150:		vfd a36/s   ,36/i_s,36/(elusid-l_org)/5,36/(l_151-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_151:	ins4:	vfd a36/    ,36/i_c,36/c_edalit,36/(l_152-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_all,36/(ins2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_leading,36/(ins2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_characters,36/(ins3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_replacing,36/(ins7-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
l_152:		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(ins1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ins7:	vfd a36/s   ,36/i_r,36/r_all,36/(l_153-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_leading,36/(l_153-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_first,36/(l_153-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_characters,36/(ins9-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_153:	ins8:	vfd a36/s   ,36/i_s,36/(elusid-l_org)/5,36/(l_154-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_154:	ins14:	vfd a36/s   ,36/i_r,36/r_by,36/(l_155-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_155:		vfd a36/s   ,36/i_s,36/(elusid-l_org)/5,36/(l_156-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_156:		vfd a36/s   ,36/i_r,36/r_before,36/(l_157-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_after,36/(l_157-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(ins10-l_org)/5,36/0
l_157:		vfd a36/s   ,36/i_r,36/r_initial,36/(l_158-l_org)/5,36/0
l_158:		vfd a36/s   ,36/i_s,36/(elusid-l_org)/5,36/(ins10-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ins9:	vfd a36/s   ,36/i_r,36/r_by,36/(l_159-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_159:		vfd a36/s   ,36/i_s,36/(elusid-l_org)/5,36/(l_160-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_160:		vfd a36/s   ,36/i_r,36/r_before,36/(l_161-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_after,36/(l_161-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
l_161:		vfd a36/s   ,36/i_r,36/r_initial,36/(l_162-l_org)/5,36/0
l_162:		vfd a36/s   ,36/i_s,36/(elusid-l_org)/5,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ins10:	vfd a36/s   ,36/i_r,36/r_all,36/(ins8-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_leading,36/(ins8-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_first,36/(ins8-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(elusid-l_org)/5,36/(ins14-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	merge:	vfd a36/s   ,36/i_r,36/r_merge,36/(l_163-l_org)/5,36/a_109
l_163:		vfd a36/s   ,36/i_c,36/c_srtfil,36/(l_164-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_164:		vfd a36/s   ,36/i_r,36/r_on,36/(l_165-l_org)/5,36/0
l_165:	merge_8:	vfd a36/s   ,36/i_r,36/r_ascending,36/(l_166-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_descending,36/(l_166-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_166:	merge_1:	vfd a36/s   ,36/i_r,36/r_key,36/(l_167-l_org)/5,36/0
l_167:		vfd a36/s   ,36/i_c,36/c_dninfl,36/(l_168-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_168:	merge_4:	vfd a36/s   ,36/i_c,36/c_dninfl,36/(merge_4-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_on,36/(merge_8-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_ascending,36/(merge_1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_descending,36/(merge_1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_collating,36/(mcs_1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_sequence,36/(mcs_3-l_org)/5,36/0
	muse:	vfd a36/s   ,36/i_r,36/r_using,36/(l_169-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_169:		vfd a36/s   ,36/i_c,36/c_filenm,36/(l_170-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_170:	merge_3:	vfd a36/s   ,36/i_n,36/0,36/(l_171-l_org)/5,36/0
l_171:		vfd a36/s   ,36/i_c,36/c_filenm,36/(merge_3-l_org)/5,36/a_60
		vfd a36/s   ,36/i_r,36/r_output,36/(l_172-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_giving,36/(merge_2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_172:	merge_7:	vfd a36/s   ,36/i_r,36/r_procedure,36/(l_173-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_173:		vfd a36/s   ,36/i_r,36/r_is,36/(l_174-l_org)/5,36/0
l_174:		vfd a36/s   ,36/i_c,36/c_prnm,36/(l_175-l_org)/5,36/a_110
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_175:		vfd a36/s   ,36/i_r,36/r_thru,36/(l_176-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
l_176:		vfd a36/s   ,36/i_c,36/c_prnm,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	merge_2:	vfd a36/s   ,36/i_c,36/c_filenm,36/(l_177-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_177:		vfd a36/s   ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	mcs_1:	vfd a36/s   ,36/i_r,36/r_sequence,36/(l_178-l_org)/5,36/0
l_178:	mcs_3:	vfd a36/s   ,36/i_r,36/r_is,36/(l_179-l_org)/5,36/0
l_179:	mcs_2:	vfd a36/s   ,36/i_c,36/c_alphnm,36/(muse-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	move:	vfd a36/s   ,36/i_r,36/r_move,36/(l_180-l_org)/5,36/0
l_180:		vfd a36/s   ,36/i_c,36/c_lit,36/(mov1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(mov1-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(mov1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_xnm,36/(mov1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_all,36/(l_181-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_181:		vfd a36/s   ,36/i_c,36/c_lit,36/(l_182-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(l_182-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_182:	mov1:	vfd a36/s   ,36/i_r,36/r_to,36/(l_183-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_183:		vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(l_183-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_xnm,36/(l_183-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	multiply:	vfd a36/s   ,36/i_r,36/r_multiply,36/(l_184-l_org)/5,36/a_13
l_184:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_185-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_185:		vfd a36/s   ,36/i_r,36/r_by,36/(l_186-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_186:		vfd a36/    ,36/i_c,36/c_nlit,36/(mul6-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_all,36/(mul6-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_zero,36/(mul6-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(l_187-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_187:		vfd a36/s   ,36/i_r,36/r_giving,36/(mul4-l_org)/5,36/a_57
	mul1:	vfd a36/s   ,36/i_r,36/r_rounded,36/(l_188-l_org)/5,36/0
l_188:	mul2:	vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(mul1-l_org)/5,36/0
	mul3:	vfd a36/s   ,36/i_r,36/r_not,36/(l_189-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/a_96
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/a_96
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_189:	mul7:	vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	mul4:	vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(l_190-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_190:	mul5:	vfd a36/s   ,36/i_r,36/r_rounded,36/(l_191-l_org)/5,36/0
l_191:		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(mul5-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_not,36/(mul7-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/a_96
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/a_96
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
	mul6:	vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_192-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_192:		vfd a36/s   ,36/i_r,36/r_giving,36/(l_193-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_193:		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(mul5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	open:	vfd a36/s   ,36/i_r,36/r_open,36/(l_194-l_org)/5,36/0
l_194:		vfd a36/s   ,36/i_r,36/r_input,36/(l_195-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_output,36/(open_o-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_i_o,36/(open_io-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_extend,36/(open_io-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_195:	open_i:	vfd a36/s   ,36/i_c,36/c_filenm,36/(l_196-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_196:	open_i1:	vfd a36/s   ,36/i_r,36/r_reversed,36/(open_i2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_with,36/(open_i3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_no,36/(open_i4-l_org)/5,36/0
	open_i2:	vfd a36/s   ,36/i_c,36/c_filenm,36/(open_i1-l_org)/5,36/a_60
	open_1:	vfd a36/s   ,36/i_r,36/r_input,36/(open_i-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_output,36/(open_o-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_i_o,36/(open_io-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_extend,36/(open_io-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	open_i3:	vfd a36/s   ,36/i_r,36/r_no,36/(l_197-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_197:	open_i4:	vfd a36/s   ,36/i_r,36/r_rewind,36/(open_i2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	open_o:	vfd a36/s   ,36/i_c,36/c_filenm,36/(l_198-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_198:	open_o1:	vfd a36/s   ,36/i_r,36/r_with,36/(open_o3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_no,36/(open_o4-l_org)/5,36/0
	open_o2:	vfd a36/s   ,36/i_c,36/c_filenm,36/(open_o1-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(open_1-l_org)/5,36/0
	open_o3:	vfd a36/s   ,36/i_r,36/r_no,36/(l_199-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_199:	open_o4:	vfd a36/s   ,36/i_r,36/r_rewind,36/(open_o2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	open_io:	vfd a36/s   ,36/i_c,36/c_filenm,36/(l_200-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_200:		vfd a36/s   ,36/i_c,36/c_filenm,36/(l_200-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(open_1-l_org)/5,36/0
	perform:	vfd a36/s   ,36/i_r,36/r_perform,36/(l_201-l_org)/5,36/a_31
l_201:		vfd a36/s   ,36/i_c,36/c_prnm,36/(l_202-l_org)/5,36/a_67
		vfd a36/    ,36/i_n,36/0,36/(per1-l_org)/5,36/a_66
l_202:		vfd a36/s   ,36/i_r,36/r_thru,36/(l_203-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(per1-l_org)/5,36/0
l_203:		vfd a36/s   ,36/i_c,36/c_prnm,36/(l_204-l_org)/5,36/a_84
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_204:	per1:	vfd a36/    ,36/i_c,36/c_elnuint,36/(per3-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_elnudnint,36/(per3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_until,36/(per4-l_org)/5,36/a_70
		vfd a36/s   ,36/i_r,36/r_varying,36/(per5-l_org)/5,36/a_71
		vfd a36/    ,36/i_n,36/0,36/(l_205-l_org)/5,36/a_68
l_205:	per2:	vfd a36/    ,36/i_c,36/c_in_line,36/(cverb-l_org)/5,36/0
l_206:		vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_207-l_org)/5,36/0
l_207:		vfd a36/s   ,36/i_r,36/r_end_perform,36/(cverb-l_org)/5,36/a_74
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	per3:	vfd a36/    ,36/i_n,36/0,36/(l_208-l_org)/5,36/a_69
l_208:		vfd a36/s   ,36/i_s,36/(elnumint-l_org)/5,36/(l_209-l_org)/5,36/a_121
l_209:		vfd a36/s   ,36/i_r,36/r_times,36/(per2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	per4:	vfd a36/    ,36/i_s,36/(condition-l_org)/5,36/(per2-l_org)/5,36/a_85
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	per5:	vfd a36/    ,36/i_s,36/(range-l_org)/5,36/(l_210-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_210:	per6:	vfd a36/s   ,36/i_r,36/r_after,36/(l_211-l_org)/5,36/a_89
		vfd a36/    ,36/i_n,36/0,36/(per2-l_org)/5,36/0
l_211:		vfd a36/    ,36/i_s,36/(range-l_org)/5,36/(per6-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	range:	vfd a36/    ,36/i_n,36/0,36/(l_212-l_org)/5,36/a_90
l_212:		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(l_213-l_org)/5,36/a_118
		vfd a36/s   ,36/i_c,36/c_xnm,36/(l_213-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_213:		vfd a36/s   ,36/i_r,36/r_from,36/(l_214-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_214:		vfd a36/    ,36/i_n,36/0,36/(l_215-l_org)/5,36/a_91
l_215:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_216-l_org)/5,36/a_119
		vfd a36/s   ,36/i_c,36/c_xnm,36/(l_216-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_216:		vfd a36/s   ,36/i_r,36/r_by,36/(l_217-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_217:		vfd a36/    ,36/i_n,36/0,36/(l_218-l_org)/5,36/a_92
l_218:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_219-l_org)/5,36/a_120
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_219:		vfd a36/s   ,36/i_r,36/r_until,36/(l_220-l_org)/5,36/a_93
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_220:		vfd a36/    ,36/i_s,36/(condition-l_org)/5,36/(succ-l_org)/5,36/a_83
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	process:	vfd a36/s   ,36/i_r,36/r_process,36/(l_221-l_org)/5,36/0
l_221:		vfd a36/s   ,36/i_c,36/c_descnm,36/(l_222-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_222:		vfd a36/s   ,36/i_r,36/r_from,36/(pro2-l_org)/5,36/0
	pro1:	vfd a36/s   ,36/i_r,36/r_using,36/(pro3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	pro2:	vfd a36/s   ,36/i_s,36/(ident-l_org)/5,36/(pro1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	pro3:	vfd a36/s   ,36/i_c,36/c_saanm,36/(l_223-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_said,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_223:	purge:	vfd a36/s   ,36/i_r,36/r_purge,36/(l_224-l_org)/5,36/0
l_224:		vfd a36/s   ,36/i_c,36/c_outcdnm,36/(verb1-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	read:	vfd a36/s   ,36/i_r,36/r_read,36/(l_225-l_org)/5,36/a_29
l_225:		vfd a36/s   ,36/i_c,36/c_filenm,36/(l_226-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_226:		vfd a36/s   ,36/i_r,36/r_next,36/(l_227-l_org)/5,36/0
l_227:		vfd a36/s   ,36/i_r,36/r_record,36/(l_228-l_org)/5,36/0
l_228:		vfd a36/s   ,36/i_r,36/r_into,36/(read_3-l_org)/5,36/0
	read_1:	vfd a36/s   ,36/i_r,36/r_key,36/(read_4-l_org)/5,36/0
	read_2:	vfd a36/s   ,36/i_r,36/r_not,36/(l_229-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_at,36/(o_ae-l_org)/5,36/a_99
		vfd a36/s   ,36/i_r,36/r_end,36/(o_ae1-l_org)/5,36/a_99
		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/a_100
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_229:		vfd a36/s   ,36/i_r,36/r_at,36/(o_ae-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_end,36/(o_ae1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	read_3:	vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(read_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	read_4:	vfd a36/s   ,36/i_r,36/r_is,36/(l_230-l_org)/5,36/0
l_230:		vfd a36/s   ,36/i_c,36/c_type9,36/(read_2-l_org)/5,36/a_59
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	receive:	vfd a36/s   ,36/i_r,36/r_receive,36/(l_231-l_org)/5,36/a_31
l_231:		vfd a36/s   ,36/i_c,36/c_incdnm,36/(l_232-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_232:		vfd a36/s   ,36/i_r,36/r_message,36/(l_233-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_segment,36/(l_233-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_233:		vfd a36/s   ,36/i_r,36/r_into,36/(l_234-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_234:		vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(l_235-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_235:		vfd a36/    ,36/i_s,36/(with_data-l_org)/5,36/(o_nd-l_org)/5,36/0
		vfd a36/    ,36/i_s,36/(no_data-l_org)/5,36/(o_nd-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
	with_data:	vfd a36/s   ,36/i_r,36/r_with,36/(l_236-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_data,36/(succ-l_org)/5,36/a_101
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_236:		vfd a36/s   ,36/i_r,36/r_data,36/(succ-l_org)/5,36/a_101
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	no_data:	vfd a36/s   ,36/i_r,36/r_not,36/(l_237-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_no,36/(no_data_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_237:		vfd a36/s   ,36/i_r,36/r_with,36/(l_238-l_org)/5,36/0
l_238:	no_data_1:	vfd a36/s   ,36/i_r,36/r_data,36/(succ-l_org)/5,36/a_97
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	release:	vfd a36/s   ,36/i_r,36/r_release,36/(l_239-l_org)/5,36/0
l_239:		vfd a36/s   ,36/i_c,36/c_recnm,36/(l_240-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_240:		vfd a36/s   ,36/i_r,36/r_from,36/(l_241-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
l_241:		vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	return:	vfd a36/s   ,36/i_r,36/r_return,36/(l_242-l_org)/5,36/a_28
l_242:		vfd a36/s   ,36/i_c,36/c_asfil,36/(l_243-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_243:		vfd a36/s   ,36/i_r,36/r_record,36/(l_244-l_org)/5,36/0
l_244:		vfd a36/s   ,36/i_r,36/r_into,36/(ret_2-l_org)/5,36/0
	ret_1:	vfd a36/s   ,36/i_r,36/r_not,36/(l_245-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_at,36/(o_ae-l_org)/5,36/a_99
		vfd a36/s   ,36/i_r,36/r_end,36/(o_ae1-l_org)/5,36/a_99
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_245:		vfd a36/s   ,36/i_r,36/r_at,36/(o_ae-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_end,36/(o_ae1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ret_2:	vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(ret_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	rewrite:	vfd a36/s   ,36/i_r,36/r_rewrite,36/(l_246-l_org)/5,36/a_29
l_246:		vfd a36/s   ,36/i_c,36/c_nsrecnm,36/(l_247-l_org)/5,36/a_115
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_247:		vfd a36/s   ,36/i_r,36/r_from,36/(l_248-l_org)/5,36/a_116
		vfd a36/    ,36/i_n,36/0,36/(rew_1-l_org)/5,36/0
l_248:		vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(l_249-l_org)/5,36/a_117
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_249:	rew_1:	vfd a36/s   ,36/i_r,36/r_not,36/(l_250-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/a_100
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_250:		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	search:	vfd a36/s   ,36/i_r,36/r_search,36/(l_251-l_org)/5,36/a_31
l_251:		vfd a36/s   ,36/i_c,36/c_srchid,36/(l_252-l_org)/5,36/a_59
		vfd a36/s   ,36/i_r,36/r_all,36/(sea12-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_252:		vfd a36/s   ,36/i_n,36/0,36/(l_253-l_org)/5,36/0
l_253:		vfd a36/s   ,36/i_r,36/r_varying,36/(l_254-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(sea4-l_org)/5,36/0
l_254:		vfd a36/s   ,36/i_c,36/c_xnm,36/(l_255-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_usornm,36/(sea10-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_255:	sea4:	vfd a36/s   ,36/i_r,36/r_at,36/(l_256-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_end,36/(sea41-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(sea7-l_org)/5,36/0
l_256:		vfd a36/s   ,36/i_r,36/r_end,36/(l_257-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_257:	sea41:	vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_258-l_org)/5,36/0
l_258:	sea7:	vfd a36/s   ,36/i_r,36/r_when,36/(l_259-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_259:	sea8:	vfd a36/    ,36/i_s,36/(condition-l_org)/5,36/(l_260-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_260:		vfd a36/s   ,36/i_r,36/r_next,36/(sea11-l_org)/5,36/0
l_261:		vfd a36/    ,36/i_s,36/(verb-l_org)/5,36/(l_262-l_org)/5,36/a_40
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_262:	sea9:	vfd a36/s   ,36/i_r,36/r_when,36/(sea8-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/a_42
	sea10:	vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(sea4-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(xdname-l_org)/5,36/(sea4-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sea11:	vfd a36/s   ,36/i_r,36/r_sentence,36/(sea9-l_org)/5,36/a_40
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sea12:	vfd a36/    ,36/i_c,36/c_srchid,36/(l_263-l_org)/5,36/a_64
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_263:		vfd a36/s   ,36/i_c,36/c_keylbl,36/(l_264-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_264:		vfd a36/s   ,36/i_n,36/0,36/(l_265-l_org)/5,36/0
l_265:		vfd a36/    ,36/i_r,36/r_when,36/(sea14-l_org)/5,36/a_3
		vfd a36/s   ,36/i_r,36/r_at,36/(l_266-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_end,36/(sea31-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_266:		vfd a36/s   ,36/i_r,36/r_end,36/(l_267-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_267:	sea31:	vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_268-l_org)/5,36/0
l_268:		vfd a36/s   ,36/i_r,36/r_when,36/(l_269-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_269:	sea14:	vfd a36/    ,36/i_s,36/(condition-l_org)/5,36/(l_270-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_270:		vfd a36/s   ,36/i_r,36/r_next,36/(sea15-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_271-l_org)/5,36/a_39
l_271:		vfd a36/    ,36/i_s,36/(verb-l_org)/5,36/(endwd-l_org)/5,36/a_42
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sea15:	vfd a36/s   ,36/i_r,36/r_sentence,36/(endwd-l_org)/5,36/a_40
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	send:	vfd a36/s   ,36/i_r,36/r_send,36/(l_272-l_org)/5,36/0
l_272:		vfd a36/s   ,36/i_c,36/c_outcdnm,36/(l_273-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_273:		vfd a36/s   ,36/i_r,36/r_from,36/(send_1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_with,36/(l_274-l_org)/5,36/0
l_274:	send_5:	vfd a36/    ,36/i_r,36/r_esi,36/(send_3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_emi,36/(send_3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_egi,36/(send_3-l_org)/5,36/0
		vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(send_4-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	send_1:	vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(l_275-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_275:		vfd a36/s   ,36/i_r,36/r_with,36/(send_5-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_esi,36/(send_3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_emi,36/(send_3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_egi,36/(send_3-l_org)/5,36/0
		vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(send_4-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	send_3:	vfd a36/s   ,36/i_r,36/r_before,36/(send_6-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_after,36/(send_6-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	send_4:	vfd a36/s   ,36/i_c,36/c_onechnosn,36/(send_3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	send_6:	vfd a36/s   ,36/i_r,36/r_advancing,36/(l_276-l_org)/5,36/0
l_276:		vfd a36/s   ,36/i_s,36/(elnumint-l_org)/5,36/(send_8-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_prt_con,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_page,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_277:		vfd a36/s   ,36/i_c,36/c_elnuindi,36/(l_278-l_org)/5,36/a_59
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_278:	send_8:	vfd a36/s   ,36/i_r,36/r_lines,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	set:	vfd a36/s   ,36/i_r,36/r_set,36/(l_279-l_org)/5,36/0
l_279:		vfd a36/s   ,36/i_c,36/c_xnm,36/(set_4-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_xint,36/(set_5-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_ssnm,36/(l_280-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_280:	set_1:	vfd a36/s   ,36/i_c,36/c_ssnm,36/(set_1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_to,36/(set_2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(set_2-l_org)/5,36/0
	set_2:	vfd a36/s   ,36/i_c,36/c_on_off,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	set_4:	vfd a36/s   ,36/i_c,36/c_xnm,36/(set_4-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_to,36/(set_7-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_up,36/(set_10-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_down,36/(set_10-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(set_6-l_org)/5,36/0
	set_5:	vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(l_281-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(xdname-l_org)/5,36/(l_281-l_org)/5,36/0
l_281:	set_6:	vfd a36/    ,36/i_c,36/c_xint,36/(set_5-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_xnm,36/(set_3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_to,36/(set_7-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	set_3:	vfd a36/s   ,36/i_n,36/0,36/(set_6-l_org)/5,36/0
	set_7:	vfd a36/s   ,36/i_c,36/c_xnm,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_set_xint,36/(set_9-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_set_pigz,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	set_9:	vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(xdname-l_org)/5,36/(verb1-l_org)/5,36/0
	set_10:	vfd a36/s   ,36/i_r,36/r_by,36/(l_282-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_282:		vfd a36/    ,36/i_c,36/c_elnudnint,36/(l_283-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_elnuint,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_283:		vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sort:	vfd a36/s   ,36/i_r,36/r_sort,36/(l_284-l_org)/5,36/a_109
l_284:		vfd a36/s   ,36/i_c,36/c_srtfil,36/(l_285-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_285:		vfd a36/s   ,36/i_n,36/0,36/(l_286-l_org)/5,36/0
l_286:		vfd a36/s   ,36/i_r,36/r_on,36/(l_287-l_org)/5,36/0
l_287:	sort_1:	vfd a36/s   ,36/i_r,36/r_ascending,36/(l_288-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_descending,36/(l_288-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_288:	sort_2:	vfd a36/s   ,36/i_r,36/r_key,36/(l_289-l_org)/5,36/0
l_289:		vfd a36/s   ,36/i_c,36/c_dninfl,36/(l_290-l_org)/5,36/a_59
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_290:	sort_12:	vfd a36/s   ,36/i_c,36/c_dninfl,36/(sort_12-l_org)/5,36/a_59
		vfd a36/s   ,36/i_r,36/r_on,36/(sort_1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_ascending,36/(sort_2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_descending,36/(sort_2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_collating,36/(sort_3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_sequence,36/(sort_4-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_291-l_org)/5,36/0
l_291:	sort_5:	vfd a36/s   ,36/i_r,36/r_input,36/(sort_6-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_using,36/(sort_11-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sort_3:	vfd a36/s   ,36/i_r,36/r_sequence,36/(l_292-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_292:	sort_4:	vfd a36/s   ,36/i_r,36/r_is,36/(l_293-l_org)/5,36/0
l_293:		vfd a36/s   ,36/i_c,36/c_alphnm,36/(sort_5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sort_6:	vfd a36/s   ,36/i_r,36/r_procedure,36/(sort_7-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sort_11:	vfd a36/s   ,36/i_c,36/c_filenm,36/(l_294-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_294:	sort_9:	vfd a36/s   ,36/i_n,36/0,36/(sort_8-l_org)/5,36/0
	sort_7:	vfd a36/s   ,36/i_r,36/r_is,36/(l_295-l_org)/5,36/0
l_295:		vfd a36/s   ,36/i_c,36/c_descnmra,36/(l_296-l_org)/5,36/a_111
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_296:		vfd a36/s   ,36/i_r,36/r_thru,36/(l_297-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(sort_13-l_org)/5,36/0
l_297:		vfd a36/s   ,36/i_c,36/c_descnmra,36/(sort_13-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sort_8:	vfd a36/s   ,36/i_c,36/c_filenm,36/(l_298-l_org)/5,36/0
l_298:	sort_13:	vfd a36/s   ,36/i_r,36/r_output,36/(l_299-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_giving,36/(sort_10-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_299:		vfd a36/s   ,36/i_r,36/r_procedure,36/(l_300-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_300:		vfd a36/s   ,36/i_r,36/r_is,36/(l_301-l_org)/5,36/0
l_301:		vfd a36/s   ,36/i_c,36/c_descnmra,36/(l_302-l_org)/5,36/a_110
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_302:		vfd a36/s   ,36/i_r,36/r_thru,36/(l_303-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
l_303:		vfd a36/s   ,36/i_c,36/c_descnmra,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sort_10:	vfd a36/s   ,36/i_c,36/c_filenm,36/(l_304-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_304:		vfd a36/s   ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	start:	vfd a36/s   ,36/i_r,36/r_start,36/(l_305-l_org)/5,36/a_29
l_305:	sta1:	vfd a36/s   ,36/i_c,36/c_filenm,36/(l_306-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_306:		vfd a36/s   ,36/i_r,36/r_key,36/(sta3-l_org)/5,36/0
	sta9:	vfd a36/s   ,36/i_r,36/r_not,36/(l_307-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/a_100
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_307:		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sta3:	vfd a36/s   ,36/i_r,36/r_is,36/(l_308-l_org)/5,36/0
l_308:		vfd a36/s   ,36/i_r,36/r_eq,36/(l_309-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_gt,36/(sta8-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_not,36/(sta6-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_309:		vfd a36/s   ,36/i_r,36/r_to,36/(l_310-l_org)/5,36/0
l_310:	sta7:	vfd a36/s   ,36/i_c,36/c_undana,36/(sta9-l_org)/5,36/a_59
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sta8:	vfd a36/s   ,36/i_r,36/r_than,36/(sta7-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(sta7-l_org)/5,36/0
	sta6:	vfd a36/s   ,36/i_r,36/r_less,36/(sta8-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	stop:	vfd a36/s   ,36/i_r,36/r_stop,36/(l_311-l_org)/5,36/0
l_311:		vfd a36/s   ,36/i_r,36/r_run,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_lit,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	string:	vfd a36/s   ,36/i_r,36/r_string,36/(l_312-l_org)/5,36/a_28
l_312:		vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(l_313-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_nonumlit,36/(str2-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(str2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_313:	str1:	vfd a36/s   ,36/i_c,36/c_usisds,36/(l_314-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_314:	str2:	vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(str1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_delimited,36/(l_315-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_nonumlit,36/(str2-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(str2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_315:		vfd a36/s   ,36/i_r,36/r_by,36/(l_316-l_org)/5,36/0
l_316:		vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(l_317-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_size,36/(str4-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_nonumlit,36/(str4-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(str4-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_317:		vfd a36/s   ,36/i_c,36/c_usisds,36/(l_318-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_318:	str4:	vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(str1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_nonumlit,36/(str2-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(str2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_into,36/(l_319-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_319:		vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(l_320-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_320:		vfd a36/s   ,36/i_c,36/c_elneds,36/(l_321-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_321:		vfd a36/s   ,36/i_r,36/r_with,36/(str7-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_pointer,36/(str8-l_org)/5,36/0
	str6:	vfd a36/s   ,36/i_r,36/r_not,36/(l_322-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_ov-l_org)/5,36/a_98
		vfd a36/s   ,36/i_r,36/r_overflow,36/(o_ov1-l_org)/5,36/a_98
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_322:		vfd a36/s   ,36/i_r,36/r_on,36/(o_ov-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_overflow,36/(o_ov1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	str7:	vfd a36/s   ,36/i_r,36/r_pointer,36/(l_323-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_323:	str8:	vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(l_324-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_324:		vfd a36/s   ,36/i_c,36/c_elnuindi,36/(str6-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	subtract:	vfd a36/s   ,36/i_r,36/r_subtract,36/(l_325-l_org)/5,36/a_13
l_325:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_326-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_326:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_326-l_org)/5,36/0
l_327:		vfd a36/s   ,36/i_r,36/r_from,36/(l_328-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_328:		vfd a36/    ,36/i_c,36/c_nlit,36/(sub6-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_all,36/(sub6-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_zero,36/(sub6-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(l_329-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_329:		vfd a36/s   ,36/i_r,36/r_giving,36/(sub4-l_org)/5,36/a_94
	sub1:	vfd a36/s   ,36/i_r,36/r_rounded,36/(l_330-l_org)/5,36/0
l_330:	sub2:	vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(sub1-l_org)/5,36/0
	sub3:	vfd a36/s   ,36/i_r,36/r_not,36/(l_331-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/a_96
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/a_96
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_331:	sub7:	vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sub4:	vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(l_332-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_332:	sub5:	vfd a36/s   ,36/i_r,36/r_rounded,36/(l_333-l_org)/5,36/0
l_333:		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(sub5-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_not,36/(sub7-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_se-l_org)/5,36/a_96
		vfd a36/s   ,36/i_r,36/r_size,36/(o_se1-l_org)/5,36/a_96
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
	sub6:	vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_334-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_334:		vfd a36/s   ,36/i_r,36/r_giving,36/(l_335-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_335:		vfd a36/s   ,36/i_s,36/(alel-l_org)/5,36/(mul5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	suspend:	vfd a36/s   ,36/i_r,36/r_suspend,36/(l_336-l_org)/5,36/0
l_336:	sus1:	vfd a36/s   ,36/i_c,36/c_file,36/(sus3-l_org)/5,36/0
	sus2:	vfd a36/s   ,36/i_c,36/c_repnm,36/(l_337-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_337:	sus3:	vfd a36/s   ,36/i_c,36/c_lit,36/(l_338-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(ident-l_org)/5,36/(l_338-l_org)/5,36/0
l_338:		vfd a36/    ,36/i_c,36/c_file,36/(sus1-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_repnm,36/(sus2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	terminate:	vfd a36/s   ,36/i_r,36/r_terminate,36/(l_339-l_org)/5,36/0
l_339:		vfd a36/s   ,36/i_r,36/r_all,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_repnm,36/(l_340-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_340:		vfd a36/s   ,36/i_c,36/c_repnm,36/(l_340-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	unstring:	vfd a36/s   ,36/i_r,36/r_unstring,36/(l_341-l_org)/5,36/a_28
l_341:		vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(l_342-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_342:		vfd a36/s   ,36/i_c,36/c_andait,36/(l_343-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_343:		vfd a36/s   ,36/i_r,36/r_delimited,36/(l_344-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_into,36/(un2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_344:		vfd a36/s   ,36/i_r,36/r_by,36/(l_345-l_org)/5,36/0
l_345:	un1:	vfd a36/s   ,36/i_r,36/r_all,36/(l_346-l_org)/5,36/0
l_346:		vfd a36/s   ,36/i_s,36/(nonumid-l_org)/5,36/(l_347-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figconall,36/(l_347-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_347:		vfd a36/s   ,36/i_r,36/r_or,36/(un1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_into,36/(l_348-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_348:	un2:	vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(l_349-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_349:	un3:	vfd a36/s   ,36/i_s,36/(usnoned-l_org)/5,36/(l_350-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_350:		vfd a36/s   ,36/i_r,36/r_delimiter,36/(un8-l_org)/5,36/0
	un4:	vfd a36/s   ,36/i_r,36/r_count,36/(un10-l_org)/5,36/0
	un5:	vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(un3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_with,36/(un11-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_pointer,36/(un12-l_org)/5,36/0
	un6:	vfd a36/s   ,36/i_r,36/r_tallying,36/(un13-l_org)/5,36/0
	un8:	vfd a36/s   ,36/i_r,36/r_in,36/(l_351-l_org)/5,36/0
l_351:		vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(l_352-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_352:		vfd a36/s   ,36/i_c,36/c_andait,36/(un4-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	un10:	vfd a36/s   ,36/i_r,36/r_in,36/(l_353-l_org)/5,36/0
l_353:		vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(l_354-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_354:		vfd a36/s   ,36/i_c,36/c_elnuindi,36/(un5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	un11:	vfd a36/s   ,36/i_r,36/r_pointer,36/(l_355-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_355:	un12:	vfd a36/    ,36/i_s,36/(sid-l_org)/5,36/(l_356-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_356:		vfd a36/s   ,36/i_c,36/c_elnuindi,36/(un6-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	un13:	vfd a36/s   ,36/i_r,36/r_in,36/(l_357-l_org)/5,36/0
l_357:		vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(l_358-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_358:		vfd a36/s   ,36/i_c,36/c_elnuindi,36/(l_359-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_359:		vfd a36/s   ,36/i_r,36/r_not,36/(l_360-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_on,36/(o_ov-l_org)/5,36/a_98
		vfd a36/s   ,36/i_r,36/r_overflow,36/(o_ov1-l_org)/5,36/a_98
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_360:		vfd a36/s   ,36/i_r,36/r_on,36/(o_ov-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_overflow,36/(o_ov1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	write:	vfd a36/s   ,36/i_r,36/r_write,36/(l_361-l_org)/5,36/a_29
l_361:		vfd a36/s   ,36/i_c,36/c_nsrecnm,36/(l_362-l_org)/5,36/a_115
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_362:		vfd a36/s   ,36/i_r,36/r_from,36/(wr4-l_org)/5,36/a_116
	wr2:	vfd a36/s   ,36/i_r,36/r_before,36/(wr5-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_after,36/(wr5-l_org)/5,36/0
	wr3:	vfd a36/s   ,36/i_r,36/r_not,36/(l_363-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_at,36/(o_eop-l_org)/5,36/a_102
		vfd a36/s   ,36/i_r,36/r_eop,36/(o_eop1-l_org)/5,36/a_102
		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/a_100
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_363:		vfd a36/s   ,36/i_r,36/r_at,36/(o_eop-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_eop,36/(o_eop1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	wr4:	vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(wr2-l_org)/5,36/a_117
	wr5:	vfd a36/s   ,36/i_r,36/r_advancing,36/(l_364-l_org)/5,36/0
l_364:		vfd a36/    ,36/i_c,36/c_elnudnint,36/(wr1-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(elnumint-l_org)/5,36/(wr8-l_org)/5,36/0
	wr6:	vfd a36/s   ,36/i_c,36/c_prt_con,36/(wr3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_page,36/(wr3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	wr8:	vfd a36/s   ,36/i_r,36/r_lines,36/(wr3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(wr3-l_org)/5,36/0
	wr1:	vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(wr8-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(wr6-l_org)/5,36/0
	examine:	vfd a36/s   ,36/i_r,36/r_examine,36/(l_365-l_org)/5,36/0
l_365:		vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(l_366-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_366:		vfd a36/s   ,36/i_r,36/r_tallying,36/(l_367-l_org)/5,36/0
l_367:		vfd a36/s   ,36/i_r,36/r_replacing,36/(ex1-l_org)/5,36/a_94
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_368:		vfd a36/s   ,36/i_r,36/r_all,36/(ex3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_leading,36/(ex3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_until,36/(ex4-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ex1:	vfd a36/s   ,36/i_r,36/r_all,36/(ex7-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_leading,36/(ex7-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_until,36/(ex8-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_first,36/(ex7-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ex3:	vfd a36/s   ,36/i_c,36/c_examlitid,36/(ex5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ex4:	vfd a36/s   ,36/i_r,36/r_first,36/(ex3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ex5:	vfd a36/s   ,36/i_r,36/r_replacing,36/(l_369-l_org)/5,36/a_94
l_369:		vfd a36/s   ,36/i_r,36/r_by,36/(l_370-l_org)/5,36/0
l_370:		vfd a36/s   ,36/i_c,36/c_examlitid,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ex7:	vfd a36/s   ,36/i_c,36/c_examlitid,36/(ex9-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ex8:	vfd a36/s   ,36/i_r,36/r_first,36/(ex7-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ex9:	vfd a36/s   ,36/i_r,36/r_by,36/(l_371-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_371:		vfd a36/s   ,36/i_c,36/c_examlitid,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	transform:	vfd a36/s   ,36/i_r,36/r_transform,36/(l_372-l_org)/5,36/0
l_372:		vfd a36/    ,36/i_c,36/c_elaanne,36/(l_373-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_373:		vfd a36/s   ,36/i_s,36/(rid-l_org)/5,36/(l_374-l_org)/5,36/0
l_374:		vfd a36/s   ,36/i_r,36/r_characters,36/(l_375-l_org)/5,36/0
l_375:		vfd a36/s   ,36/i_r,36/r_from,36/(l_376-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_376:		vfd a36/s   ,36/i_c,36/c_figconall,36/(l_377-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_nonumlit,36/(l_377-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(ident-l_org)/5,36/(l_377-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_377:		vfd a36/s   ,36/i_r,36/r_to,36/(l_378-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_378:		vfd a36/s   ,36/i_c,36/c_figconall,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_nonumlit,36/(verb1-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(ident-l_org)/5,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	delete:	vfd a36/s   ,36/i_r,36/r_delete,36/(l_379-l_org)/5,36/a_29
l_379:		vfd a36/s   ,36/i_c,36/c_filenm,36/(l_380-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_380:		vfd a36/s   ,36/i_r,36/r_record,36/(l_381-l_org)/5,36/0
l_381:		vfd a36/s   ,36/i_r,36/r_not,36/(l_382-l_org)/5,36/a_97
		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/a_100
		vfd a36/    ,36/i_n,36/0,36/(cverb-l_org)/5,36/0
l_382:		vfd a36/s   ,36/i_r,36/r_invalid,36/(o_inv-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	suppress:	vfd a36/s   ,36/i_r,36/r_suppress,36/(sup1-l_org)/5,36/0
	sup1:	vfd a36/s   ,36/i_r,36/r_printing,36/(verb1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(verb1-l_org)/5,36/0
	xdname:	vfd a36/    ,36/i_c,36/c_unxdnm,36/(succ-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_suxdnm,36/(ident_5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	ident:	vfd a36/    ,36/i_c,36/c_undana,36/(succ-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_sudana,36/(l_383-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_383:	ident_5:	vfd a36/s   ,36/i_r,36/r_lt,36/(l_384-l_org)/5,36/a_45
		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/0
l_384:	ident_2:	vfd a36/s   ,36/i_c,36/c_pigz,36/(l_385-l_org)/5,36/a_46
		vfd a36/s   ,36/i_c,36/c_xnm,36/(ident_3-l_org)/5,36/a_46
		vfd a36/s   ,36/i_c,36/c_udneli,36/(l_385-l_org)/5,36/a_46
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_385:	ident_1:	vfd a36/    ,36/i_r,36/r_rt,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_ieqlvl,36/(ident_2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ident_3:	vfd a36/s   ,36/i_r,36/r_pls,36/(l_386-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_sub,36/(l_386-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(ident_1-l_org)/5,36/0
l_386:		vfd a36/s   ,36/i_c,36/c_unsint,36/(ident_1-l_org)/5,36/a_65
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	sid:	vfd a36/    ,36/i_c,36/c_type9,36/(l_387-l_org)/5,36/a_59
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_387:		vfd a36/    ,36/i_s,36/(ident-l_org)/5,36/(succ-l_org)/5,36/a_114
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	rid:	vfd a36/    ,36/i_c,36/c_edalit,36/(l_388-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_388:		vfd a36/    ,36/i_s,36/(ident-l_org)/5,36/(succ-l_org)/5,36/a_114
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	verb:	vfd a36/    ,36/i_c,36/c_verb,36/(succ-l_org)/5,36/a_16
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	cverb:	vfd a36/    ,36/i_n,36/0,36/(l_389-l_org)/5,36/0
l_389:	verb1:	vfd a36/    ,36/i_n,36/0,36/(l_390-l_org)/5,36/a_eos
l_390:	verb2:	vfd a36/    ,36/i_c,36/c_impvrb,36/(succ-l_org)/5,36/a_16
		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/0
	o_ae:	vfd a36/    ,36/i_s,36/(ate1-l_org)/5,36/(l_391-l_org)/5,36/0
l_391:	o_ae1:	vfd a36/    ,36/i_n,36/0,36/(l_392-l_org)/5,36/a_103
l_392:		vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_393-l_org)/5,36/0
l_393:		vfd a36/    ,36/i_c,36/c_not_opt,36/(o_ae2-l_org)/5,36/0
l_394:		vfd a36/s   ,36/i_r,36/r_not,36/(o_ae2-l_org)/5,36/0
	endwd:	vfd a36/s   ,36/i_s,36/(end_word-l_org)/5,36/(l_395-l_org)/5,36/a_74
		vfd a36/    ,36/i_n,36/0,36/(verb2-l_org)/5,36/a_105
l_395:	endwd1:	vfd a36/    ,36/i_n,36/0,36/(verb2-l_org)/5,36/a_104
	o_ae2:	vfd a36/    ,36/i_s,36/(ate-l_org)/5,36/(l_396-l_org)/5,36/a_104
l_396:	endwd2:	vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_397-l_org)/5,36/0
l_397:		vfd a36/s   ,36/i_s,36/(end_word-l_org)/5,36/(endwd1-l_org)/5,36/a_74
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	o_inv:	vfd a36/s   ,36/i_r,36/r_key,36/(l_398-l_org)/5,36/0
l_398:		vfd a36/    ,36/i_n,36/0,36/(l_399-l_org)/5,36/a_103
l_399:		vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_400-l_org)/5,36/0
l_400:		vfd a36/    ,36/i_c,36/c_not_opt,36/(o_inv1-l_org)/5,36/0
l_401:		vfd a36/s   ,36/i_r,36/r_not,36/(l_402-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/0
l_402:	o_inv1:	vfd a36/    ,36/i_s,36/(ik-l_org)/5,36/(endwd2-l_org)/5,36/a_104
		vfd a36/    ,36/i_n,36/0,36/(endwd2-l_org)/5,36/0
	o_eop:	vfd a36/    ,36/i_s,36/(eop1-l_org)/5,36/(l_403-l_org)/5,36/0
l_403:	o_eop1:	vfd a36/    ,36/i_n,36/0,36/(l_404-l_org)/5,36/a_103
l_404:		vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_405-l_org)/5,36/0
l_405:		vfd a36/    ,36/i_c,36/c_not_opt,36/(o_eop2-l_org)/5,36/0
l_406:		vfd a36/s   ,36/i_r,36/r_not,36/(o_eop2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/0
	o_eop2:	vfd a36/    ,36/i_s,36/(eop-l_org)/5,36/(endwd2-l_org)/5,36/a_104
		vfd a36/    ,36/i_n,36/0,36/(endwd2-l_org)/5,36/0
	o_se:	vfd a36/    ,36/i_s,36/(ose1-l_org)/5,36/(o_se2-l_org)/5,36/0
	o_se1:	vfd a36/    ,36/i_s,36/(ose2-l_org)/5,36/(l_407-l_org)/5,36/0
l_407:	o_se2:	vfd a36/    ,36/i_n,36/0,36/(l_408-l_org)/5,36/a_103
l_408:		vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_409-l_org)/5,36/0
l_409:		vfd a36/    ,36/i_c,36/c_not_opt,36/(o_se3-l_org)/5,36/0
l_410:		vfd a36/s   ,36/i_r,36/r_not,36/(l_411-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/0
l_411:	o_se3:	vfd a36/    ,36/i_s,36/(ose-l_org)/5,36/(endwd2-l_org)/5,36/a_104
		vfd a36/    ,36/i_n,36/0,36/(endwd2-l_org)/5,36/0
	o_ov:	vfd a36/    ,36/i_s,36/(ov1-l_org)/5,36/(l_412-l_org)/5,36/0
l_412:	o_ov1:	vfd a36/    ,36/i_n,36/0,36/(l_413-l_org)/5,36/a_103
l_413:		vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_414-l_org)/5,36/0
l_414:		vfd a36/    ,36/i_c,36/c_not_opt,36/(o_ov2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/0
l_415:		vfd a36/s   ,36/i_r,36/r_not,36/(l_416-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/0
l_416:	o_ov2:	vfd a36/    ,36/i_s,36/(ov-l_org)/5,36/(endwd2-l_org)/5,36/a_104
		vfd a36/    ,36/i_n,36/0,36/(endwd2-l_org)/5,36/0
	o_nd:	vfd a36/    ,36/i_n,36/0,36/(l_417-l_org)/5,36/a_103
l_417:		vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_418-l_org)/5,36/0
l_418:		vfd a36/    ,36/i_c,36/c_not_opt,36/(o_nd1-l_org)/5,36/0
l_419:		vfd a36/    ,36/i_s,36/(with_data-l_org)/5,36/(endwd2-l_org)/5,36/a_104
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/0
	o_nd1:	vfd a36/    ,36/i_s,36/(no_data-l_org)/5,36/(endwd2-l_org)/5,36/a_104
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/0
	o_ex:	vfd a36/    ,36/i_s,36/(oe1-l_org)/5,36/(l_420-l_org)/5,36/0
l_420:	o_ex1:	vfd a36/    ,36/i_n,36/0,36/(l_421-l_org)/5,36/a_103
l_421:		vfd a36/    ,36/i_s,36/(imp-l_org)/5,36/(l_422-l_org)/5,36/0
l_422:		vfd a36/    ,36/i_c,36/c_not_opt,36/(o_ex2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/0
l_423:		vfd a36/s   ,36/i_r,36/r_not,36/(l_424-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(endwd-l_org)/5,36/0
l_424:	o_ex2:	vfd a36/    ,36/i_s,36/(oe-l_org)/5,36/(endwd2-l_org)/5,36/a_104
		vfd a36/    ,36/i_n,36/0,36/(endwd2-l_org)/5,36/0
	end_word:	vfd a36/    ,36/i_n,36/0,36/(l_425-l_org)/5,36/a_95
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_add-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_call-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_comp-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_del-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_div-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_eval-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_if-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_mul-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_perf-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_read-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_rec-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_ret-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_rew-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_sea-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_sta-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_str-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_sub-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_uns-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(e_wr-l_org)/5,36/0
l_425:	e_add:	vfd a36/    ,36/i_r,36/r_end_add,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_call:	vfd a36/    ,36/i_r,36/r_end_call,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_comp:	vfd a36/    ,36/i_r,36/r_end_compute,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_del:	vfd a36/    ,36/i_r,36/r_end_delete,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_div:	vfd a36/    ,36/i_r,36/r_end_divide,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_eval:	vfd a36/    ,36/i_r,36/r_end_evaluate,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_if:	vfd a36/    ,36/i_r,36/r_end_if,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_mul:	vfd a36/    ,36/i_r,36/r_end_multiply,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_perf:	vfd a36/    ,36/i_r,36/r_end_perform,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_read:	vfd a36/    ,36/i_r,36/r_end_read,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_rec:	vfd a36/    ,36/i_r,36/r_end_receive,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_ret:	vfd a36/    ,36/i_r,36/r_end_return,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_rew:	vfd a36/    ,36/i_r,36/r_end_rewrite,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_sea:	vfd a36/    ,36/i_r,36/r_end_search,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_sta:	vfd a36/    ,36/i_r,36/r_end_start,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_str:	vfd a36/    ,36/i_r,36/r_end_string,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_sub:	vfd a36/    ,36/i_r,36/r_end_subtract,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_uns:	vfd a36/    ,36/i_r,36/r_end_unstring,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	e_wr:	vfd a36/    ,36/i_r,36/r_end_write,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	wd:	vfd a36/s   ,36/i_r,36/r_with,36/(l_426-l_org)/5,36/0
l_426:	wd1:	vfd a36/s   ,36/i_r,36/r_data,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ov:	vfd a36/s   ,36/i_r,36/r_on,36/(l_427-l_org)/5,36/0
l_427:	ov1:	vfd a36/s   ,36/i_r,36/r_overflow,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	eop:	vfd a36/s   ,36/i_r,36/r_at,36/(l_428-l_org)/5,36/0
l_428:	eop1:	vfd a36/s   ,36/i_r,36/r_eop,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	nd:	vfd a36/s   ,36/i_r,36/r_no,36/(l_429-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_429:	nd1:	vfd a36/s   ,36/i_r,36/r_data,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ose:	vfd a36/s   ,36/i_r,36/r_on,36/(l_430-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_size,36/(ose2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_430:	ose1:	vfd a36/s   ,36/i_r,36/r_size,36/(l_431-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_431:	ose2:	vfd a36/s   ,36/i_r,36/r_error,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	oe:	vfd a36/s   ,36/i_r,36/r_on,36/(l_432-l_org)/5,36/0
l_432:	oe1:	vfd a36/s   ,36/i_r,36/r_exception,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ate:	vfd a36/s   ,36/i_r,36/r_at,36/(l_433-l_org)/5,36/0
l_433:	ate1:	vfd a36/s   ,36/i_r,36/r_end,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	ik:	vfd a36/s   ,36/i_r,36/r_invalid,36/(l_434-l_org)/5,36/0
l_434:		vfd a36/s   ,36/i_r,36/r_key,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/0
	imp:	vfd a36/    ,36/i_c,36/c_impsw,36/(l_435-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_435:		vfd a36/    ,36/i_s,36/(verb-l_org)/5,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/0
	nonumid:	vfd a36/    ,36/i_c,36/c_nonumlit,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_nonumdn,36/(l_436-l_org)/5,36/a_59
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_436:		vfd a36/    ,36/i_s,36/(ident-l_org)/5,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	usnoned:	vfd a36/    ,36/i_c,36/c_usagid,36/(l_437-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_437:		vfd a36/    ,36/i_c,36/c_edick,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	elnumint:	vfd a36/    ,36/i_c,36/c_elnuint,36/(succ-l_org)/5,36/0
	elnint:	vfd a36/    ,36/i_c,36/c_elnudnint,36/(el_1-l_org)/5,36/0
	el_2:	vfd a36/    ,36/i_r,36/r_all,36/(l_438-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_zero,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_438:		vfd a36/s   ,36/i_n,36/0,36/(l_439-l_org)/5,36/0
l_439:		vfd a36/    ,36/i_r,36/r_zero,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	el_1:	vfd a36/    ,36/i_s,36/(ident-l_org)/5,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	elnuitem:	vfd a36/    ,36/i_c,36/c_nlit,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_elnuit,36/(eln_1-l_org)/5,36/a_59
		vfd a36/    ,36/i_r,36/r_all,36/(l_440-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_zero,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_440:		vfd a36/s   ,36/i_n,36/0,36/(l_441-l_org)/5,36/0
l_441:		vfd a36/    ,36/i_r,36/r_zero,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	eln_1:	vfd a36/    ,36/i_s,36/(ident-l_org)/5,36/(succ-l_org)/5,36/a_114
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	elusid:	vfd a36/    ,36/i_c,36/c_nonumlit,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_figconall,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_eldis,36/(l_442-l_org)/5,36/a_59
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_442:		vfd a36/    ,36/i_s,36/(ident-l_org)/5,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	usagid:	vfd a36/    ,36/i_c,36/c_usagid,36/(alel2-l_org)/5,36/a_59
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	alel:	vfd a36/    ,36/i_c,36/c_altst,36/(l_443-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_443:	alel2:	vfd a36/    ,36/i_s,36/(ident-l_org)/5,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	edalel:	vfd a36/    ,36/i_c,36/c_edaltst,36/(alel2-l_org)/5,36/a_60
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	r_1:	vfd a36/    ,36/i_n,36/0,36/(l_444-l_org)/5,36/a_56
l_444:		vfd a36/    ,36/i_c,36/c_prdef,36/(decl-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_endcob,36/(decl-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_verb,36/(decl-l_org)/5,36/a_eos
		vfd a36/s   ,36/i_r,36/r_per,36/(decl-l_org)/5,36/a_eos
		vfd a36/    ,36/i_r,36/r_declaratives,36/(decl-l_org)/5,36/a_eos
		vfd a36/s   ,36/i_n,36/0,36/(l_444-l_org)/5,36/0
	r_2:	vfd a36/    ,36/i_n,36/0,36/(l_445-l_org)/5,36/a_56
l_445:		vfd a36/    ,36/i_c,36/c_prdef,36/(l_446-l_org)/5,36/a_43
		vfd a36/    ,36/i_c,36/c_endcob,36/(l_446-l_org)/5,36/a_43
		vfd a36/    ,36/i_c,36/c_verb,36/(l_446-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_enddec,36/(l_446-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_per,36/(l_446-l_org)/5,36/a_36
		vfd a36/s   ,36/i_n,36/0,36/(l_445-l_org)/5,36/0
l_446:		vfd a36/    ,36/i_n,36/0,36/(nodecl-l_org)/5,36/a_41
	r_3:	vfd a36/    ,36/i_n,36/0,36/(l_447-l_org)/5,36/a_56
l_447:		vfd a36/    ,36/i_c,36/c_sechdr,36/(nodecl-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_paranm,36/(nodecl-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_endcob,36/(nodecl-l_org)/5,36/a_eos
		vfd a36/s   ,36/i_n,36/0,36/(l_447-l_org)/5,36/0
	r_4:	vfd a36/    ,36/i_n,36/0,36/(l_448-l_org)/5,36/a_56
l_448:		vfd a36/    ,36/i_c,36/c_sechdr,36/(decl_sent-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_enddec,36/(decl_sent-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_endcob,36/(decl_sent-l_org)/5,36/a_eos
		vfd a36/s   ,36/i_n,36/0,36/(l_448-l_org)/5,36/0
	r_5:	vfd a36/    ,36/i_n,36/0,36/(l_449-l_org)/5,36/a_56
l_449:		vfd a36/    ,36/i_c,36/c_verb,36/(para_1-l_org)/5,36/a_eos
		vfd a36/    ,36/i_r,36/r_per,36/(para_1-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_paranm,36/(para_1-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_sechdr,36/(para_1-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_enddec,36/(para_1-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_endcob,36/(para_1-l_org)/5,36/a_eos
		vfd a36/s   ,36/i_n,36/0,36/(l_449-l_org)/5,36/0
	r_6:	vfd a36/    ,36/i_n,36/0,36/(l_450-l_org)/5,36/a_56
l_450:		vfd a36/    ,36/i_c,36/c_enddec,36/(l_451-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_endcob,36/(r_61-l_org)/5,36/a_eos
		vfd a36/s   ,36/i_n,36/0,36/(l_450-l_org)/5,36/0
l_451:		vfd a36/s   ,36/i_r,36/r_per,36/(l_452-l_org)/5,36/a_eos
		vfd a36/    ,36/i_n,36/0,36/(l_452-l_org)/5,36/a_eos
l_452:	r_61:	vfd a36/    ,36/i_n,36/0,36/(nodecl-l_org)/5,36/a_55
	r_7:	vfd a36/    ,36/i_n,36/0,36/(l_453-l_org)/5,36/a_56
l_453:		vfd a36/    ,36/i_c,36/c_paranm,36/(para_2-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_sechdr,36/(para_2-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_enddec,36/(para_2-l_org)/5,36/a_eos
		vfd a36/    ,36/i_c,36/c_endcob,36/(para_2-l_org)/5,36/a_eos
		vfd a36/s   ,36/i_n,36/0,36/(l_453-l_org)/5,36/0
	succ:	vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/a_1
	fail:	vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/a_2
	edalit:	vfd a36/    ,36/i_c,36/c_edalit,36/(l_454-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_454:		vfd a36/    ,36/i_s,36/(ident-l_org)/5,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
	condition:	vfd a36/    ,36/i_n,36/0,36/(l_455-l_org)/5,36/a_82
l_455:	lpar:	vfd a36/s   ,36/i_r,36/r_lt,36/(lpar-l_org)/5,36/a_63
	lpar2:	vfd a36/    ,36/i_c,36/c_resword,36/(res-l_org)/5,36/0
	res1:	vfd a36/    ,36/i_s,36/(condop-l_org)/5,36/(infix_rel-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_sscondnm,36/(bop-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	res:	vfd a36/    ,36/i_s,36/(relop-l_org)/5,36/(imp_subj-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_not,36/(not_cond-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_is,36/(is_cond-l_org)/5,36/0
		vfd a36/    ,36/i_s,36/(pos_rel-l_org)/5,36/(imp_subj-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_message,36/(l_456-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(res1-l_org)/5,36/0
l_456:		vfd a36/s   ,36/i_r,36/r_for,36/(l_457-l_org)/5,36/0
l_457:		vfd a36/s   ,36/i_c,36/c_incdnm,36/(bop-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	not_cond:	vfd a36/    ,36/i_r,36/r_lt,36/(lpar-l_org)/5,36/0
		vfd a36/    ,36/i_s,36/(relop-l_org)/5,36/(imp_subj-l_org)/5,36/0
l_458:		vfd a36/s   ,36/i_r,36/r_not,36/(rel-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(lpar2-l_org)/5,36/0
	is_cond:	vfd a36/s   ,36/i_r,36/r_not,36/(rel-l_org)/5,36/0
		vfd a36/    ,36/i_s,36/(relop-l_org)/5,36/(imp_subj-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_unequal,36/(l_459-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_459:		vfd a36/s   ,36/i_r,36/r_to,36/(imp_subj-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(imp_subj-l_org)/5,36/0
	rel:	vfd a36/    ,36/i_s,36/(relop-l_org)/5,36/(l_460-l_org)/5,36/0
l_460:	imp_subj:	vfd a36/    ,36/i_c,36/c_is_sub_opt,36/(obj_op-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	infix_rel:	vfd a36/    ,36/i_s,36/(relop-l_org)/5,36/(obj_op-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_not,36/(inf_rel-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_is,36/(inf_is-l_org)/5,36/0
		vfd a36/    ,36/i_s,36/(pos_rel-l_org)/5,36/(obj_op-l_org)/5,36/0
	inf_test:	vfd a36/s   ,36/i_c,36/c_pnz,36/(bop-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_numeric,36/(bop-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_alphabetic,36/(bop-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_is_sub_opt,36/(bop-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	inf_is:	vfd a36/s   ,36/i_r,36/r_not,36/(inf_rel-l_org)/5,36/0
		vfd a36/    ,36/i_s,36/(relop-l_org)/5,36/(obj_op-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_unequal,36/(l_461-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(inf_test-l_org)/5,36/0
l_461:		vfd a36/s   ,36/i_r,36/r_to,36/(obj_op-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(obj_op-l_org)/5,36/0
	inf_rel:	vfd a36/    ,36/i_s,36/(relop-l_org)/5,36/(l_462-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(inf_test-l_org)/5,36/0
l_462:	obj_op:	vfd a36/    ,36/i_s,36/(condop-l_org)/5,36/(l_463-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_463:	bop:	vfd a36/    ,36/i_n,36/0,36/(l_464-l_org)/5,36/a_72
l_464:		vfd a36/s   ,36/i_r,36/r_and,36/(lpar-l_org)/5,36/0
	bop3:	vfd a36/s   ,36/i_r,36/r_or,36/(lpar-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_rt,36/(more_rpar-l_org)/5,36/a_73
		vfd a36/    ,36/i_c,36/c_lptopstk,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	more_rpar:	vfd a36/s   ,36/i_r,36/r_rt,36/(l_465-l_org)/5,36/a_64
		vfd a36/s   ,36/i_r,36/r_and,36/(lpar-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(bop3-l_org)/5,36/0
l_465:		vfd a36/    ,36/i_c,36/c_lptopstk,36/(more_rpar-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	pos_rel:	vfd a36/s   ,36/i_r,36/r_equals,36/(succ-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_exceeds,36/(succ-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_unequal,36/(l_466-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_466:		vfd a36/s   ,36/i_r,36/r_to,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/0
	relop:	vfd a36/s   ,36/i_c,36/c_relop,36/(l_467-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_467:		vfd a36/s   ,36/i_r,36/r_to,36/(succ-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_than,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/0
	condop:	vfd a36/    ,36/i_r,36/r_all,36/(cop4-l_org)/5,36/0
		vfd a36/    ,36/i_s,36/(arithexp-l_org)/5,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_468-l_org)/5,36/a_124
l_468:		vfd a36/s   ,36/i_s,36/(sid-l_org)/5,36/(succ-l_org)/5,36/a_123
	cop3:	vfd a36/s   ,36/i_c,36/c_lit,36/(succ-l_org)/5,36/0
	cop2:	vfd a36/s   ,36/i_c,36/c_figconall,36/(succ-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_xnm,36/(succ-l_org)/5,36/0
		vfd a36/s   ,36/i_s,36/(xdname-l_org)/5,36/(succ-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_all,36/(l_469-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_469:	cop4:	vfd a36/s   ,36/i_n,36/0,36/(l_470-l_org)/5,36/0
l_470:		vfd a36/    ,36/i_c,36/c_figconall,36/(cop2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_nonumlit,36/(cop3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
	arithexp:	vfd a36/s   ,36/i_r,36/r_pls,36/(ae_3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_sub,36/(ae_3-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_471-l_org)/5,36/a_124
l_471:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(ae_1-l_org)/5,36/a_123
		vfd a36/s   ,36/i_r,36/r_lt,36/(l_472-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fail-l_org)/5,36/0
l_472:	ae_2:	vfd a36/s   ,36/i_r,36/r_pls,36/(l_473-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_sub,36/(l_473-l_org)/5,36/0
l_473:	ae_3:	vfd a36/    ,36/i_n,36/0,36/(l_474-l_org)/5,36/a_124
l_474:		vfd a36/s   ,36/i_s,36/(elnuitem-l_org)/5,36/(l_475-l_org)/5,36/a_123
		vfd a36/s   ,36/i_r,36/r_lt,36/(ae_2-l_org)/5,36/a_63
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
l_475:	ae_1:	vfd a36/s   ,36/i_c,36/c_arop,36/(ae_2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_rt,36/(l_476-l_org)/5,36/a_64
		vfd a36/    ,36/i_n,36/0,36/(succ-l_org)/5,36/0
l_476:		vfd a36/    ,36/i_c,36/c_lptopstk,36/(ae_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r_2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_477-l_org)/5,36/0
l_477:		vfd a36/    ,36/i_r,36/r_records,36/(l_477-l_org)/5,36/0
l_478:		vfd a36/    ,36/i_r,36/r_in,36/(l_478-l_org)/5,36/0
l_479:		vfd a36/    ,36/i_r,36/r_of,36/(l_479-l_org)/5,36/0
l_480:		vfd a36/    ,36/i_r,36/r_end_of_page,36/(l_480-l_org)/5,36/0
l_481:		vfd a36/    ,36/i_r,36/r_equal,36/(l_481-l_org)/5,36/0
l_482:		vfd a36/    ,36/i_r,36/r_greater,36/(l_482-l_org)/5,36/0
l_483:		vfd a36/    ,36/i_r,36/r_copy,36/(l_483-l_org)/5,36/0
l_484:		vfd a36/    ,36/i_r,36/r_corr,36/(l_484-l_org)/5,36/0
l_485:		vfd a36/    ,36/i_r,36/r_corresponding,36/(l_485-l_org)/5,36/0
l_486:		vfd a36/    ,36/i_r,36/r_off,36/(l_486-l_org)/5,36/0
l_487:		vfd a36/    ,36/i_r,36/r_replace,36/(l_487-l_org)/5,36/0
l_488:		vfd a36/    ,36/i_r,36/r_high_value,36/(l_488-l_org)/5,36/0
l_489:		vfd a36/    ,36/i_r,36/r_high_values,36/(l_489-l_org)/5,36/0
l_490:		vfd a36/    ,36/i_r,36/r_low_value,36/(l_490-l_org)/5,36/0
l_491:		vfd a36/    ,36/i_r,36/r_low_values,36/(l_491-l_org)/5,36/0
l_492:		vfd a36/    ,36/i_r,36/r_zero,36/(l_492-l_org)/5,36/0
l_493:		vfd a36/    ,36/i_r,36/r_zeros,36/(l_493-l_org)/5,36/0
l_494:		vfd a36/    ,36/i_r,36/r_zeroes,36/(l_494-l_org)/5,36/0
l_495:		vfd a36/    ,36/i_r,36/r_quote,36/(l_495-l_org)/5,36/0
l_496:		vfd a36/    ,36/i_r,36/r_quotes,36/(l_496-l_org)/5,36/0
l_497:		vfd a36/    ,36/i_r,36/r_space,36/(l_497-l_org)/5,36/0
l_498:		vfd a36/    ,36/i_r,36/r_spaces,36/(l_498-l_org)/5,36/0
l_499:		vfd a36/    ,36/i_r,36/r_linage_counter,36/(l_499-l_org)/5,36/0
l_500:		vfd a36/    ,36/i_r,36/r_negative,36/(l_500-l_org)/5,36/0
l_501:		vfd a36/    ,36/i_r,36/r_positive,36/(l_501-l_org)/5,36/0
l_502:		vfd a36/    ,36/i_r,36/r_through,36/(l_502-l_org)/5,36/0
l_503:		vfd a36/    ,36/i_r,36/r_character,36/(l_503-l_org)/5,36/0
l_504:		vfd a36/    ,36/i_r,36/r_line,36/(l_504-l_org)/5,36/0
l_505:		vfd a36/    ,36/i_r,36/r_pls,36/(l_505-l_org)/5,36/0
l_506:		vfd a36/    ,36/i_r,36/r_sub,36/(l_506-l_org)/5,36/0
l_507:		vfd a36/    ,36/i_r,36/r_tim,36/(l_507-l_org)/5,36/0
l_508:		vfd a36/    ,36/i_r,36/r_div,36/(l_508-l_org)/5,36/0
l_509:		vfd a36/    ,36/i_r,36/r_exp,36/(l_509-l_org)/5,36/0
l_510:		vfd a36/    ,36/i_r,36/r_ls,36/(l_510-l_org)/5,36/0
l_511:		vfd a36/    ,36/i_r,36/r_gt,36/(l_511-l_org)/5,36/0
l_512:		vfd a36/    ,36/i_r,36/r_eq,36/(l_512-l_org)/5,36/0
	equ c_acc_dev,197
	equ c_actloglp,136
	equ c_adrisadr,158
	equ c_alelnuitm,117
	equ c_alph,105
	equ c_alphnm,195
	equ c_alphoral,122
	equ c_altlegal,191
	equ c_altprnm,13
	equ c_altst,188
	equ c_amarg,201
	equ c_an,102
	equ c_andait,68
	equ c_anes,98
	equ c_argscomp,135
	equ c_arop,80
	equ c_aroprp,123
	equ c_asfil,49
	equ c_cdname,87
	equ c_ckdecpn,167
	equ c_ckdsegnum,171
	equ c_ckerrex,172
	equ c_ckextend,176
	equ c_ckinput,173
	equ c_ckintbit,170
	equ c_ckio,175
	equ c_cklit,166
	equ c_cklit1,180
	equ c_cklit2,182
	equ c_ckoutput,174
	equ c_ckprpnbit,152
	equ c_ckrcpref,165
	equ c_ckrng1,163
	equ c_ckrng2,164
	equ c_cksegm,168
	equ c_cktp25,162
	equ c_csstst,190
	equ c_cstst,187
	equ c_daib,140
	equ c_dana,88
	equ c_decnondec,151
	equ c_descnm,26
	equ c_descnmra,35
	equ c_deswon,90
	equ c_deswz,86
	equ c_devprt,210
	equ c_disp_dev,198
	equ c_dninfl,61
	equ c_ecnt,34
	equ c_edalelnue,120
	equ c_edalit,116
	equ c_edaltst,189
	equ c_edick,161
	equ c_egrze,69
	equ c_elaanne,149
	equ c_eldis,95
	equ c_elemred,82
	equ c_elneds,64
	equ c_elnudnint,119
	equ c_elnuindi,65
	equ c_elnuint,118
	equ c_elnuit,66
	equ c_endcob,39
	equ c_enddec,115
	equ c_examlitid,81
	equ c_figconall,22
	equ c_file,67
	equ c_filenm,5
	equ c_fileno,43
	equ c_filnefil,143
	equ c_filno,121
	equ c_flusisds,63
	equ c_formtlb,6
	equ c_gotod,145
	equ c_group,99
	equ c_ieqlvl,75
	equ c_impsw,85
	equ c_impvrb,41
	equ c_in_line,72
	equ c_inbit,1
	equ c_incdnm,18
	equ c_indeqind,77
	equ c_indev,153
	equ c_indexed,76
	equ c_indxfile,144
	equ c_inrng,47
	equ c_is_cobol,24
	equ c_is_lang,200
	equ c_is_rout,160
	equ c_is_sub_opt,126
	equ c_is_user_word,206
	equ c_ixfil,20
	equ c_ixrlrady,83
	equ c_ixrlsqdy,155
	equ c_keyiskey,157
	equ c_keylbl,52
	equ c_lefdep,112
	equ c_lefparstk,131
	equ c_lev_test,192
	equ c_lident,2
	equ c_linage,71
	equ c_linktot,3
	equ c_lit,21
	equ c_logbitstk,132
	equ c_logstk,133
	equ c_lptopstk,137
	equ c_mcobol,181
	equ c_mnenm,56
	equ c_msfilnm,31
	equ c_nestedif,141
	equ c_njustr,146
	equ c_nlit,208
	equ c_nomsss,30
	equ c_nonumdn,147
	equ c_nonumlit,15
	equ c_not_opt,11
	equ c_notalpstk,129
	equ c_notnumstk,128
	equ c_notseqac,29
	equ c_notseqfl,38
	equ c_nsfilnm,17
	equ c_nsrecnm,70
	equ c_nstorg,185
	equ c_nstream,183
	equ c_nues,97
	equ c_numlit,12
	equ c_numstak,127
	equ c_nznumlit,169
	equ c_on_off,196
	equ c_onechnosn,54
	equ c_open_mode,207
	equ c_outcdnm,19
	equ c_outdev,154
	equ c_outrng,48
	equ c_paranm,8
	equ c_pigz,78
	equ c_pigz_by,209
	equ c_pnz,125
	equ c_posint,59
	equ c_prdef,8
	equ c_preosp,40
	equ c_preospn,96
	equ c_prnm,14
	equ c_prnum,10
	equ c_prt_con,199
	equ c_rae,148
	equ c_rafl,45
	equ c_recnm,46
	equ c_relfile,156
	equ c_relop,124
	equ c_repnm,27
	equ c_resword,193
	equ c_rident,7
	equ c_ritdep,111
	equ c_rpid,25
	equ c_saanm,36
	equ c_said,37
	equ c_san,110
	equ c_sechdr,4
	equ c_secsw,84
	equ c_seqfil,53
	equ c_seqnext,91
	equ c_seqstmfil,211
	equ c_set_pigz,203
	equ c_set_xint,202
	equ c_sizlit,28
	equ c_slelef,114
	equ c_sler,100
	equ c_snae,108
	equ c_snal,107
	equ c_sndrdp,103
	equ c_snne,109
	equ c_snon,106
	equ c_snor,101
	equ c_snos,104
	equ c_sqacdyac,23
	equ c_sqfl,44
	equ c_sqrlsqac,55
	equ c_srchf2,142
	equ c_srchid,50
	equ c_srtfil,60
	equ c_sscondnm,134
	equ c_ssnm,159
	equ c_sterm,93
	equ c_stream,184
	equ c_stun,113
	equ c_sudana,74
	equ c_suxdnm,150
	equ c_tst_pigz,205
	equ c_tst_xint,204
	equ c_type9,194
	equ c_udneli,186
	equ c_undana,73
	equ c_unelnudn,92
	equ c_unsint,79
	equ c_unxdnm,138
	equ c_usagid,94
	equ c_useform1,32
	equ c_useform1a,57
	equ c_useform1b,89
	equ c_useformds,177
	equ c_useformr,178
	equ c_useformrw,179
	equ c_useid,16
	equ c_usisds,62
	equ c_usornm,51
	equ c_varsiz,42
	equ c_verb,9
	equ c_xint,58
	equ c_xnm,33
	equ c_zerstk,130
	equ a_1,1
	equ a_10,10
	equ a_100,100
	equ a_101,101
	equ a_102,102
	equ a_103,103
	equ a_104,104
	equ a_105,105
	equ a_106,106
	equ a_107,107
	equ a_108,108
	equ a_109,109
	equ a_11,11
	equ a_110,110
	equ a_111,111
	equ a_112,112
	equ a_113,113
	equ a_114,114
	equ a_115,115
	equ a_116,116
	equ a_117,117
	equ a_118,118
	equ a_119,119
	equ a_12,12
	equ a_120,120
	equ a_121,121
	equ a_122,122
	equ a_123,123
	equ a_124,124
	equ a_13,13
	equ a_14,14
	equ a_15,15
	equ a_16,16
	equ a_17,17
	equ a_18,18
	equ a_19,19
	equ a_2,2
	equ a_20,20
	equ a_21,21
	equ a_22,22
	equ a_23,23
	equ a_24,24
	equ a_25,25
	equ a_26,26
	equ a_27,27
	equ a_28,28
	equ a_29,29
	equ a_3,3
	equ a_30,30
	equ a_31,31
	equ a_32,32
	equ a_33,33
	equ a_34,34
	equ a_35,35
	equ a_36,36
	equ a_37,37
	equ a_38,38
	equ a_39,39
	equ a_4,4
	equ a_40,40
	equ a_41,41
	equ a_42,42
	equ a_43,43
	equ a_44,44
	equ a_45,45
	equ a_46,46
	equ a_47,47
	equ a_48,48
	equ a_49,49
	equ a_5,5
	equ a_50,50
	equ a_51,51
	equ a_52,52
	equ a_53,53
	equ a_54,54
	equ a_55,55
	equ a_56,56
	equ a_57,57
	equ a_58,58
	equ a_59,59
	equ a_6,6
	equ a_60,60
	equ a_61,61
	equ a_62,62
	equ a_63,63
	equ a_64,64
	equ a_65,65
	equ a_66,66
	equ a_67,67
	equ a_68,68
	equ a_69,69
	equ a_7,7
	equ a_70,70
	equ a_71,71
	equ a_72,72
	equ a_73,73
	equ a_74,74
	equ a_75,75
	equ a_76,76
	equ a_77,77
	equ a_78,78
	equ a_79,79
	equ a_8,8
	equ a_80,80
	equ a_81,81
	equ a_82,82
	equ a_83,83
	equ a_84,84
	equ a_85,85
	equ a_88,88
	equ a_89,89
	equ a_9,9
	equ a_90,90
	equ a_91,91
	equ a_92,92
	equ a_93,93
	equ a_94,94
	equ a_95,95
	equ a_96,96
	equ a_97,97
	equ a_98,98
	equ a_99,99
	equ a_endjob,87
	equ a_eos,86
	equ r_eq,102
	equ r_lt,187
	equ r_rt,188
	equ r_tim,184
	equ r_exp,186
	equ r_pls,182
	equ r_sub,183
	equ r_per,189
	equ r_div,185
	equ r_ls,123
	equ r_gt,113
	equ r_accept,1
	equ r_add,2
	equ r_advancing,71
	equ r_after,72
	equ r_all,73
	equ r_alphabetic,74
	equ r_alter,4
	equ r_and,77
	equ r_ascending,78
	equ r_at,79
	equ r_before,80
	equ r_beginning,81
	equ r_by,82
	equ r_call,5
	equ r_cancel,7
	equ r_character,83
	equ r_characters,83
	equ r_close,8
	equ r_collating,515
	equ r_compute,40
	equ r_copy,522
	equ r_corr,524
	equ r_corresponding,524
	equ r_count,84
	equ r_data,196
	equ r_date,86
	equ r_day,87
	equ r_day_of_week,326
	equ r_debugging,88
	equ r_declaratives,89
	equ r_delete,22
	equ r_delimited,90
	equ r_delimiter,91
	equ r_depending,92
	equ r_descending,93
	equ r_disable,41
	equ r_display,42
	equ r_divide,9
	equ r_division,94
	equ r_down,95
	equ r_egi,233
	equ r_else,96
	equ r_emi,97
	equ r_enable,43
	equ r_end,98
	equ r_end_add,466
	equ r_end_call,467
	equ r_end_compute,468
	equ r_end_delete,469
	equ r_end_divide,470
	equ r_end_evaluate,471
	equ r_end_if,472
	equ r_end_multiply,473
	equ r_end_of_page,100
	equ r_end_perform,474
	equ r_end_read,475
	equ r_end_receive,476
	equ r_end_return,477
	equ r_end_rewrite,478
	equ r_end_search,479
	equ r_end_start,480
	equ r_end_string,481
	equ r_end_subtract,482
	equ r_end_unstring,483
	equ r_end_write,484
	equ r_ending,99
	equ r_eop,100
	equ r_equal,102
	equ r_equals,102
	equ r_error,3
	equ r_esi,105
	equ r_examine,50
	equ r_exceeds,113
	equ r_exception,107
	equ r_exit,12
	equ r_extend,216
	equ r_file,108
	equ r_first,109
	equ r_for,110
	equ r_from,111
	equ r_generate,45
	equ r_giving,112
	equ r_go,14
	equ r_greater,113
	equ r_high_value,221
	equ r_high_values,221
	equ r_hold,46
	equ r_i_o,119
	equ r_if,47
	equ r_in,101
	equ r_initial,114
	equ r_initiate,16
	equ r_input,115
	equ r_inspect,17
	equ r_into,116
	equ r_invalid,117
	equ r_is,118
	equ r_key,120
	equ r_label,121
	equ r_leading,122
	equ r_less,123
	equ r_linage_counter,564
	equ r_line,124
	equ r_lines,124
	equ r_lock,125
	equ r_low_value,229
	equ r_low_values,229
	equ r_merge,15
	equ r_message,126
	equ r_move,18
	equ r_multiply,10
	equ r_negative,127
	equ r_next,128
	equ r_no,129
	equ r_not,130
	equ r_numeric,131
	equ r_of,133
	equ r_off,574
	equ r_on,134
	equ r_open,19
	equ r_or,135
	equ r_output,137
	equ r_overflow,6
	equ r_page,139
	equ r_perform,20
	equ r_pointer,140
	equ r_positive,141
	equ r_printing,559
	equ r_procedure,142
	equ r_procedures,143
	equ r_proceed,144
	equ r_process,48
	equ r_program,146
	equ r_purge,58
	equ r_quote,235
	equ r_quotes,235
	equ r_read,21
	equ r_receive,23
	equ r_record,148
	equ r_records,195
	equ r_reel,149
	equ r_references,150
	equ r_release,24
	equ r_remainder,151
	equ r_removal,260
	equ r_replace,425
	equ r_replacing,152
	equ r_reporting,153
	equ r_return,25
	equ r_reversed,154
	equ r_rewind,155
	equ r_rewrite,27
	equ r_rounded,156
	equ r_run,157
	equ r_search,26
	equ r_section,158
	equ r_segment,159
	equ r_send,30
	equ r_sentence,160
	equ r_sequence,587
	equ r_set,31
	equ r_size,161
	equ r_sort,49
	equ r_space,192
	equ r_spaces,192
	equ r_standard,162
	equ r_start,56
	equ r_stop,33
	equ r_string,34
	equ r_subtract,11
	equ r_suppress,57
	equ r_suspend,35
	equ r_tallying,163
	equ r_terminal,164
	equ r_terminate,36
	equ r_than,165
	equ r_then,300
	equ r_through,166
	equ r_thru,166
	equ r_time,168
	equ r_times,168
	equ r_to,170
	equ r_transform,51
	equ r_unequal,171
	equ r_unit,172
	equ r_unstring,37
	equ r_until,173
	equ r_up,174
	equ r_upon,175
	equ r_use,39
	equ r_using,176
	equ r_varying,177
	equ r_when,178
	equ r_with,179
	equ r_write,38
	equ r_zero,180
	equ r_zeroes,180
	equ r_zeros,180
	end
~~~




		    cobol_db_phase.pl1              05/24/89  1044.4rew 05/24/89  0832.9      918099



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8082),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8082 cobol_db_phase.pl1 Fix wild array subscript.
                                                   END HISTORY COMMENTS */


/* Modified on 02/11/85 by FCH, [5.3-1], conditional statements revised, BUG561 */
/* Modified on 12/30/81 by FCH, [5.1-1], eof not properly detected if debugging mode, phx11819(BUG517)*/
/* Modified on 09/17/81 by FCH, debug proc not exec on ACCEPT MESSAGE COUNT, BUG505 */
/* Modified on 07/10/81 by FCH, [4.4-4], debug cards not processed unless use for debugging used (phx10378, BUG493) */
/* Modified on 02/20/81 by FCH, [4.4-3], fix debugging for communication statements, BUG465 */
/* Modified on 12/10/80 by FCH, [4.4-2], cobol_db_phase$initialize called by cobol_lex instead of cobol_res_words */
/* Modified on 10/20/80 by FCH, [4.4-1], automatic items changed to static int options(const) */
/* Modified on 06/13/80 by FCH, [4.3-1], debug-sub-i described with sign */
/* Modified on 05/08/80 by FCH, [4.2-1], END-PERFORM not written after PERFORM pn1 THRU pn2 */
/* Modified on 09/21/79 by FCH, [4.0-1], Fix DEBUG-LINE on pn (DB101) */
/* Created for Version 4.0 by FCH on 03/20/79 */






/* format: style3 */
cobol_db_phase:
     proc;

start:						/* the following are init changed to assign */
	gotodep = "0"b;
	preospn_bit = "0"b;
	nestifcnt = 0;
	cssub = 0;
	mod_num = 0;

	emrec = "0"b;
	copy_tab.size = 0;
	copy_mode = "0"b;
	impswitch = 0;
	decswitch = 0;
	nest_lev = 0;
	N_L = "1"b;
	secswitch = 0;

	i1 = 0;
	syntax_line_ptr = addr (sline);
	sline.s_exit = 59;				/* 59*5+5 */

	call cobol_db (pointer_to_internal, dumfix);	/* initialize diag item */

	dg_ptr = addr (diag_item);
	diag_item.size = 28;
	diag_item.type = 5;
	diag_item.run = 10;
	TOK_ptr, ft_ptr, occptr = null ();

/*[4.0-1]*/
	ln_not_emitted = "1"b;			/*[4.0-1]*/
	nines_ptr = null ();
	lev_dg_ptr = addr (lev_diag_item);
	lev_diag_item.size = 28;
	lev_diag_item.type = 5;
	lev_diag_item.run = 9;

	diag_item.info = "00000000"b;
	DIAG_NUM = 0;
	trace_ptr = addr (interp);
	tbit = fixed_common.syntax_trace;
	pn_count = 0;

	debug_table.cd.first_ptr, debug_table.cd.last_ptr = null ();
	debug_table.file.first_ptr, debug_table.file.last_ptr = null ();
	debug_table.proc.first_ptr, debug_table.proc.last_ptr = null ();
	debug_table.data.first_ptr, debug_table.data.last_ptr = null ();

	debug_table.cd.size = 0;
	debug_table.file.size = 0;
	debug_table.proc.size = 0;
	debug_table.data.size = 0;

	debug_table.cd.max = 5;
	debug_table.file.max = 20;
	debug_table.proc.max = 50;
	debug_table.data.max = 50;

	string (debug_table.data.all_refs) = "0"b;

	data_size = size (data_entry);
	proc_size = size (proc_entry);
	file_size = size (file_entry);
	cd_size = size (cd_entry);

	call st_init;
	all_procs = "0"b;
	TOK_TAB.size = 0;

	if tbit
	then call cobol_syntax_trace_$initialize_phase (trace_ptr, 4);

	call SCAN;

	current_line = syntax_line.s_exit;

	go to new_inst;

get_rec:
     entry (crp, REC_NUM);

/* called by cobol_get_rec which	*/
/* is called by cobol_res_words after	*/
/* PROCEDURE DIVISION		*/


	crp = addr (DD (REC_NUM));

/*[5.1-1]*/
	if REC_NUM = 17
	then REC_NUM = 0;

	return;

declare	crp		ptr,
	REC_NUM		fixed bin;

/*[4.4-1]*/
declare	DD		(16) char (73) static int options (constant)
			init ("~~~~~~ 01   debug-item.                                                 
", "~~~~~~ 02      debug-line      picture is x(6).                         
", "~~~~~~ 02      filler          picture is x value space.                
", "~~~~~~ 02      debug-name      picture is x(30).                        
", "~~~~~~ 02      filler          picture is x value space.                
", "~~~~~~ 02      debug-subs.
", "~~~~~~ 03      debug-sub-1     pic is s9999
", "~~~~~~                   sign is leading separate character.
", "~~~~~~ 03      filler          picture is x value space.                
", "~~~~~~ 03      debug-sub-2     pic is s9999
", "~~~~~~                   sign is leading separate character.
", "~~~~~~ 03      filler          picture is x value space.                
", "~~~~~~ 03      debug-sub-3     pic is s9999
", "~~~~~~                   sign is leading separate character.
", "~~~~~~ 03      filler          picture is x value space.                
", "~~~~~~ 02      debug-contents  picture is x(2048). ""~~~~~~""
");

get_perf:
     entry (crp, REC_NUM);

/* called by cobol_get_rec which	*/
/* is called by cobol_res_words after	*/
/* END DECLARATIVES			*/

/*[4.4-1]*/
declare	perf_line		char (72) static int;

declare	proc_count	fixed bin static int;

/*[5.1-1]*/
	if proc_def_size = 0 | proc_count >= proc_def_size + 1
	then do;
		REC_NUM = 0;
		return;
	     end;

	proc_count = proc_count + 1;

	if proc_count <= proc_def_size
	then do;

		perf_line = "~~~~~~     perform " || proc_def_table (proc_count) -> proc_def.name || ".
";

/*[4.4-1]*/
		crp = perf_line_ptr;

	     end;

	else crp = addr (TKN (17));

	return;


get_tok:
     entry (crp, REC_NUM);

/* called by cobol_get_rec which	*/
/* is called by cobol_res_words after	*/
/* WORKING STORAGE			*/

	crp = addr (TKN (REC_NUM));

/*[5.1-1]*/
	if REC_NUM = 18
	then REC_NUM = 0;


	return;

/*[4.4-1]*/
dcl	TKN		(17) char (73) static int options (constant)
			init ("~~~~~~      debug-line debug-name debug-contents                        
", "~~~~~~      debug-sub-1 debug-sub-2 debug-sub-3                         
", "~~~~~~      ""LLLLLL"" ""NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN""                   
", "~~~~~~      move to ""~"" ""~"" = space perform
", "~~~~~~      ""START PROGRAM"" ""SORT INPUT"" ""SORT OUTPUT"" ""MERGE OUTPUT""   
", "~~~~~~      ""PERFORM LOOP"" ""USE PROCEDURE"" ""FALL THROUGH""               
", "~~~~~~      set compute up by end-perform times until not )
", "~~~~~~      thru add end-if
", "~~~~~~      on size error at end invalid key eop overflow
", "~~~~~~      with data exception no end-add end-call 
", "~~~~~~      end-compute end-delete
", "~~~~~~      end-divide end-evaluate end-if end-multiply end-perform
", "~~~~~~      end-read end-receive end-return end-rewrite
", "~~~~~~      end-search end-start
", "~~~~~~      end-string end-subtract end-unstring end-write
", "~~~~~~      ( if DEBUG-ON . debug-subs ""999999""
", "~~~~~~      ""~~~""
");

proc_def_ptr:
     entry (proc_def_ptr);				/* used by cobol_res_words, use for debugging */
declare	proc_def_table	(64) ptr static internal;
declare	proc_def_size	fixed bin static internal;

declare	proc_def_ptr	ptr;

	proc_def_size = proc_def_size + 1;
	proc_def_table (proc_def_size) = addrel (proc_def_ptr, 1);

	return;

initialize:
     entry;

/*[4.4-1]*/
declare	perf_line_ptr	ptr static int;		/* called by cobol_lex */
	proc_def_size, proc_count = 0;		/*[4.4-2]*/
						/*	fixed_common.debug = "1"b;*/
						/*[4.4-1]*/
	perf_line_ptr = addr (perf_line);

	return;

/*					*/
/*	 syntax interpreter			*/
/*					*/

fail:						/*failure */
	if tbit
	then call cobol_syntax_trace_$trace (trace_ptr, tm2);

next_inst:
	current_line = current_line + 1;

new_inst:						/* new instruction */
	syntax_line_ptr = addr (syntax_table (current_line));

	go to test (syntax_line.t_type);

test (0):						/* reserved word test */
	if reserved_word.type ^= 1
	then go to fail;

	if reserved_word.key ^= syntax_line.t_field
	then go to fail;

success:						/* success */
	if tbit
	then call cobol_syntax_trace_$trace (trace_ptr, tm1);

ucon:
	if syntax_line.o_bit ^= " "
	then do;
		if syntax_line.o_bit > fixed_common.comp_level
		then call lev_diag (syntax_line.a_num);
		go to ret;
	     end;

	go to action (syntax_line.a_num);

test (1):						/* check routine test */
	go to check (syntax_line.t_field);

test (2):						/* unconditional branch */
	DIAG_NUM = syntax_line.t_field;
	act_num = syntax_line.a_num;

	if syntax_line.o_bit ^= " "
	then do;
		if syntax_line.o_bit > fixed_common.comp_level
		then do;
			mod_num = syntax_line.a_num;
			call lev_diag (DIAG_NUM);
		     end;

		DIAG_NUM = 0;
		act_num = 0;
	     end;

	if tbit
	then call cobol_syntax_trace_$trace (trace_ptr, tm1);

	go to action (act_num);

test (3):
	i1 = i1 + 1;
	if tbit
	then call cobol_syntax_trace_$trace (trace_ptr, tm3);

	if i1 > 75
	then go to comp_error;

	intrp_stack (i1) = current_line;
	current_line = syntax_line.t_field;

	go to new_inst;

ret:
action (0):
	if DIAG_NUM ^= 0
	then call diag (DIAG_NUM);

	if syntax_line.s_bit = "s"
	then call SCAN;

	current_line = syntax_line.s_exit;

	go to new_inst;

action (1):					/* exit true */
	current_line = intrp_stack (i1);

	if tbit
	then call cobol_syntax_trace_$trace (trace_ptr, tm4);

	syntax_line_ptr = addr (syntax_table (current_line));
	i1 = i1 - 1;

	go to ucon;

action (2):					/* exit false */
	current_line = intrp_stack (i1);

	if tbit
	then call cobol_syntax_trace_$trace (trace_ptr, tm5);

	i1 = i1 - 1;

	go to next_inst;

comp_error:
	diag_item.number = 183;
	diag_item.column = header.column;
	diag_item.line = header.line;

	call cobol_c_list (dg_ptr);

	return;

st_init:
     proc;

	bad_token = "0"b;
	inhibit_db = "0"b;
	statement.cd.size, statement.file.size, statement.proc.size, statement.data.size = 0;


     end;

emit_nl:
     proc;

	N_L = "0"b;
	call emit;
	N_L = "1"b;

     end;

EMIT:
     proc;

declare	i		fixed bin,
	AR		ptr;

	if TOK_TAB.size ^= 0
	then do i = 1 by 1 to TOK_TAB.size;

		AR = TOK_TAB.ptr (i);
		last_line = header.line;
		last_col = header.column;

		RP = AR;
		call PUT_REC;

	     end;

     end;

PUT_REC:
     proc;

/* make entry in output stream	*/
/* enter copy stack if required	*/
	if copy_mode
	then do;
		copy_tab.size = copy_tab.size + 1;

		call cobol_db_put (cobol_x3fp, st, RP, RP -> header.size, RP1);

		copy_tab.ptr (copy_tab.size) = addrel (RP1, 1);
	     end;
	else call cobol_db_put (cobol_x3fp, st, RP, RP -> header.size, RP1);
     end;

emit_copy:
     proc (loc);

declare	loc		fixed bin;
declare	p		ptr,
	i		fixed bin;

/* process entry in copy stack */

	if loc > copy_tab.size
	then return;

	do i = loc by 1 to copy_tab.size;

	     p = copy_tab.ptr (i);

	     call cobol_db_put (cobol_x3fp, st, p, p -> header.size, RP1);

	     p = addrel (RP1, 1);

	     p -> header.line = 0;
	     p -> header.column = 0;

	end;

	copy_tab.size = loc - 1;

     end;

SCAN:
     proc;

	do while ("1"b);

	     TOK_TAB.size = TOK_TAB.size + 1;

	     call cobol_swf_get (cobol_rmin2fp, st, addr_record, tln);

	     if substr (st, 17, 16) ^= "0"b
	     then return;

	     TOK_TAB.ptr (TOK_TAB.size) = addr_record;

	     if header.type ^= 5 & header.type ^= 6
	     then return;

	     bad_token = "1"b;

	end;

     end;

diag:
     proc (diag_num);

declare	diag_num		fixed bin;

	diag_item.number = diag_num;
	diag_item.column = header.column;
	diag_item.line = header.line;
	call cobol_c_list (dg_ptr);
     end diag;

lev_diag:
     proc (diag_num);

declare	diag_num		fixed bin;

	lev_diag_item.line = header.line;
	lev_diag_item.column = header.column;
	lev_diag_item.number = diag_num;
	lev_diag_item.module = mod_num;

	call cobol_c_list (lev_dg_ptr);

	mod_num = 0;

     end;

/* is item an 01 or 77 item in linkage section */



check (2):
lident:
	if (header.type = 9) & ((data_name.level = 01) | (data_name.level = 77)) & data_name.linkage_section
	then go to success;
	go to fail;				/* is it a section header */
check (4):
sechdr:
	if (header.type = 7) & (proc_def.section_name = "1"b)
	then go to success;
	go to fail;				/* is it a non sort file name */



check (5):
filenm:
	if header.type = 12
	then go to success;
	else go to fail;

check (6):
res_test:
	if db_res = 1
	then inhibit_db = "0"b;
	else inhibit_db = "1"b;

	current_line = current_line + res;
	go to new_inst;				/* is it a report section  group item */
check (7):
rident:
	if header.type = 21
	then go to success;
	go to fail;				/* is it a procedure definition */
check (8):
paranm:
prdef:
	if (header.type = 7 & proc_def.section_name = "0"b)
	then go to success;
	go to fail;				/* is it a verb */



check (9):
verb:
	if ((header.type = 1) & (reserved_word.verb = "1"b))
	then go to success;
	go to fail;				/* is section number legitimate */


check (10):
prnum:
	if header.type = 2 & numeric_lit.integral = "1"b & numeric_lit.sign = " " & numeric_lit.seg_range = "1"b
	then go to success;
	go to fail;

check (11):
not_opt:
	if ST.parity (nest_lev) = 1
	then go to success;
	else go to fail;


check (12):
numlit:
	if header.type = 2
	then go to success;
	go to fail;				/* is it a procedure name reference */


check (14):
prnm:
	if header.type = 18
	then go to success;
	go to fail;				/* is it a non numeric literal */
check (15):
nonumlit:
	if header.type = 3
	then go to success;
	go to fail;				/* is it an 01 or 77 item within file working-storage communication or link section */


check (16):
useid:
	if header.type = 2 | header.type = 3
	then go to success;

	if header.type = 9
	then do;
		if ((data_name.level = 1 | data_name.level = 77)
		     & (data_name.file_section | data_name.working_storage | data_name.communication_section
		     | data_name.linkage_section | data_name.constant_section))
		then go to success;
	     end;

	go to fail;

/* is it a non sort file name */


check (17):
nsfilnm:
	if header.type = 12
	then go to success;
	else go to fail;				/* is it an input cd name */

/*[5.0-1]*/
dcl	cd_pres		bit (1);
check (18):
incdnm:
	if (addr_record -> cdtoken.type = 13 & addr_record -> cdtoken.options.input)
						/*[5.0-1]*/
	then do;
		cd_pres = "1"b;
		go to success;
	     end;					/*[5.0-1]*/
	else do;
		cd_pres = "0"b;
		go to fail;
	     end;					/* is it an output cd name */


check (19):
outcdnm:
	if (addr_record -> cdtoken.type = 13 & addr_record -> cdtoken.output)
	then go to success;
	go to fail;

/* is it a literal */



check (21):
lit:
	if header.type = 2 | header.type = 3
	then go to success;
	go to fail;				/* is item a figurative constant except all */
check (22):
figconall:
	if header.type = 1 & reserved_word.figcon
	then go to success;

	go to fail;

check (25):
rpid:						/*	if report_name.type = 20 | (group_name.type = 21 & group_name.group_type = 4) then go to success;
go to fail;	*/
						/* is it a declarative section name reference */
check (26):
descnm:
	if header.type = 18 & proc_def.section_name & proc_def.declarative_proc
	then go to success;
	go to fail;				/* is it an rd report name */
check (27):
repnm:
	if header.type = 20
	then go to success;
	go to fail;				/*is file not sequentila access
	not file table already in core from check 38 */

check (29):
notseqac:
	if access > 1
	then go to success;
	go to fail;

/* is it a non sort mass storage file */
check (31):
msfilnm:						/*  according to ron ham we do not check for ms file regardless of codasyl rules */
	if header.type = 12
	then go to success;
	go to fail;

/* is it an index name */
check (33):
xnm:
	if header.type = 10
	then do;
		min_index = max (min_index, index_name.min);
		max_index = min (max_index, index_name.max);
		go to success;
	     end;
	go to fail;

/* is item a declarative section name reference */
/* and is it a random processing section */



check (35):
descnmra:
	if header.type = 18 & proc_def.section_name
	then go to success;
	go to fail;				/* is it an sa area name */
check (36):
saanm:
	if header.type = 15
	then go to success;
	go to fail;				/* is it an  01 data name under sa */
check (37):
said:
	if header.type = 9 & data_name.level_01 & data_name.exp_redefining
	then go to success;
	go to fail;

/* is it end cobol statement */
check (39):
endcob:
	if header.type = 1 & reserved_word.end_cobol = "1"b
	then go to success;
	go to fail;				/* is verb an imperative verb */
check (41):
impvrb:
	if header.type = 1 & reserved_word.imper_verb = "1"b
	then go to success;
	go to fail;

/* is this item a record within the associated sort file */
check (46):
recnm:
	if header.type ^= 9
	then go to fail;

	go to success;

/* is this file the same as associated file in the sort statement */
check (49):
asfil:
	if header.type ^= 16
	then go to fail;


	go to success;

/* is item not subscripted and not indexed */
/* but still has the occurs and indexed by clauses */
check (50):
srchid:
	if header.type = 9 & data_name.subscripted & data_name.indexed_by
	then go to success;
	else go to fail;				/* is item an integer type or is it usage is index */
check (51):
usornm:
	if header.type = 9 & (data_name.pic_integer | data_name.usage_index)
	then go to success;
	else go to fail;				/* does item have the key is clause */
check (52):
keylbl:
	if data_name.key_a | data_name.key_d
	then go to success;
	else go to fail;

/* is it a one character integer without an operational sign */



check (54):
onechnosn:
	if data_name.item_length = 1 & data_name.pic_integer & ^data_name.item_signed
	then go to success;
	go to fail;

/* is it a mnemonic name */
check (56):
mnenm:
	if header.type = 17
	then go to success;
	go to fail;

/* does the file have an associated format 1 use procedure */

/* is it  an index data item or
			is it  an elementary integer item */
check (58):
xint:
	if header.type = 9 & data_name.elementary & data_name.usage_index = "1"b
	then go to success;

	if header.type = 9 & data_name.elementary = "1"b & data_name.pic_integer = "1"b
	then go to success;
	go to fail;				/* is it a positive integer literal  */



check (59):
posint:
	if header.type = 2 & numeric_lit.integral = "1"b & numeric_lit.sign ^= "-"
	then go to success;
	go to fail;				/* is it a sortt file */



check (60):
srtfil:
	if header.type = 16
	then go to success;
	go to fail;				/* is itt a data_name within the saved file */


check (61):
dninfl:
	if header.type = 9
	then go to success;
	go to fail;				/* does item have usage is display clause */

check (62):
usisds:
	if data_name.non_elementary | (data_name.elementary & data_name.display)
	then go to success;
	go to fail;				/* is item fixed length with usage is display clause */
check (63):
flusisds:
	if data_name.display & ^data_name.variable_length
	then go to success;
	go to fail;				/* is item an elementary data item with usage is display clause
			and with no edit symbols */
check (64):
elneds:
	if data_name.elementary & data_name.display & ^data_name.numeric_edited & ^data_name.alphanum_edited
	     & ^data_name.alphabetic_edited
	then go to success;
	go to fail;				/* is itt an elementary numeric integer data item */
check (65):
elnuindi:
	if data_name.elementary & data_name.numeric & data_name.pic_integer
	then go to success;
	go to fail;				/* is it an elementary numeric item */



check (66):
elnuit:
	if header.type = 9 & data_name.elementary & data_name.numeric
	then go to success;
	go to fail;				/* is it a file name */



check (67):
file:
	if header.type = 12 | header.type = 16
	then go to success;
	go to fail;				/* is it an alphanumeric data item */
check (68):
andait:
	if data_name.alphanum | data_name.alphanum_edited
	then go to success;
	go to fail;				/* is item a non_sort record name */



check (70):
nsrecnm:
	if header.type = 9
	then go to success;
	else go to fail;				/* does saved item have linage clause */
						/* not to be executed until common is all set */
check (71):
linage:
	if file_table.linage
	then go to success;

	go to fail;

check (72):
in_line:
	if IN_LINE = 0
	then go to success;
	else go to fail;

/* is item an unsubscripted data name excluding index data names */



check (73):
undana:
	if header.type = 9 & ^data_name.subscripted & ^data_name.usage_index
	then go to success;
	go to fail;

/* is item a subscripted data name excluding  index data names */

check (74):
sudana:
	if header.type = 9 & data_name.subscripted & ^data_name.usage_index
	then go to success;
	go to fail;

/* is subcnt less than level of occurs in the saved ident */
check (75):
ieqlvl:
	if subcnt <= 3
	then go to success;
	go to fail;				/* is the saved ident indexed at this level */
check (76):
indexed:
	if indexedno (subcnt) ^= 0
	then do;
		sub_loc = sub_loc + 1;
		go to success;
	     end;
	go to fail;				/* is index no of curent item = to
			index no of saved item */
check (77):
indeqind:
	if index_name.index_no = indexedno (subcnt)
	then go to success;
	go to fail;				/* is item a positive integer whose value is greater than zero */
check (78):
pigz:
	call pigz_sub;

	if pigz_res = 0
	then go to success;
	else go to fail;

pigz_sub:
     proc;

	pigz_res = 0;
	litcnt = 1;

	if header.type = 2 & numeric_lit.integral & numeric_lit.sign ^= "-"
	then do while ("1"b);

		if substr (numeric_lit.literal, litcnt, 1) ^= "0"
		then return;

		if litcnt = numeric_lit.places
		then do;
			pigz_res = 1;
			return;
		     end;

		litcnt = litcnt + 1;

	     end;

	pigz_res = 1;

     end;

/* is item an unsigned integer */
check (79):
unsint:
	if header.type = 2 & numeric_lit.integral & numeric_lit.sign = " "
	then go to success;
	go to fail;				/* is item an arithemetic operator */
check (80):
arop:
	if header.type = 1 & reserved_word.arith_op
	then go to success;
	go to fail;

check (81):
examlitid:
	if header.type = 9 | header.type = 1 | header.type = 3
	then go to success;
	else go to fail;				/* is item a single character non numeric literal or a fig con */
						/* is item elementary or redefined */

check (82):
elemred:
	if data_name.elementary | data_name.s_of_rdf | data_name.o_of_rdf
	then go to success;
	go to fail;


/* does program contain sections */
check (84):
secsw:
	if secswitch = 1
	then go to success;
	go to fail;				/* does imperative switch = 0 */



check (85):
impsw:
	if impswitch = 0
	then go to success;
	go to fail;				/* is it a cdname */
check (87):
cdname:
	if header.type = 13
	then go to success;
	go to fail;				/* is it a data name not in report section */
check (88):
dana:
	if header.type = 9 & data_name.report_section = "0"b
	then go to success;
	go to fail;


check (90):
deswon:
	if decswitch > 1 & decswitch < 5
	then go to success;
	go to fail;


/* is it an unsubscripted elementary data name */

check (92):
unelnudn:
	if header.type = 9 & data_name.subscripted = "0"b & data_name.elementary = "1"b & ^data_name.constant_section
	     & data_name.numeric = "1"b
	then go to success;
	go to fail;				/* is it a statement termiator */
check (93):
sterm:
	if header.type = 1 & reserved_word.terminator = "1"b
	then go to success;

	if header.type = 7
	then go to success;
	go to fail;				/* is it a group item or does it have usage is display */



check (94):
usagid:
	if header.type = 9 & (data_name.non_elementary | data_name.display)
	then go to success;
	go to fail;

/*  is item an elementary item with usage is display clause */
check (95):
eldis:
	if header.type = 9 & data_name.display & data_name.elementary
	then go to success;
	go to fail;				/* is it end declaratives */


check (115):
enddec:
	if header.type = 1 & reserved_word.key = 98 & reserved_word.end_dec = "1"b
	then do;
		decswitch = 5;
		go to success;
	     end;
	go to fail;				/* is item alterable */

check (116):
edalit:
	if header.type = 9 & data_name.constant_section = "0"b
	then go to success;
	go to fail;				/* is it an alterable elementary numeric item */
check (117):
alelnuitm:
	if header.type = 9 & data_name.constant_section = "0"b & data_name.elementary = "1"b & data_name.numeric = "1"b
	then go to success;
	go to fail;				/* is it an integer */
check (118):
elnuint:
	if header.type = 2 & numeric_lit.integral
	then go to success;
	go to fail;				/*  is it an elementary numeric data name and an integer */
check (119):
elnudnint:
	if header.type = 9 & data_name.elementary & data_name.pic_integer
	then go to success;
	go to fail;				/* is it an edited or non edited alterable
			elementary numeric item */
check (120):
edalelnue:
	if header.type = 9 & ^data_name.constant_section & data_name.elementary
	     & (data_name.numeric | data_name.numeric_edited)
	then go to success;
	go to fail;				/* is item alphabetic or alphanumeric */
check (122):
alphoral:
	if data_name.alphanum | data_name.alphabetic
	then go to success;
	go to fail;				/* is item an arithmetic operator or right paren */
check (123):
aroprp:
	if header.type = 1 & reserved_word.arith_op
	then go to success;

	if header.type = 1 & reserved_word.key = 188
	then go to success;
	go to fail;				/* is item a relation operator */

check (124):
relop:
	if header.type = 1 & reserved_word.rel_op
	then go to success;

	go to fail;				/* is token res word positive or negative or zero */
check (125):
pnz:
	if header.type = 1
	then if reserved_word.key = 141 | reserved_word.key = 127 | reserved_word.key = 180
	     then go to success;
	go to fail;				/* is subject not = 0 --- do we have a subject present */
check (126):
is_sub_opt:
	if subj_req
	then go to fail;
	else go to success;


/* is item a status switch condition name */
check (134):
sscondnm:
	if mnemonic_name.type = 17 & mnemonic_name.class.switch_condition
	then go to success;

	go to fail;


check (137):
lptopstk:
	if cssub >= 0
	then go to success;
	else go to fail;

/* is item an unsubscripted index data name */

check (138):
unxdnm:
	if header.type = 9 & ^data_name.subscripted & data_name.usage_index
	then go to success;
	go to fail;

check (141):
nestedif:
	if nestifcnt = 0
	then go to success;
	else go to fail;

/* is item alphanumeric */

check (147):
nonumdn:
	if header.type = 9 & data_name.alphanum
	then go to success;
	go to fail;

/* is item elementary alphabetic,alphanumeric or numeric edited or a group item */



check (149):
elaanne:
	if header.type = 9
	     & ((data_name.elementary & (data_name.numeric_edited | data_name.alphanum | data_name.alphabetic))
	     | data_name.non_elementary)
	then go to success;
	go to fail;

/* is item a subscribted idndex data name */



check (150):
suxdnm:
	if header.type = 9 & data_name.subscripted & data_name.usage_index
	then go to success;
	go to fail;

/* is this MNEMONIC NAME an input device */

check (153):
indev:
	if mnemonic_name.iw_key = 3 | mnemonic_name.iw_key = 1
	then go to success;
	go to fail;

/* is MNEMONIC NAME input device */

check (154):
outdev:
	if mnemonic_name.iw_key = 3 | mnemonic_name.iw_key = 2
	then go to success;
	go to fail;

check (158):
adrisadr:
	if header.type = 9
	then go to success;
	else go to fail;

/* is ADDRESS same as FILE KEY in COMMON */
/* FILE TABLE already in core */
/* processing START verb */

check (159):
ssnm:
	if mnemonic_name.type = 17 & mnemonic_name.class.switch_name
	then go to success;

	go to fail;

check (160):					/* enter, routine name */
is_rout:
	if lang_num = 1
	then go to fail;

	if header.type = 8
	then go to success;

	go to fail;

check (161):
edick:
	if data_name.alphanum | data_name.alphabetic
	     | (data_name.numeric & data_name.places_left ^< 0 & data_name.places_right ^< 0)
	then go to success;
	go to fail;

check (162):
cktp25:
	if header.type = 25
	then go to success;
	go to fail;

check (166):
cklit:
	if header.type = 3 & alphanum_lit.lit_size < 31
	then go to success;
	go to fail;

/* check for a nonzero numeric literal */
check (169):
nznumlit:
	if header.type = 2
	then do;
		litcnt = 1;

		do while ("1"b);

		     if substr (numeric_lit.literal, litcnt, 1) ^= "0"
		     then go to success;

		     if litcnt = numeric_lit.places
		     then go to fail;

		     litcnt = litcnt + 1;

		end;
	     end;

	go to fail;

/* check integer bit in saved identifier */
check (170):
ckintbit:
	if numeric_lit.integral
	then go to success;
	go to fail;

/* is an lit < 32 chars for CALL */

check (180):
cklit1:
	if alphanum_lit.lit_size < 32
	then go to success;
	go to fail;

/* are we executing multics cobol compiler */

check (181):
mcobol:
	if compiler_id = 3
	then go to success;
	go to fail;

/* is an lit < 66 chars for CALL */

check (182):
cklit2:
	if alphanum_lit.lit_size < 66
	then go to success;
	go to fail;

/* is item unsubscripted data name excluding index data names, and,
		is it elementary, numeric ,integer data item. */
check (186):
udneli:
	if header.type = 9 & ^data_name.subscripted & ^data_name.usage_index & data_name.elementary
	     & data_name.numeric & data_name.pic_integer
	then do;
		sub_loc = sub_loc + 1;
		go to success;
	     end;
	go to fail;

check (188):
altst:
	if header.type = 9 & data_name.elementary
	then go to success;
	else go to fail;

check (189):
edaltst:
	if header.type = 9 & data_name.elementary & (data_name.numeric | data_name.numeric_edited)
	then go to success;
	else go to fail;

check (193):
resword:
	if reserved_word.type = 1
	then go to success;
	else go to fail;

check (194):
type9:
	if header.type = 9
	then go to success;
	else go to fail;

check (195):
alphnm:						/* check for alphabet name token */
	if alphabet_name.type ^= 40
	then go to fail;

	go to success;

check (196):
on_off:						/* test for ON or OFF */
	if reserved_word.type ^= 1
	then go to fail;

	key = reserved_word.key;

	if key ^= 134 & key ^= 574
	then go to fail;

	go to success;

acc_dev:
check (197):					/* test for accept device */
	if mnemonic_name.type = 17 & mnemonic_name.class.accept_device
	then go to success;

	go to fail;

disp_dev:
check (198):					/* test for display device */
	if mnemonic_name.type = 17 & mnemonic_name.class.display_device
	then go to success;

	go to fail;

prt_con:
check (199):					/* test for printer control */
	if mnemonic_name.type = 17 & mnemonic_name.class.printer_control
	then go to success;

	go to fail;

check (200):					/* enter, language name */
is_lang:
	lang_num = cobol_imp_word$lang_name (addr_record);

	if lang_num = 0
	then go to fail;

	go to success;

check (201):
amarg:
	if header.column < 12
	then go to success;
	go to fail;

check (202):
set_xint:
	if header.type = 9 & data_name.elementary
	then go to success;

	go to fail;

check (203):
set_pigz:
	call pigz_sub;

	if pigz_res = 0
	then go to success;

	go to fail;

check (206):
is_user_word:
	if data_name.type = 9
	then go to success;

	go to fail;

check (208):
nlit:
	if header.type = 2
	then go to success;

	go to fail;

check (209):
pigz_by:
	litcnt = 1;

	if header.type = 2 & numeric_lit.integral
	then do while ("1"b);

		if substr (numeric_lit.literal, litcnt, 1) ^= "0"
		then go to success;

		if litcnt = numeric_lit.places
		then go to fail;

		litcnt = litcnt + 1;

	     end;

	go to fail;

/***********************************************:*****************************/
/*****		PLACE NEW CHECKS BEFORE THIS COMMENT		********/
/*****************************************************************************/



action (12):
	call set_st_type (103);
	statement.line = proc_def.line;		/* section header */

	call enter_st_table;

	pn_count = pn_count + 1;
	go to ret;

action (13):
	if reserved_word.key = 2
	then end_word = 1;				/* add */
	else if reserved_word.key = 11
	then end_word = 17;				/* subtract */
	else if reserved_word.key = 40
	then end_word = 3;				/* compute */
	else if reserved_word.key = 10
	then end_word = 8;				/* multiply */
	else if reserved_word.key = 9
	then end_word = 5;				/* divide */

NL:
	nest_lev = nest_lev + 1;
	ST.end_word (nest_lev) = end_word;
	ST.parity (nest_lev) = 0;
	not_emitted = "0"b;

	go to ret;



action (14):
	call set_st_type (104);
	statement.line = proc_def.line;		/* paragraph header */

	call enter_st_table;

	pn_count = pn_count + 1;
	go to ret;

action (15):
	nestifcnt = nestifcnt + 1;
	call set_until_ptr;
	go to action (28);

action (16):
	call set_st_type (reserved_word.key);

	current_line = reserved_word.key;
	statement.line = reserved_word.line;
	go to new_inst;

action (17):
	decswitch = 3;
	section_ptr -> proc_def.type = 18;
	go to ret;

action (18):
	call set_st_type (106);			/* . */
	go to ret;

action (19):
	call set_st_type (107);			/* P.goto. */
	go to ret;

action (20):
	statement.type = 108;			/* go to depending */
	go to ret;

action (21):
	call set_st_type (109);			/* P.exit. */
	go to ret;

action (22):
	call set_st_type (110);			/* stop statement */
	go to ret;

action (23):
	call set_st_type (111);			/* end declaratives*/
	decswitch = 5;
	pn_count = 0;
	go to ret;

action (24):
	call set_st_type (112);			/* end cobol */
	go to ret;

action (25):
	call scan_to_end;				/* type 25 token */
	go to ret;

action (26):
	call set_st_type (114);			/* use statement */
	db_res = 1;
	go to ret;

action (27):
	call set_st_type (115);			/* on size error */
	go to ret;

action (28):
	if reserved_word.key = 47
	then end_word = 7;				/*if */
	else if reserved_word.key = 5
	then end_word = 2;				/* call */
	else if reserved_word.key = 34
	then end_word = 16;				/* string */
	else if reserved_word.key = 37
	then end_word = 18;				/* unstring */
	else if reserved_word.key = 25
	then end_word = 12;				/* return */

	go to NL;


action (29):
	from_pres = "0"b;

	if reserved_word.key = 21
	then end_word = 10;				/* read */
	else if reserved_word.key = 38
	then end_word = 19;				/* write */
	else if reserved_word.key = 27
	then end_word = 13;				/* rewrite */
	else if reserved_word.key = 56
	then end_word = 15;				/* start */
	else if reserved_word.key = 22
	then end_word = 4;				/* delete */

	go to NL;



action (30):
	call set_st_type (116);			/* next statement */
	go to ret;

action (31):
	if reserved_word.key = 20			/* perform */
	then do;
		per_desc.pn1, per_desc.pn2 = 0;
		end_word = 9;
	     end;
	else if reserved_word.key = 26		/* search */
	then do;
		end_word = 14;
		call set_until_ptr;
	     end;
	else if reserved_word.key = 23
	then end_word = 11;				/* receive */
	else if reserved_word.key = 500
	then end_word = 6;				/* evaluate */

	go to NL;


action (32):
	call set_st_type (117);			/* else */
	go to ret;

action (33):
	alphanum_lit.all_lit = "1"b;
	go to ret;

action (34):
	call set_st_type (100);
	decswitch = 1;				/* procedure division */
	go to ret;

action (35):
	item_tab.ptr (1) = TOK_TAB.ptr (1);
	TOK_TAB.size = 0;
	res, i = 2;

	do while (res = 2);

	     call cobol_swf_get (cobol_rmin2fp, st, item_tab.ptr (i), tln);

	     addr_record = item_tab.ptr (i);

	     if alphanum_lit.type = 3 & alphanum_lit.string = "~~~"
	     then res = 0;
	     else i = i + 1;

	end;

	item_tab.size = i;

	call define_macros;
	go to ret;

action (36):
	nest_lev = 0;
	go to ret;

action (37):
	call set_st_type (118);			/* invalid key */
	impswitch = 0;
	go to ret;

action (38):
	call set_st_type (119);			/* at end */
	go to ret;

action (39):
	impswitch = 1;
	go to ret;

action (40):
	impswitch = 0;
	go to ret;

action (41):
	nestifcnt = 0;
	nest_lev = 0;
	impswitch = 0;
	go to ret;

action (42):
	impswitch = 0;
	go to ret;

action (43):
	nest_lev = 0;
	go to ret;

action (44):
	call set_st_type (120);			/* at eop */
	go to ret;

action (45):
	subcnt = 0;
	go to ret;

action (46):
	subcnt = subcnt + 1;
	if QQ = null ()
	then go to ret;
	statement_data_entry.dimen = statement_data_entry.dimen + 1;
	go to a46 (subcnt);

a46 (1):
	statement_data_entry.sub_1.TOK = TOK_TAB.size;
	statement_data_entry.sub_1.TOK_size = 1;
	go to ret;

a46 (2):
	statement_data_entry.sub_2.TOK = TOK_TAB.size;
	statement_data_entry.sub_2.TOK_size = 1;
	go to ret;

a46 (3):
	statement_data_entry.sub_3.TOK = TOK_TAB.size;
	statement_data_entry.sub_3.TOK_size = 1;
	go to ret;

action (47):
	impswitch = 0;
	cssub = 0;
	go to ret;

action (48):
	nestifcnt = nestifcnt - 1;
	go to ret;

action (49):
	nestifcnt = nestifcnt - 1;
	go to ret;

action (50):
	nestifcnt = nestifcnt - 1;
	call set_st_type (117);
	go to ret;

action (51):					/* cd-name,data-name,file-name,proc-name */
	ALL_REFS = "0"b;
	call enter_db_table;
	go to ret;

action (52):					/* all refs, data-name */
	ALL_REFS = "1"b;
	call enter_db_table;
	go to ret;

action (53):					/* all procs */
	if debug_table.proc.size ^= 0
	then call diag (6);
	else if all_procs
	then call diag (7);
	else do;
		all_procs, DB = "1"b;
		debug_table.proc.size = 1;
		debug_table.proc.entry.proc_ptr (1) = section_ptr;
	     end;
	go to ret;

action (54):
	ALL_REFS = "0"b;
	go to ret;

action (55):
	decswitch = 4;
	go to ret;

action (56):
	call set_st_type (0);			/*	call ioa_("^d ^d",header.line,header.column); dcl ioa_ entry options(variable);*/
	go to ret;

action (57):
	if EN ^= 0
	then statement.data.entry.TOK (EN) = -statement.data.entry.TOK (EN);
	go to ret;

action (58):					/* go to PN */
	call set_st_type (14);
	go to ret;

action (59):					/* ident, sending field */
	send_bit = "1"b;
	BEG_ID = TOK_TAB.size;
	if QQ ^= null ()
	then statement_data_entry.TOK_size = 1;

	call enter_st_table;
	go to ret;

action (60):					/* ident, receiving field */
	send_bit = "0"b;
	BEG_ID = TOK_TAB.size;
	if QQ ^= null ()
	then statement_data_entry.TOK_size = 1;

	call enter_st_table;
	go to ret;

action (61):
	statement.line = reserved_word.line;
	go to ret;

action (62):
	section_ptr = addr_record;
	go to ret;

action (63):
	cssub = cssub + 1;
	subj_req = "1"b;
	go to ret;

action (64):
	per_desc.format = 1;
	cssub = cssub - 1;
	go to ret;

action (65):
	subcnt = subcnt + 1;
	if QQ = null ()
	then go to ret;
	statement_data_entry.dimen = statement_data_entry.dimen + 1;
	go to a65 (subcnt);

a65 (1):
	statement_data_entry.sub_1.TOK_size = 3;
	go to ret;

a65 (2):
	statement_data_entry.sub_2.TOK_size = 3;
	go to ret;

a65 (3):
	statement_data_entry.sub_3.TOK_size = 3;
	go to ret;
action (66):
	IN_LINE = 1;
	dim = 0;
	per_desc.pn1 = 0;
	go to ret;

action (67):
	IN_LINE = 0;
	dim = 0;
	per_desc.pn1 = TOK_TAB.size;

	call enter_st_table;
	go to ret;

action (68):
	per_desc.format = 1;
	go to ret;

action (69):
	per_desc.format = 2;
	per_desc.count.tok_no = TOK_TAB.size;
	go to ret;

action (70):
	per_desc.format = 3;
	per_desc.until.tok_no = TOK_TAB.size + 1;
	call set_until_ptr;
	go to ret;

action (71):
	per_desc.format = 4;
	per_desc.dim = 1;
	call set_per_cond_ptr;
	go to ret;

action (72):
	subj_req = "0"b;
	go to ret;

action (73):
	subj_req = "1"b;
	cssub = cssub - 1;
	go to ret;
action (74):					/*[5.3-1]*/
	nest_lev = nest_lev - 1;
	go to ret;
action (82):
	cssub = 0;
	subj_req = "1"b;
	go to ret;
action (83):
	per_desc.loop.cond.size (per_desc.dim) = TOK_TAB.size - per_desc.loop.cond.tok_no (per_desc.dim);
	go to ret;

action (84):
	per_desc.pn2 = TOK_TAB.size;
	go to ret;

action (85):
	per_desc.until.size = TOK_TAB.size - per_desc.until.tok_no + 1;
	go to ret;

action (86):
eos:
	if bad_token | inhibit_db | decswitch < 3
	then call emit_nl;
	else do;
		call db_emit;

		if e_res = 1
		then if stne
		     then call emit_db_code;
	     end;

	call st_init;
	go to ret;

action (87):
endjob:
	return;

action (88):
	db_res = 2;
	go to ret;

action (89):
	per_desc.dim = per_desc.dim + 1;
	call set_per_cond_ptr;
	go to ret;

action (90):
	per_desc.loop.var.tok_no (per_desc.dim) = TOK_TAB.size;
	per_desc.loop.var.size (per_desc.dim) = 1;
	go to ret;

action (91):
	per_desc.loop.from.tok_no (per_desc.dim) = TOK_TAB.size;
	per_desc.loop.from.size (per_desc.dim) = 1;
	go to ret;

action (92):
	per_desc.loop.by.tok_no (per_desc.dim) = TOK_TAB.size;
	per_desc.loop.by.size (per_desc.dim) = 1;
	go to ret;

action (93):
	per_desc.loop.cond.tok_no (per_desc.dim) = TOK_TAB.size + 1;
	go to ret;

action (94):					/* send-receive status */
	TOK_NUM = -TOK_NUM;
	go to ret;

action (95):					/* dispatch on end word */
	end_word = ST.end_word (nest_lev);

	if end_word < 0
	then end_word = -end_word;

	if end_word = 0 | end_word > 19
	then end_word = 1;
	else end_word = end_word + 1;

	current_line = current_line + end_word;
	go to new_inst;

action (96):
	ST.parity (nest_lev) = 0;
	call emit_not_option (1);			/* on size error */
	go to ret;

action (97):
	ST.parity (nest_lev) = 1;
	call emit;				/* set to NOT */
	call st_init;
	go to ret;

action (98):
	ST.parity (nest_lev) = 0;
	call emit_not_option (5);			/* on overflow */
	go to ret;

action (99):
	ST.parity (nest_lev) = 0;
	call emit_not_option (2);			/* at end */
	go to ret;

action (100):
	ST.parity (nest_lev) = 0;
	call emit_not_option (3);			/* invalid key */
	go to ret;

action (101):					/*[4.4-3]*/
	opt_word_num = 44;				/* with */
	ST.parity (nest_lev) = 0;
	call emit_not_option (8);			/* no data */
	go to ret;
action (102):
	ST.parity (nest_lev) = 0;
	call emit_not_option (4);			/* at eop */
	go to ret;
action (103):
	if not_emitted
	then call reset_TOK_TAB;
	else do;
		call emit_nl;
		call st_init;
	     end;
	go to ret;
action (104):
	call emit;
	call st_init;
	go to ret;

action (105):
	if not_emitted
	then call PUT (item_tab.ptr (47 + ST.end_word (nest_lev)));
	go to ret;

action (106):
	call set_st_type (101);
	decswitch = 2;
	go to ret;

action (107):
	decswitch = 5;
	pn_count = 0;
	go to ret;

action (108):
	if all_procs
	then res = 1;
	else call enter_st_table;

	if res = 1
	then do;
		alt_ct = alt_ct + 1;
		alt_tab.pn1 (alt_ct) = TOK_TAB.size;
	     end;
	go to ret;

action (109):
	sm_desc.ip_TOK, sm_desc.op_TOK = 0;		/* initialize for sort-merge */
	go to ret;

action (110):
	sm_desc.op_TOK = TOK_TAB.size;		/* pn for output procedure */
	go to action (60);

action (111):
	sm_desc.ip_TOK = TOK_TAB.size;		/* pn for input procedure */
	go to action (60);

action (112):
	alt_ct = 0;
	go to ret;

action (113):
	alt_tab.pn2 (alt_ct) = TOK_TAB.size;
	go to ret;

action (114):
	if QQ ^= null ()
	then statement_data_entry.TOK_size = TOK_TAB.size - BEG_ID + 1;
	go to ret;
action (115):
	send_bit = "0"b;
	call enter_st_table;			/* call type12_token; */
						/* form type 12 token, enter_st_table */
	go to ret;

action (116):
	from_pres = "1"b;
	FR.TOK = TOK_TAB.size + 1;
	go to ret;

action (117):
	FR.TOK_size = TOK_TAB.size - FR.TOK + 1;
	go to ret;

action (118):
	per_desc.loop.var.size (per_desc.dim) = TOK_TAB.size - per_desc.loop.var.tok_no (per_desc.dim) + 1;
	go to ret;

action (119):
	per_desc.loop.from.size (per_desc.dim) = TOK_TAB.size - per_desc.loop.from.tok_no (per_desc.dim) + 1;
	go to ret;

action (120):
	per_desc.loop.by.size (per_desc.dim) = TOK_TAB.size - per_desc.loop.by.tok_no (per_desc.dim) + 1;
	go to ret;

action (121):
	per_desc.count.size = TOK_TAB.size - per_desc.count.tok_no + 1;
	go to ret;

action (122):
	call enter_st_table;
	go to ret;

action (123):
	if ST_NO = 0
	then go to ret;

	if new_entry | cond_desc.tok_count = 0
	then ;
	else do i = 1 by 1 to cond_desc.tok_count;

		if cond_desc.tok (i) = ST_NO
		then go to ret;

	     end;

	cond_desc.tok_count = cond_desc.tok_count + 1;
	cond_desc.tok (cond_desc.tok_count) = ST_NO;
	go to ret;

action (124):
	ST_NO = 0;
	go to ret;

define_macros:
     proc;

	M1.size = 4;
	M1.type (1) = 1;				/* MOVE */
	M1.ptr (1) = item_tab.ptr (9);
	M1.type (2) = 2;				/* AN_LIT(statement.line) */
	M1.ptr (2) = addr (statement.line);
	M1.type (3) = 1;				/* TO */
	M1.ptr (3) = item_tab.ptr (10);
	M1.type (4) = 1;				/* DEBUG-LINE */
	M1.ptr (4) = item_tab.ptr (1);

	M2.size = 4;
	M2.type (1) = 1;				/* MOVE */
	M2.ptr (1) = item_tab.ptr (9);
	M2.type (2) = 3;				/* NAME(token) */
	M2.ptr (2) = null ();
	M2.type (3) = 1;				/* TO */
	M2.ptr (3) = item_tab.ptr (10);
	M2.type (4) = 1;				/* DEBUG-NAME */
	M2.ptr (4) = item_tab.ptr (2);

	M3.size = 4;
	M3.type (1) = 1;				/* MOVE */
	M3.ptr (1) = item_tab.ptr (9);
	M3.type (2) = 1;				/* SPACES */
	M3.ptr (2) = item_tab.ptr (14);
	M3.type (3) = 1;				/* TO */
	M3.ptr (3) = item_tab.ptr (10);
	M3.type (4) = 1;				/* DEBUG-CONTENTS */
	M3.ptr (4) = item_tab.ptr (3);

	M4.size = 4;
	M4.type (1) = 1;				/* MOVE */
	M4.ptr (1) = item_tab.ptr (9);
	M4.type (2) = 1;				/* token */
	M4.ptr (2) = null ();
	M4.type (3) = 1;				/* TO */
	M4.ptr (3) = item_tab.ptr (10);
	M4.type (4) = 1;				/* DEBUG-CONTENTS */
	M4.ptr (4) = item_tab.ptr (3);

	M5.size = 10;
	M5.type (1) = 1;				/* IF */
	M5.ptr (1) = item_tab.ptr (68);

	do i = 0 by 1 to 5;				/* SWITCH-9 */

	     M5.type (2 + i) = 1;
	     M5.ptr (2 + i) = item_tab.ptr (69 + i);

	end;

	M5.type (8) = 1;				/* PERFORM */
	M5.ptr (8) = item_tab.ptr (15);
	M5.type (9) = 1;				/* PN */
	M5.ptr (9) = null ();
	M5.type (10) = 1;				/* END-IF */
	M5.ptr (10) = item_tab.ptr (34);

	M6.size = 4;
	M6.type (1) = 1;				/* MOVE */
	M6.ptr (1) = item_tab.ptr (9);
	M6.type (2) = 3;				/* NAME(token) */
	M6.ptr (2) = null ();
	M6.type (3) = 1;				/* TO */
	M6.ptr (3) = item_tab.ptr (10);
	M6.type (4) = 1;				/* DEBUG-CONTENTS */
	M6.ptr (4) = item_tab.ptr (3);

     end;

/*		item_tab.ptr

	1	type 9	DEBUG-LINE
	2	type 9	DEBUG-NAME
	3	type 9	DEBUG-CONTENTS
	4	type 9	DEBUG-SUB-1
	5	type 9	DEBUG-SUB-2
	6	type 9	DEBUG-SUB-3
	7	type 3	"(6)L"
	8	type 3	"(30)N"
	9	type 1	MOVE
	10	type 1	TO
	11	type 3	"~"
	12	type3	"~"
	13	type 1	=
	14	type 1	SPACE
	15	type 1	PERFORM
	16	type 3	"START PROGRAM"
	17	type 3	"SORT INPUT"
	18	type 3	"SORT OUTPUT"
	19	type 3	"MERGE OUTPUT"
	20	type 3	"PERFORM LOOP"
	21	type 3	"USE PROCEDURE"
	22	type 3	"FALL THROUGH"
	23	type 1	SET
	24	type 1	COMPUTE
	25	type 1	UP
	26	type 1	BY
	27	type 1	END-PERFORM
	28	type 1	TIMES
	29	type 1	UNTIL
	30	type 1	NOT
	31	type 1	)
	32	type 1	THRU
	33	type 1	ADD
	34	type1	END-IF
	35	type1	ON
	36	type1	SIZE
	37	type1	ERROR
	38	type1	AT
	39	type1	END
	40	type1	INVALID
	41	type1	KEY
	42	type1	EOP
	43	type1	OVERFLOW
	44	type1	WITH
	45	type1	DATA
	46	type1	EXCEPTION
	47	type1	NO
	48	type1	END-ADD
	49	type1	END-CALL
	50	type1	END-COMPUTE
	51	type1	END-DELETE
	52	type1	END-DIVIDE
	53	type1	END-EVALUATE
	54	type1	END-IF
	55	type1	END-MULTIPLY
	56	type1	END-PERFORM
	57	type1	END-READ
	58	type1	END-RECEIVE
	59	type1	END-RETURN
	60	type1	END-REWRITE
	61	type1	END-SEARCH
	62	type1	END-START
	63	type1	END-STRING
	64	type1	END-SUBTRACT
	65	type1	END-UNSTRING
	66	type1	END-WRITE
	67	type 1	(
	68	type 1	if
	69	type1	(	DEBUG-ON OF SWITCH-9
	70	type9	DEBUG-ON	|
	71	type1	NOT	|
	72	type1	EQUALS	|
	73	type3	LOW-VALUE	|
	74	type1	)	|
	75	type1	.
	76	type9	DEBUG-SUBS
	77	type3	"999999"
	128	type 3	"~~~"
*/
declare	1 M1,					/* MOVE AN-LIT(statement-line) TO DEBUG-LINE*/
	  2 size		fixed bin,
	  2 def		(4),
	    3 type	fixed bin,
	    3 num		fixed bin,
	    3 ptr		ptr;

declare	1 M2,					/* MOVE NAME(token) TO DEBUG-NAME */
	  2 size		fixed bin,
	  2 def		(4),
	    3 type	fixed bin,
	    3 num		fixed bin,
	    3 ptr		ptr;

declare	1 M3,					/* MOVE SPACES TO DEBUG-CONTENTS */
	  2 size		fixed bin,
	  2 def		(4),
	    3 type	fixed bin,
	    3 num		fixed bin,
	    3 ptr		ptr;

declare	1 M4,					/* MOVE token TO DEBUG-CONTENTS */
	  2 size		fixed bin,
	  2 def		(4),
	    3 type	fixed bin,
	    3 num		fixed bin,
	    3 ptr		ptr;

declare	1 M5,					/* IF DEBUG-ON PERFORM debug-section END-IF */
	  2 size		fixed bin,
	  2 def		(10),
	    3 type	fixed bin,
	    3 num		fixed bin,
	    3 ptr		ptr;

declare	1 M6,					/* MOVE NAME(token) TO DEBUG-CONTENTS */
	  2 size		fixed bin,
	  2 def		(4),
	    3 type	fixed bin,
	    3 num		fixed bin,
	    3 ptr		ptr;

set_st_type:
     proc (type);

declare	type		fixed bin;

	statement.type = type;
	stne = "0"b;

     end;

emit_proc_name:
     proc;					/* used by VERB(103): section header, VERB(104): para header */

/*	First Non-Declarative Procedure

		MOVE "START-PROGRAM TO DEBUG-CONTENTS.

			LL: PN section.
			LL: PN.

		MOVE "PN" TO DEBUG-NAME
		IF DEBUG-ON THEN PERFORM.

	Subsequent Non-Declarative Procedures

		MOVE "FALL-THROUGH" TO DEBUG-CONTENTS.

			LL: PN section.
			LL: PN.

		MOVE "PN" TO DEBUG-NAME
		IF DEBUG-ON THEN PERFORM.

	Use Procedure (Not For debugging)

			LL: PN section.
			    USE ...

		MOVE "USE PROCEDURE" TO DEBUG-CONTENTS
		MOVE "PN" TO DEBUG-NAME
		IF DEBUG-ON THEN PERFORM.

*/
declare	en		fixed bin,
	ep		ptr;

	M2.ptr (2) = TOK_TAB.ptr (1);

	go to EPN (decswitch);

EPN (0):						/* 0: initial value */
EPN (1):						/* 1: procedure division */
EPN (3):						/* 3: use(debugging) */
	call emit_nl;

	if ^stne
	then return;

	go to EPN2;

EPN (2):						/* 2: declaratives */
EPN (4):						/* 4: use(not debugging) */
	call emit_nl;

	if ^stne & ^all_procs
	then return;
EPN2:
	M4.ptr (2) = item_tab.ptr (21);		/* USE PROCEDURE */

	call emit_macro (addr (M4));			/* MOVE xx TO DEBUG-CONTENTS */


	go to EPN1;

EPN (5):						/* 5: end declaratives */
	if ^stne & ^all_procs
	then do;
		call emit_nl;
		return;
	     end;

/*[4.0-1]*/
	if ln_not_emitted				/*[4.0-1]*/
	then do;
		call PUT (item_tab.ptr (9));		/* MOVE */
						/*[4.0-1]*/
		call PUT (item_tab.ptr (77));		/* "999999" */

/*[4.0-1]*/
		nines_ptr = addrel (RP1, 1);

/*[4.0-1]*/
		call PUT (item_tab.ptr (10));		/* TO */
						/*[4.0-1]*/
		call PUT (item_tab.ptr (1));		/* DEBUG-LINE */

/*[4.0-1]*/
		ln_not_emitted = "0"b;

/*[4.0-1]*/
	     end;

	if pn_count = 1
	then M4.ptr (2) = item_tab.ptr (16);		/* START PROGRAM */
	else M4.ptr (2) = item_tab.ptr (22);		/* FALL THROUGH */

	call emit_macro (addr (M4));			/* MOVE xx TO DEBUG-CONTENTS */
	call PUT (item_tab.ptr (75));			/* . */
	call emit_nl;				/* emit statement */

	go to EPN1;

EPN1:
	call emit_macro (addr (M2));			/* MOVE "PN" TO DEBUG-NAME */



	if all_procs
	then ep = debug_table.proc.entry.proc_ptr (1);	/* use on all procs specified */
	else do;
		en = statement.proc.entry.num (1);
		ep = debug_table.proc.entry.proc_ptr (en);
	     end;

	call emit_perform (ep);

	call PUT (item_tab.ptr (75));			/* . */
     end;

set_debug_line:
     proc;

/*[4.0-1]*/
	call emit_macro (addr (M1));			/* MOVE AN_LIT(line) TO DEBUG-LINE */

/*[4.0-1]*/
	if nines_ptr ^= null ()			/*[4.0-1]*/
	then do;
		substr (nines_ptr -> alphanum_lit.string, 1, 6) = LN1;

/*[4.0-1]*/
		nines_ptr = null ();		/*[4.0-1]*/
	     end;

/*[4.0-1]*/
	ln_not_emitted = "0"b;

     end;


emit_alter:
     proc;					/* alter statement */

declare	(i, num, TOK)	fixed bin,
	(pn1, pn2, proc_ptr)
			ptr;


/*[4.0-1]*/
	call set_debug_line;			/* MOVE AN-LIT(line) TO DEBUG-LINE */
	if alt_ct > 0
	then do i = 1 by 1 to alt_ct;

		pn1 = TOK_TAB.ptr (alt_tab.pn1 (i));
		pn2 = TOK_TAB.ptr (alt_tab.pn2 (i));

		if all_procs
		then proc_ptr = debug_table.proc.entry.proc_ptr (1);
						/* use for all procs specified */
		else do;
			num = statement.proc.entry.num (i);
			proc_ptr = debug_table.proc.entry.proc_ptr (num);
		     end;

		M2.ptr (2) = pn1;
		call emit_macro (addr (M2));		/* MOVE NAME(token) TO DEBUG-NAME */

		M6.ptr (2) = pn2;
		call emit_macro (addr (M6));		/* MOVE NAME(token) TO DEBUG-CONTENTS */

		call emit_perform (proc_ptr);		/* IF SWITCH-8 THEN PERFORM ...*/

	     end;

	call emit_nl;

     end;

emit_data:
     proc (p, q);

declare	(p, q, dn_ptr)	ptr,
	TOKNO		fixed bin;

declare	1 state_dn	based (p),
	  2 num		fixed bin,		/* debug table entry */
	  2 TOK		fixed bin;		/* token table entry */

declare	1 data_dn		based (q),
	  2 TOK_size	fixed bin,
	  2 dimen		fixed bin,
	  2 sub_1,
	    3 TOK		fixed bin,
	    3 TOK_size	fixed bin,
	  2 sub_2,
	    3 TOK		fixed bin,
	    3 TOK_size	fixed bin,
	  2 sub_3,
	    3 TOK		fixed bin,
	    3 TOK_size	fixed bin,
	  2 sub_ptr	ptr;

declare	1 dntok,
	  2 TOK		fixed bin,
	  2 TOK_size	fixed bin;

declare	1 entry_dn	based (dn_ptr),
	  2 seg_num	fixed bin,
	  2 offset	fixed bin,
	  2 level		fixed bin,
	  2 name_size	fixed bin,
	  2 name		char (32),
	  2 proc_ptr	ptr;

	if ^emrec
	then if state_dn.TOK < 0 & debug_table.data.all_refs (state_dn.num) = "0"b
	     then return;

	if state_dn.TOK < 0
	then TOKNO = -state_dn.TOK;
	else TOKNO = state_dn.TOK;

	M2.ptr (2) = TOK_TAB.ptr (TOKNO);
	call emit_macro (addr (M2));			/* MOVE NAME(token TO DEBUG-NAME */

	if data_dn.dimen > 0
	then do;
		call set_subs;
		call emit_subs (q);
	     end;

	dntok.TOK = TOKNO;
	dntok.TOK_size = data_dn.TOK_size;
	dn_ptr = addr (debug_table.data.entry (state_dn.num));

	call PUT (item_tab.ptr (9));			/* MOVE */
	call emit_range (addr (dntok));		/* identifier */
	call PUT (item_tab.ptr (10));			/* TO */
	call PUT (item_tab.ptr (3));			/* DEBUG-CONTENTS */

	call emit_perform (entry_dn.proc_ptr);
     end;

emit_subs:
     proc (p);

declare	p		ptr;

declare	1 data		based (p),
	  2 TOK_size	fixed bin,
	  2 dimen		fixed bin,
	  2 sub_1,
	    3 TOK		fixed bin,
	    3 TOK_size	fixed bin,
	  2 sub_2,
	    3 TOK		fixed bin,
	    3 TOK_size	fixed bin,
	  2 sub_3,
	    3 TOK		fixed bin,
	    3 TOK_size	fixed bin,
	  2 sub_ptr	ptr;

	if data.dimen > 3
	then return;

	go to DM (data.dimen);

DM (1):
	call emit_sub (item_tab.ptr (4), addr (data.sub_1));
	go to DM1;

DM (2):
	call emit_sub (item_tab.ptr (4), addr (data.sub_1));
	call emit_sub (item_tab.ptr (5), addr (data.sub_2));
	go to DM1;

DN (3):
	call emit_sub (item_tab.ptr (4), addr (data.sub_1));
	call emit_sub (item_tab.ptr (5), addr (data.sub_2));
	call emit_sub (item_tab.ptr (6), addr (data.sub_3));
	go to DM1;

DM1:
     end;

emit_sub:
     proc (item_tab_ptr, sub_ptr);

declare	(item_tab_ptr, sub_ptr, PP)
			ptr;

declare	1 sub		based (sub_ptr),
	  2 TOK		fixed bin,
	  2 TOK_size	fixed bin;

	PP = TOK_TAB.ptr (sub.TOK);

	if PP -> header.type = 10
	then do;
		if TOK_size > 4
		then return;

		call PUT (item_tab.ptr (23));		/* SET */
		call PUT (item_tab_ptr);		/* DEBUG-SUB-i */
		call PUT (item_tab.ptr (10));		/* TO */
		call PUT (TOK_TAB.ptr (TOK));		/* index-name */

		if TOK_size = 3
		then do;
			call PUT (item_tab.ptr (24)); /* COMPUTE */
			call PUT (item_tab_ptr);	/* DEBUG-SUB-i */
			call PUT (item_tab.ptr (13)); /* = */
			call PUT (item_tab_ptr);	/* DEBUG-SUB-i */
			call PUT (TOK_TAB.ptr (TOK)); /* +- */
			call PUT (TOK_TAB.ptr (TOK + 1));
						/* integer */
		     end;
	     end;
	else do;
		call PUT (item_tab.ptr (24));		/* COMPUTE */
		call PUT (item_tab_ptr);		/* DEBUG-SUB-i */
		call PUT (item_tab.ptr (13));		/* = */
		call emit_range (sub_ptr);
	     end;
     end;

emit_range:
     proc (p);

declare	p		ptr,
	i		fixed bin;

declare	1 sub		based (p),
	  2 TOK		fixed bin,
	  2 TOK_size	fixed bin;

	do i = sub.TOK by 1 to sub.TOK + sub.TOK_size - 1;

	     call PUT (TOK_TAB.ptr (i));

	end;
     end;

PUT:
     proc (p);

declare	p		ptr;

	p -> header.line = last_line;
	p -> header.column = last_col;

	RP = p;
	call PUT_REC;

     end;

emit_macro:
     proc (p);

declare	(p, rptr)		ptr,
	LN		char (6),
	ch		char (1),
	NAME		char (30),
	(i, j)		fixed bin;

declare	1 def		based (p),
	  2 size		fixed bin,
	  2 def		(128),
	    3 type	fixed bin,
	    3 num		fixed bin,
	    3 ptr		ptr;

/*	type = 1	token(ptr)
					type = 2	debug-line value(ptr)
					type = 3	token name value(ptr)
				*/

declare	line_num		fixed bin based (def.def.ptr (i));

declare	ch30		char (30) based;

	do i = 1 by 1 to def.size;

	     go to EM (def.def.type (i));

EM (1):						/* token */
	     rptr = def.def.ptr (i);
	     go to EM1;

EM (2):						/* DEBUG-LINE value */
	     LN = " ";
	     call ioa_$rsnnl ("^d", LN, 6, line_num);

	     j = 6;
	     LN1 = " ";
	     ch = substr (LN, j, 1);

	     do while (ch = " " & j > 0);

		j = j - 1;
		ch = substr (LN, j, 1);

	     end;

	     if j > 0
	     then substr (LN1, 7 - j, j) = substr (LN, 1, j);

	     rptr = item_tab.ptr (7);
	     rptr -> alphanum_lit.lit_size = 6;
	     rptr -> alphanum_lit.string = LN1;
	     go to EM1;

EM (3):						/* DEBUG-NAME value */
	     PP, rptr = def.def.ptr (i);

	     call set_type;

	     go to TTP (DB_TYPE);

TTP (1):						/* proc-name */
	     NAME = rptr -> proc_def.name;
	     go to TTP1;

TTP (2):						/* data-name */
	     NAME = rptr -> data_name.name;
	     go to TTP1;

TTP (3):						/* file-name */
	     NAME = rptr -> fd_token.name;
	     go to TTP1;

TTP (4):						/* cd-name */
	     NAME = rptr -> cdtoken.name;
	     go to TTP1;

TTP1:
	     rptr = item_tab.ptr (8);

	     NAME = translate (NAME, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz");

	     substr (rptr -> alphanum_lit.string, 1, 30) = NAME;
						/* form alphanumeric literal */
	     go to EM1;

EM1:
	     rptr -> header.line = last_line;
	     rptr -> header.column = last_col;

	     RP = rptr;
	     call PUT_REC;

	end;
     end;

emit_file:
     proc (p);

declare	(p, fn_ptr)	ptr;

/* execute debug section for file-name 
					   DEBUG-NAME = file-name
					   DEBUG-CONTENTS = entire record(READ), SPACES(^READ)
					*/

declare	1 state_fn	based (p),
	  2 num		fixed bin,		/* debug table entry */
	  2 TOK		fixed bin;		/* TOK_TAB entry */

declare	1 entry_fn	based (fn_ptr),
	  2 file_no	fixed bin,
	  2 proc_ptr	ptr;

	fn_ptr = addr (debug_table.file.entry (state_fn.num));

	call emit_debug_name (TOK_TAB.ptr (state_fn.TOK));/* MOVE NAME(token) TO DEBUG-NAME */

	if statement.type = 21
	then do;
		call emit_rec_name (fn_ptr);		/* READ statement */
	     end;
	else do;
		call emit_macro (addr (M3));
	     end;





	call emit_perform (entry_fn.proc_ptr);

     end;

emit_perform:
     proc (p);					/* IF SWITCH-9 PERFORM debug-section END-IF */
declare	p		ptr;

	M5.ptr (9) = p;

	call emit_macro (addr (M5));

     end;

emit_cd:
     proc (p);

declare	(p, cd_ptr, cd_name_ptr)
			ptr;			/* execute debug section for cd-name
						   DEBUG-NAME = cd-name
						   DEBUG-CONTENTS = area for cd-name
						*/

declare	1 state_cd	based (p),
	  2 num		fixed bin,		/* debug table entry */
	  2 TOK		fixed bin;		/* TOK_TAB entry */

declare	1 entry_cd	based (cd_ptr),
	  2 cd_num	fixed bin,
	  2 proc_ptr	ptr;

	cd_ptr = addr (debug_table.cd.entry (state_cd.num));

/*[4.4-3]*/
	cd_name_ptr = TOK_TAB.ptr (state_cd.TOK);	/*[4.4-3]*/
	call emit_debug_name (cd_name_ptr);		/*[4.4-3]*/
	call emit_debug_contents (cd_name_ptr);

	call emit_perform (entry_cd.proc_ptr);

     end;

emit_db_code:
     proc;

/* execute the debug sections specified
						   in the statement table
						*/

declare	i		fixed bin;

	if statement.cd.size ^= 0			/* cd-names */
	then do i = 1 by 1 to statement.cd.size;

		call emit_cd (addr (statement.cd.entry (i)));

	     end;

	if statement.file.size ^= 0			/* file-names */
	then do i = 1 by 1 to statement.file.size;

		call emit_file (addr (statement.file.entry (i)));

	     end;

	if statement.data.size ^= 0			/* data-names */
	then do i = 1 by 1 to statement.data.size;

		call emit_data (addr (statement.data.entry (i)), addr (statement.data.data (i)));

	     end;
     end;

emit_debug_name:
     proc (p);					/* MOVE NAME(token) TO DEBUG-LINE */
declare	p		ptr;

	M2.ptr (2) = p;

	call emit_macro (addr (M2));
     end;

emit_debug_contents:
     proc (p);

declare	p		ptr;

	M4.ptr (2) = p;

	call emit_macro (addr (M4));
     end;

open_db:
     proc (tab_ptr);				/* initialize for debug table search	*/
						/* TAB based(tab_ptr)		*/
						/* (first_ptr,last_ptr,size,max)	*/
dcl	tab_ptr		ptr;

	TAB_PTR = tab_ptr;
	ENT_NUM = 0;
	NEXT_PTR = null ();
	ENT_PTR = null ();
	eof = "0"b;
	main_tab = "1"b;

     end;

extend_db:
     proc (ent_size);

declare	ent_size		fixed bin,
	new_ptr		ptr;

	ENT_NUM = ENT_NUM + 1;

	if ENT_NUM <= TAB.max
	then return;

	new_ptr = cobol$alloc (ent_size + 2);

	if ENT_NUM = TAB.max + 1
	then do;
		TAB.first_ptr = new_ptr;
		main_tab = "0"b;
	     end;
	else TAB.last_ptr -> ENTRY.next = new_ptr;

	TAB.last_ptr, ENT_PTR = new_ptr;
	new_ptr -> ENTRY.next = null ();
     end;

get_next_db:
     proc;					/* find next entry in a sub-table */
	ENT_NUM = ENT_NUM + 1;

	if ENT_NUM > TAB.size
	then do;
		eof = "1"b;			/* end of table */
		return;
	     end;

	if ENT_NUM <= TAB.max
	then do;
		main_tab = "1"b;			/* entry in main table */
		return;
	     end;

	if ENT_NUM = TAB.max + 1
	then do;
		main_tab = "0"b;

		if TAB.first_ptr = null ()		/* first entry in extended table */
		then do;
			eof = "1"b;		/* end of table */
			return;
		     end;
		ENT_PTR = TAB.first_ptr;
	     end;
	else do;
		if ENTRY.next = null ()		/* subseq entry in extended table */
		then do;
			eof = "1"b;		/* end of table */
			return;
		     end;
		ENT_PTR = ENTRY.next;
	     end;
     end;

search_data:
     proc;					/* search debug table for data-name */
	call open_db (addr (debug_table.data));

	do while ("1"b);

	     call get_next_db;

	     if eof
	     then do;
		     if MODE ^= 0
		     then call extend_db (data_size);

		     if main_tab
		     then ENT_PTR = addr (TAB_PTR -> data_array (ENT_NUM));
		     return;
		end;

	     if main_tab
	     then ENT_PTR = addr (TAB_PTR -> data_array (ENT_NUM));
	     else ENT_PTR = addr (ENTRY.data);

	     call dn_comp;
	     if res = 1
	     then return;
	end;
     end;

search_proc:
     proc;					/* search debug table for proc-name */
	call open_db (addr (debug_table.proc));

	do while ("1"b);

	     call get_next_db;

	     if eof
	     then do;
		     if MODE ^= 0
		     then call extend_db (proc_size);

		     if main_tab
		     then ENT_PTR = addr (TAB_PTR -> proc_array (ENT_NUM));
		     return;
		end;

	     if main_tab
	     then ENT_PTR = addr (TAB_PTR -> proc_array (ENT_NUM));
	     else ENT_PTR = addr (ENTRY.data);

	     call pn_comp;
	     if res = 1
	     then return;
	end;
     end;

search_file:
     proc;					/* search debug table for file-name */
	call open_db (addr (debug_table.file));

	do while ("1"b);

	     call get_next_db;

	     if eof
	     then do;
		     if MODE ^= 0
		     then call extend_db (file_size);

		     if main_tab
		     then ENT_PTR = addr (TAB_PTR -> file_array (ENT_NUM));
		     return;
		end;

	     if main_tab
	     then ENT_PTR = addr (TAB_PTR -> file_array (ENT_NUM));
	     else ENT_PTR = addr (ENTRY.data);

	     call fn_comp;
	     if res = 1
	     then return;
	end;
     end;

search_cd:
     proc;					/* search debug table for cd-name */
	call open_db (addr (debug_table.cd));

	do while ("1"b);

	     call get_next_db;

	     if eof
	     then do;
		     if MODE ^= 0
		     then call extend_db (cd_size);

		     if main_tab
		     then ENT_PTR = addr (TAB_PTR -> cd_array (ENT_NUM));

		     return;
		end;

	     if main_tab
	     then ENT_PTR = addr (TAB_PTR -> cd_array (ENT_NUM));
	     else ENT_PTR = addr (ENTRY.data);

	     call cd_comp;
	     if res = 1
	     then return;
	end;
     end;

emit_go_to:
     proc;

	call emit_macro (addr (M3));			/* MOVE SPACES TO DEBUG-CONTENTS */

	call emit;
	call st_init;

     end;

emit_go_to_dep:
     proc;

/*[4.0-1]*/
	call set_debug_line;

	if stne
	then call emit_db_code;

	if statement.proc.size ^= 0
	then call emit_macro (addr (M3));

	call emit_nl;
     end;

emit_string:
     proc;					/* string statement */
	call emit;
	call st_init;
     end;

emit_unstring:
     proc;					/* unstring statement */
	call emit;
	call st_init;
     end;

SM_emit:
     proc (iw_ptr, TOK_NUM);

declare	iw_ptr		ptr,
	TOK_NUM		fixed bin;

	M4.ptr (2) = iw_ptr;			/* literal */
	M2.ptr (2) = TOK_TAB.ptr (TOK_NUM);		/* PN */

	call emit_macro (addr (M4));			/* MOVE LL TO DEBUG-CONTENTS */

	call emit_macro (addr (M2));			/* MOVE "PN" TO DEBUG-NAME */

/*[4.0-1]*/
	call set_debug_line;			/* MOVE LINE TO DEBUG-LINE */

     end;

emit_sort_merge:
     proc (type);					/* sort/merge statements */

declare	type		fixed bin;		/* 0: sort, 1: merge */
declare	sub_ptr		ptr;

declare	1 sub,
	  2 TOK		fixed bin,
	  2 TOK_size	fixed bin;

	sub_ptr = addr (sub);


	if sm_desc.ip_TOK ^= 0
	then do;
		sub.TOK = 1;
		sub.TOK_size = sm_desc.ip_TOK - 1;
		call emit_range (sub_ptr);

		call SM_emit (item_tab.ptr (17), sm_desc.ip_TOK);
						/* SORT INPUT */

		if sm_desc.op_TOK ^= 0
		then do;
			sub.TOK = sm_desc.ip_TOK;
			sub.TOK_size = sm_desc.op_TOK - sm_desc.ip_TOK;
			call emit_range (sub_ptr);

			call SM_emit (item_tab.ptr (18), sm_desc.op_TOK);
						/* SORT OUTPUT */

			sub.TOK = sm_desc.op_TOK;
			sub.TOK_size = TOK_TAB.size - sm_desc.op_TOK;
			call ER (sub_ptr);
		     end;
		else do;
			sub.TOK = sm_desc.ip_TOK;
			sub.TOK_size = TOK_TAB.size - sm_desc.ip_TOK;
			call ER (sub_ptr);
		     end;
	     end;
	else do;
		if sm_desc.op_TOK ^= 0
		then do;
			sub.TOK = 1;
			sub.TOK_size = sm_desc.op_TOK - 1;
			call emit_range (sub_ptr);

			if type = 0
			then call SM_emit (item_tab.ptr (18), sm_desc.op_TOK);
						/* SORT OUTPUT */
			else call SM_emit (item_tab.ptr (19), sm_desc.op_TOK);
						/* MERGE OUTPUT */

			sub.TOK = sm_desc.op_TOK;
			sub.TOK_size = TOK_TAB.size - sm_desc.op_TOK;
			call ER (sub_ptr);
		     end;
		else do;
			call emit;
			call st_init;
		     end;
	     end;
     end;

ER:
     proc (sub_ptr);

declare	sub_ptr		ptr;

	call emit_range (sub_ptr);

	TOK_TAB.ptr (1) = TOK_TAB.ptr (TOK_TAB.size);
	TOK_TAB.size = 1;

     end;

emit_if:
     proc;					/* if statement */
	call emit;
	call st_init;
     end;

emit_move:
     proc;					/* move statement */
	call emit;
	if stne
	then call emit_db_code;
	call st_init;
     end;

emit_perform_state:
     proc;

declare	i		fixed bin;

	if per_desc.pn1 = 0
	then do;
		call emit;			/* in-line perform */
		call st_init;
		return;
	     end;

	if ^stne
	then do;
		call emit;
		call st_init;
		return;
	     end;

/*[4.0-1]*/
	call set_debug_line;			/* MOVE LINE-NUMBER TO DEBUG-LINE */

	if per_desc.format ^= 4
	then call PUT (item_tab.ptr (15));		/* PERFORM */

	emrec = "1"b;

	go to PERF (per_desc.format);

PERF (1):
	go to PRF;

PERF (2):
	call emit_range (addr (per_desc.count));

	call PUT (item_tab.ptr (28));			/* TIMES */

	call get_st_num (per_desc.count.tok_no);

	if st_no ^= 0
	then call ED (st_no);

	go to PRF;
PERF (3):
	call PUT (item_tab.ptr (29));			/* UNTIL */
	call emit_range (addr (per_desc.until));

	per_desc.until.copy_loc = copy_tab.size + 1;
	copy_mode = "1"b;

	call emit_db_cond (addr (per_desc.until));	/* debug(condition) */

	copy_mode = "0"b;

	call perf_common;

/*[4.0-1]*/
	call set_debug_line;			/* MOVE LINE-NUMBER TO DEBUG-LINE */

	call PUT (item_tab.ptr (27));			/* END-PERFORM */

/*[4.0-1]*/
	call set_debug_line;			/* MOVE LINE-NUMBER TO DEBUG-LINE */

	call emit_copy (per_desc.until.copy_loc);	/* debug(condition) */

	go to PRF2;

PRF:
	call perf_common;
	call PUT (item_tab.ptr (27));			/* END-PERFORM */
PRF2:
	call reset_TOK_TAB;

	emrec = "0"b;
	return;

PERF (4):
	do i = 1 by 1 to per_desc.dim;

	     call perf_set (i);

/* debug(V(i),R(i)) */

	end;

	do i = 1 by 1 to per_desc.dim;

	     call perf_until (i);			/* debug(cond(i)) */

	end;

	call perf_common;

/*[4.0-1]*/
	call set_debug_line;			/* MOVE LINE-NUMBER TO DEBUG-LINE */

	call perf_incr (per_desc.dim);

/* debug(V,I) */

	call PUT (item_tab.ptr (27));			/* END-PERFORM */

	call emit_copy (per_desc.loop.cond.copy_loc (per_desc.dim));
						/* debug(cond) */

	if per_desc.dim = 1
	then go to PRF2;

	do i = per_desc.dim - 1 by -1 to 1;

	     call perf_set (i + 1);

/* debug(V,R) */

	     call perf_incr (i);

/* debug(V,I) */

	     call PUT (item_tab.ptr (27));		/* END-PERFORM */

	     call emit_copy (per_desc.loop.cond.copy_loc (i));
						/* debug(cond(i)) */

	end;

	go to PRF2;
     end;

perf_common:
     proc;

declare	(pn1, pn2)	fixed bin;		/* MOVE pn1 TO DEBUG-NAME */
	st_no = 0;

	if per_desc.pn1 ^= 0 & statement.proc.size ^= 0
	then call get_st_proc_num (per_desc.pn1);

	if st_no ^= 0
	then do;

		call emit_debug_name (TOK_TAB.ptr (per_desc.pn1));

/* MOVE "PERFORM-LOOP" TO DEBUG-CONTENTS */

		call emit_debug_contents (item_tab.ptr (20));

/* MOVE line-number TO DEBUG-LINE */

	     end;

/* PERFORM pn1 THRU pn2 */
	pn1 = per_desc.pn1;
	pn2 = per_desc.pn2;

	call PUT (item_tab.ptr (15));			/* PERFORM */
	call PUT (TOK_TAB.ptr (pn1));			/* PN */
	call PUT (item_tab.ptr (32));			/* THRU  */

	if pn2 ^= 0
	then call PUT (TOK_TAB.ptr (pn2));
	else call PUT (TOK_TAB.ptr (pn1));



/*[4.0-1]*/
	call set_debug_line;			/* MOVE LINE-NUMBER TO DEBUG-LINE */

     end;

perf_until:
     proc (i);

declare	i		fixed bin;

	call PUT (item_tab.ptr (15));			/* PERFORM */
	call PUT (item_tab.ptr (29));			/* UNTIL */

	call PUT (item_tab.ptr (67));			/* ( */
	call emit_range (addr (per_desc.cond (i)));	/* condition */
	call PUT (item_tab.ptr (31));			/* ) */

	per_desc.loop.cond.copy_loc (i) = copy_tab.size + 1;
	copy_mode = "1"b;

	call emit_db_cond (addr (per_desc.loop.cond (i)));/* debug(condition) */

	copy_mode = "0"b;

     end;

perf_set:
     proc (i);

declare	i		fixed bin,
	(v, f)		fixed bin,
	(vp, rp)		ptr;

	vp = addr (per_desc.loop.var (i));
	rp = addr (per_desc.loop.from (i));

	if TOK_TAB.ptr (per_desc.loop.var.tok_no (i)) -> header.type = 10
	then do;
		call PUT (item_tab.ptr (23));		/* SET, V = index name */
		call emit_range (vp);		/* V */
		call PUT (item_tab.ptr (10));		/* TO */
		call emit_range (rp);		/* R */
	     end;

	else if TOK_TAB.ptr (per_desc.loop.from.tok_no (i)) -> header.type = 10
	then do;
		call PUT (item_tab.ptr (23));		/* SET, V = identifier */
		call emit_range (vp);		/* V */
		call PUT (item_tab.ptr (10));		/* TO */
		call emit_range (rp);		/* R */
	     end;
	else do;
		call PUT (item_tab.ptr (9));		/* MOVE, R = inentifier */
		call emit_range (rp);		/* R */
		call PUT (item_tab.ptr (10));		/* TO */
		call emit_range (vp);		/* V */
	     end;

	call db_perf (rp, vp);

/*	SET(V R)	V = identifier	R = identifier	MOVE R TO V
				R = index-name	SET V TO R
				R = literal	MOVE R TO V
		V = index-name			SET V TO R
*/

     end;

perf_incr:
     proc (i);

declare	i		fixed bin,
	(v, r)		fixed bin,
	(vp, rp)		ptr;

/*	V = identifier	R = identifier	ADD R TO V
			R = index-name
			R = literal

	V = index-name	R = identifier	SET V UP BY R
			R = index-name
			R = literal
*/

	vp = addr (per_desc.loop.var (i));
	rp = addr (per_desc.loop.by (i));

	if TOK_TAB.ptr (per_desc.loop.var.tok_no (i)) -> header.type = 10
	then do;
		call PUT (item_tab.ptr (23));		/* SET */
		call emit_range (vp);		/* V */
		call PUT (item_tab.ptr (25));		/* UP */
		call PUT (item_tab.ptr (26));		/* BY */
		call emit_range (rp);		/* R */
	     end;
	else do;
		call PUT (item_tab.ptr (33));		/* ADD */
		call emit_range (rp);		/* R */
		call PUT (item_tab.ptr (10));		/* TO */
		call emit_range (vp);		/* V */
	     end;

	call db_perf (rp, vp);
     end;

/*	Perform Statement Expansion

	Format 1:

		XX PERFORM pn1 THRU pn2

		LINE = "XX"
		PERFORM
			NAME = "pn1"
			CONTENTS = "PERFORM=LOOP"
			PERFORM pn1 THRU pn2
			LINE = "XX"
		END-PERFORM

	Format 2:

		XX PERFORM pn1 THRU pn2 count TIMES

		LINE = "XX"
		PERFORM count TIMES
			NAME = "pn1"
			CONTENTS = "PERFORM-LOOP"
			PERFORM pn1 THRU pn2
			LINE = "XX"
		END-PERFORM

	Format 3:

		XX PERFORM pn1 THRU pn2 UNTIL condition

		LINE = "XX"
		PERFORM UNTIL condition
			debug(condition)
			NAME = "pn1"
			CONTENTS = "PERFORM-LOOP"
			PERFORM pn1 THRU pn2
			LINE = "XX"
		END-PERFORM
		LINE = "XX"
		debug(condition)

	Format 4:

	XX PERFORM pn1 THRU pn2
		VARYING V1 FROM R1 BY I1 UNTIL C1
		AFTER   V2 FROM R2 BY I2 UNTIL C2
		AFTER   V3 FROM R3 BY I3 UNTIL C3

	LINE = "XX"
	SET(V1 R1) debug(V1 R1)
	SET(V2 R2) debug(V2 R2)
	SET(V3 R3) debug(V3 R3)

	PERFORM UNTIL ( C1 )
		debug( C1 )
		PERFORM UNTIL  ( C2 )
			debug( C2)
			PERFORM UNTIL  ( C3 )
				debug( C3 )
				NAME = "pn1"
				CONTENTS = "PERFORM-LOOP"
				PERFORM pn1 THRU pn2
				LINE = "XX"
				INCR(V3 I3) debug(V3 I3)
			END-PERFORM
			debug(C3)
			SET(V3 R3) debug(V3 R3)
			INCR(V2 I2) debug(V2 I2)
		END-PERFORM
		debug(C2)
		SET(V2 R2) debug(V2 R2)
		INCR(V1 I1) debug(V1 I1)
	END-PERFORM
	debug(C1)
*/

reset_TOK_TAB:
     proc;

	TOK_TAB.ptr (1) = TOK_TAB.ptr (TOK_TAB.size);
	TOK_TAB.size = 1;

     end;

emit:
     proc;					/* emit all but last token */
declare	TOK_SIZE		fixed bin;

	TOK_SIZE = TOK_TAB.size;
	TOK_TAB.size = TOK_TAB.size - 1;

/*[4.0-1]*/
	if N_L & DB & decswitch > 3
	then call set_debug_line;
	call EMIT;				/* last token now first token */
	TOK_TAB.ptr (1) = TOK_TAB.ptr (TOK_SIZE);
	TOK_TAB.size = 1;

     end;						/*[4.4-3]*/
declare	opt_word_num	fixed bin;
emit_not_option:
     proc (not_option);

declare	not_option	fixed bin;




	call db_emit;				/* emit statement */

	if ^stne
	then return;

/*[4.4-3]*/
	if statement.type ^= 23
	then call PUT (item_tab.ptr (30));		/* emit NOT unless RECEIVE state */

	call emit_option (not_option);		/* emit option clause */

emit_option:
     proc (not_option);

declare	not_option	fixed bin;

	go to ENO (not_option);

ENO (1):						/* ON SIZE ERROR */
	call PUT (item_tab.ptr (35));
	call PUT (item_tab.ptr (36));
	call PUT (item_tab.ptr (37));
	go to ENO1;

ENO (2):						/* AT END */
	call PUT (item_tab.ptr (38));
	call PUT (item_tab.ptr (39));
	go to ENO1;

ENO (3):						/* INVALID KEY */
	call PUT (item_tab.ptr (40));
	call PUT (item_tab.ptr (41));
	go to ENO1;

ENO (4):						/* AT EOP */
	call PUT (item_tab.ptr (38));
	call PUT (item_tab.ptr (42));
	go to ENO1;

ENO (5):						/* ON OVERFLOW */
	call PUT (item_tab.ptr (35));
	call PUT (item_tab.ptr (43));
	go to ENO1;

ENO (6):						/* WITH DATA */
	call PUT (item_tab.ptr (44));
	call PUT (item_tab.ptr (45));
	go to ENO1;

ENO (7):						/* ON EXCEPTION */
	call PUT (item_tab.ptr (35));
	call PUT (item_tab.ptr (46));
	go to ENO1;

ENO (8):						/* NO/WITH DATA */
	call PUT (item_tab.ptr (opt_word_num));
	call PUT (item_tab.ptr (45));			/*4.4-3]*/
	opt_word_num = 47;				/* no */
	go to ENO1;
ENO1:
     end;

	call emit_db_code;

	call emit_option (not_option);

	if statement.type ^= 21 & statement.type ^= 23
	then call emit_db_code;

	call st_init;

	not_emitted = "1"b;
     end;

db_emit:
     proc;

	go to VERB (statement.type);

VERB (0):						/*[4.4-4]*/
	call emit;				/*[4.4-4]*/
	e_res = 2;
	return;

VERB (1):						/* accept */
	call emit;				/*[5.0-1]*/
	if cd_pres
	then e_res = 1;
	else e_res = 2;
	return;
VERB (2):						/* add */
	call emit;
	e_res = 1;
	return;
VERB (3):						/* illegal */
	call emit_nl;
	e_res = 2;
	return;
VERB (4):						/* alter */
	call emit_alter;
	e_res = 2;
	return;
VERB (5):						/* call */
	call emit;
	e_res = 1;
	return;
VERB (6):						/* illegal */
	call emit_nl;
	e_res = 2;
	return;
VERB (7):						/* cancel */
	call emit;
	e_res = 1;
	return;
VERB (8):						/* close */
	call emit;
	e_res = 1;
	return;
VERB (9):						/* divide */
	call emit;
	e_res = 1;
	return;
VERB (10):					/* multiply */
	call emit;
	e_res = 1;
	return;
VERB (11):					/* subtract */
	call emit;
	e_res = 1;
	return;
VERB (12):					/* exit */
	call emit_nl;
	e_res = 2;
	return;
VERB (13):					/* illegal */
	call emit_nl;
	e_res = 2;
	return;
VERB (14):					/* go */
	call emit_go_to;
	e_res = 2;
	return;
VERB (15):					/* merge */
	call emit_sort_merge (1);
	;
	e_res = 2;
	return;
VERB (16):					/* initiate */
	call emit;
	e_res = 1;
	return;
VERB (17):					/* inspect */
	call emit;
	e_res = 1;
	return;
VERB (18):					/* move */
	call emit_move;
	e_res = 2;
	return;
VERB (19):					/* open */
	call emit;
	e_res = 1;
	return;
VERB (20):					/* perform */
	call emit_perform_state;
	e_res = 2;
	return;
VERB (21):					/* read */
	call emit;
	e_res = 1;
	return;
VERB (22):					/* delete */
	call emit;
	e_res = 1;
	return;
VERB (23):					/* receive */
	call emit;
	e_res = 1;
	return;
VERB (24):					/* release */
	call emit;
	e_res = 1;
	return;
VERB (25):					/* return */
	call emit;
	e_res = 1;
	return;
VERB (26):					/* search */
	call emit;
	e_res = 1;
	return;
VERB (27):					/* rewrite */
	call emit_wr_rew;
	e_res = 1;
	return;
VERB (28):					/* illegal */
	call emit_nl;
	e_res = 1;
	return;
VERB (29):					/* illegal */
	call emit_nl;
	e_res = 1;
	return;
VERB (30):					/* send */
	call emit;
	e_res = 1;
	return;
VERB (31):					/* set */
	call emit;
	e_res = 1;
	return;
VERB (32):					/* illegal */
	call emit_nl;
	e_res = 2;
	return;
VERB (33):					/* stop */
	call emit;
	e_res = 2;
	return;
VERB (34):					/* string */
	call emit_string;
	e_res = 2;
	return;
VERB (35):					/* suspend */
	call emit;
	e_res = 1;
	return;
VERB (36):					/* terminate */
	call emit;
	e_res = 1;
	return;
VERB (37):					/* unstring */
	call emit_unstring;
	e_res = 2;
	return;
VERB (38):					/* write */
	call emit_wr_rew;
	e_res = 1;
	return;
VERB (39):					/* illegal */
	call emit_nl;
	e_res = 2;
	return;
VERB (40):					/* compute */
	call emit;
	e_res = 1;
	return;
VERB (41):					/* disable */
	call emit;
	e_res = 1;
	return;
VERB (42):					/* display */
	call emit;
	e_res = 1;
	return;
VERB (43):					/* enable */
	call emit;
	e_res = 1;
	return;
VERB (44):					/* enter */
	call emit;
	e_res = 2;
	return;
VERB (45):					/* generate */
	call emit;
	e_res = 1;
	return;
VERB (46):					/* hold */
	call emit;
	e_res = 2;
	return;
VERB (47):					/* if */
	call emit_if;
	return;
VERB (48):					/* process */
	call emit;
	e_res = 2;
	return;
VERB (49):					/* sort */
	call emit_sort_merge (0);
	e_res = 2;
	return;
VERB (50):					/* examine */
	call emit;
	e_res = 1;
	return;
VERB (51):					/* transform */
	call emit;
	e_res = 1;
	return;
VERB (56):					/* start */
	call emit;
	e_res = 1;
	return;
VERB (57):					/* suppress */
	call emit;
	e_res = 1;
	return;
VERB (58):					/* purge */
	call emit;
	e_res = 1;
	return;
VERB (100):					/* procedure division */
	call emit_nl;
	e_res = 2;
	return;
VERB (101):					/* declaratives */
	call emit_nl;
	e_res = 2;
	return;
VERB (103):					/* section header */
	call emit_proc_name;
	e_res = 2;
	return;
VERB (104):					/* paragraph header */
	call emit_proc_name;
	e_res = 2;
	return;
VERB (106):					/* . */
	call emit_nl;
	e_res = 2;
	return;
VERB (107):					/* P.go to. */
	call emit_go_to;
	e_res = 2;
	return;
VERB (108):					/* go to depending */
	call emit_go_to_dep;
	e_res = 2;
	return;
VERB (109):					/* P.exit [program] */
	call emit_nl;
	e_res = 2;
	return;
VERB (110):					/* stop statement */
	call emit_nl;
	e_res = 1;
	return;
VERB (111):					/* end declaratives */
	call emit_nl;

	if ^DB & ^all_procs
	then return;

	res = 1;

	if proc_def_size > 0
	then do while (res = 1);

		call cobol_swf_get (cobol_rmin2fp, st, addr_record, tln);

		if alphanum_lit.type = 3 & alphanum_lit.string = "~~~"
		then res = 0;

	     end;

	call st_init;
	TOK_TAB.size = 0;
	call SCAN;
	return;
VERB (112):					/* end_cobol */
	call emit_nl;
	e_res = 2;
	return;
VERB (113):					/* type 25 token */
	call emit_nl;
	e_res = 2;
	return;
VERB (114):					/* use statement */
	call emit_nl;
	e_res = 2;
	return;
VERB (115):					/* on size error */
	call emit_nl;
	e_res = 2;
	return;
VERB (116):					/* next */
	call emit_nl;
	e_res = 2;
	return;
VERB (117):					/* else */
	call emit_nl;
	e_res = 2;
	return;
VERB (118):					/* invalid key */
	call emit_nl;
	e_res = 2;
	return;
VERB (119):					/* at end */
	call emit_nl;
	e_res = 2;
	return;
VERB (120):					/* at eop */
	call emit_nl;
	e_res = 2;
	return;

     end;

enter_db_table:
     proc;

	PP = addr_record;
	call set_type;

	if DB_TYPE = 1 & all_procs			/* test for all procs */
	then do;
		call diag (1);
		return;
	     end;

	MODE = 0;
	call search_debug_table;

	if eof
	then DB = "1"b;

	go to EDT (DB_TYPE);			/* make new entry in debug table */

EDT (1):						/* proc-name */
	if eof
	then do;
		proc_entry.section_name = PP -> proc_def.section_name;
		proc_entry.section_num = PP -> proc_def.section_num;
		proc_entry.proc_num = PP -> proc_def.proc_num;
		proc_entry.proc_ptr = section_ptr;
	     end;
	else call diag (2);

	go to EDT1;

EDT (2):						/* identifier */
	if eof
	then do;
		data_entry.proc_ptr = section_ptr;
		data_entry.seg_num = PP -> data_name.seg_num;
		data_entry.offset = PP -> data_name.offset;
		data_entry.level = PP -> data_name.level;
		data_entry.name_size = PP -> data_name.name_size;
		data_entry.name = PP -> data_name.name;

		if ALL_REFS
		then debug_table.data.all_refs (debug_table.data.size + 1) = "1"b;

	     end;
	else call diag (3);

	go to EDT1;

EDT (3):						/* file-name */
	if eof
	then do;
		file_entry.proc_ptr = section_ptr;
		file_entry.file_no = PP -> fd_token.file_no;
	     end;
	else call diag (4);

	go to EDT1;

EDT (4):						/* cd-name */
	if eof
	then do;
		cd_entry.proc_ptr = section_ptr;
		cd_entry.cd_num = PP -> cdtoken.cd_num;
	     end;
	else call diag (5);

	go to EDT1;

EDT1:
	TAB_PTR -> CD.size = TAB_PTR -> CD.size + 1;	/* incr size of debug sub-table */

     end;

search_st_table:
     proc;					/* search and enter statement table */
	go to SST (DB_TYPE);

SST (1):						/* proc-name */
	tab_max = 50;
	tab_ptr = addr (statement.proc);
	call ent_tab;
	go to SS;

SST (2):						/* identifier */
	tab_max = 50;
	tab_ptr = addr (statement.data);
	call ent_tab;

	if send_bit
	then do;
		if new_entry
		then statement.data.entry.TOK (EN) = -statement.data.entry.TOK (EN);
	     end;
	else do;
		if statement.data.entry.TOK (EN) < 0
		then statement.data.entry.TOK (EN) = -statement.data.entry.TOK (EN);
	     end;

	QQ = addr (statement.data.data (EN));
	statement_data_entry.dimen = 0;
	statement_data_entry.TOK_size = 1;
	ST_NO = EN;

	go to SS;

SST (3):						/* file-name */
	tab_max = 20;
	tab_ptr = addr (statement.file);
	call ent_tab;
	go to SS;

SST (4):						/* cd-name */
	tab_max = 5;
	tab_ptr = addr (statement.cd);
	call ent_tab;

	go to SS;

SS:
     end;

ent_tab:
     proc;

	tab_size = TB.size;
	new_entry = "1"b;

	if tab_size = 0
	then do;
		EN, TB.size = 1;
		stne = "1"b;
		TB.num (1) = ENT_NUM;
		TB.TOK (1) = TOK_TAB.size;

		return;
	     end;

	do EN = 1 by 1 to tab_size;

	     if TB.num (EN) = ENT_NUM
	     then do;
		     new_entry = "0"b;
		     return;
		end;

	end;

	if tab_size = tab_max
	then do;
		EN = 0;				/* not found */
		new_entry = "0"b;

		return;
	     end;

	EN, tab_size = tab_size + 1;
	TB.size = tab_size;
	TB.num (tab_size) = ENT_NUM;
	TB.TOK (tab_size) = TOK_TAB.size;

     end;

enter_st_table:
     proc;					/* If token is in the debug table	*/
						/* then search and enter the		*/
						/* statement table			*/
	QQ = null ();
	ST_NO = 0;

	if decswitch < 3
	then do;
		res = 0;
		return;
	     end;

	PP = addr_record;
	MODE = 0;
	EN = 0;

	call set_type;
	call search_debug_table;

	if res = 0
	then return;				/* send_bit = 1(sending) 0(receiving) */
	call search_st_table;

	res = 1;

     end;

search_debug_table:
     proc;					/* see if token mentioned in a use */
						/* for debugging section */

	ENT_NUM = 0;
	ENT_PTR = null ();

	if DB_TYPE = 0
	then return;

	go to SCH (DB_TYPE);

SCH (1):						/* proc-name */
	if all_procs
	then res = 0;				/* use on all procs specified */
	else call search_proc;

	go to SC;

SCH (2):						/* identifier */
	call search_data;
	go to SC;

SCH (3):						/* file-name */
	call search_file;
	go to SC;

SCH (4):						/* cd-name */
	call search_cd;
	go to SC;

SC:
     end;

dn_comp:
     proc;					/* compare identifiers */


	res = 0;

	if PP -> data_name.seg_num = data_entry.seg_num & PP -> data_name.offset = data_entry.offset
	     & PP -> data_name.level = data_entry.level & PP -> data_name.name_size = data_entry.name_size
	     & PP -> data_name.name = substr (data_entry.name, 1, data_name.name_size)
	then res = 1;
     end;

pn_comp:
     proc;					/* compare proc names */
	res = 0;

	if PP -> proc_def.section_name
	then do;
		if ^proc_entry.section_name
		then return;			/* section name */

		if PP -> proc_def.section_num = proc_entry.proc_num
		then res = 1;
	     end;
	else do;
		if proc_entry.section_name
		then return;			/* paragraph name */

		if PP -> proc_def.proc_num = proc_entry.proc_num
		then res = 1;
	     end;
     end;

fn_comp:
     proc;					/* compare file-names */
	res = 0;

	if PP -> fd_token.file_no = file_entry.file_no
	then res = 1;
     end;

cd_comp:
     proc;					/* compare cd-names */
	res = 0;

	if PP -> cdtoken.cd_num = cd_entry.cd_num
	then res = 1;
     end;

set_type:
     proc;					/* token type -> DB_TYPE */
declare	TYPE		fixed bin;

	TYPE = PP -> header.type;
	DB_TYPE, res = 0;

	if TYPE <= 18
	then go to TYP (TYPE);

	return;


TYP (7):						/* proc-name */
TYP (18):
	DB_TYPE = 1;
	go to TP;

TYP (9):						/* identifier */
	DB_TYPE = 2;
	go to TP;

TYP (12):						/* file-name */
TYP (16):
	DB_TYPE = 3;
	go to TP;

TYP (13):						/* cd-name */
	DB_TYPE = 4;
	go to TP;

TYP (1):
TYP (2):
TYP (3):
TYP (4):
TYP (5):
TYP (6):
TYP (10):
TYP (11):
TYP (14):
TYP (15):
TYP (17):
TP:
     end;

scan_to_end:
     proc;					/* read and copy all tokens after the	*/
						/* type 25 token			*/
	call emit;
	call st_init;

	do while ("1"b);

	     call cobol_swf_get (cobol_rmin2fp, st, addr_record, tln);
						/* read record */

	     if substr (st, 17, 16) ^= "0"b
	     then return;				/* eof */

	     call cobol_swf_put (cobol_x3fp, st, addr_record, header.size);
						/* write record */

	end;
     end;

emit_rec_name:
     proc (f_ptr);

declare	f_ptr		ptr,
	ch5		char (5);

declare	FN		fixed bin based (f_ptr);

	ch5 = cobol_ddsyntax$get_file_key (FN);

	if ch5 ^= ""
	then do;
		call cobol_read_rand_ (2, ch5, M4.ptr (2));

		call emit_macro (addr (M4));		/* MOVE RECORD NAME TO DEBUG-CONTENTS */
	     end;

	else call emit_macro (addr (M3));		/* MOVE SPACES TO DEBUG-CONTENTS */

     end;

emit_wr_rew:
     proc;

/*	WRITE record-name FROM identifier ...
				becomes
			MOVE identifier TO record-name
			DEBUG(identifier,record-name)
			WRITE record-name ...
		*/

declare	i		fixed bin,
	fn_save		fixed bin;

	if from_pres
	then do;
		call PUT (item_tab.ptr (9));		/* MOVE */
		call emit_range (addr (FR));		/* identifier */
		call PUT (item_tab.ptr (10));		/* TO */
		call PUT (TOK_TAB.ptr (2));		/* record-name */
						/*[4.0-1]*/
		call set_debug_line;		/* MOVE AN-LIT(statement.line) TO DEBUG-LINE */
		fn_save = statement.file.size;
		statement.file.size = 0;

		call emit_db_code;

		statement.file.size = fn_save;
		statement.data.size = 0;

		do i = FR.TOK + FR.TOK_size by 1 to TOK_TAB.size;

		     TOK_TAB.ptr (i - FR.TOK_size - 1) = TOK_TAB.ptr (i);

		end;

		TOK_TAB.size = TOK_TAB.size - FR.TOK_size - 1;

		call emit_nl;

	     end;

	else call emit;

     end;

db_perf:
     proc (sp, rp);					/*emit debug code during perform statement */

declare	(rp, sp)		ptr;
declare	(sp_no, rp_no)	fixed bin;
declare	TN		fixed bin,
	p		ptr;

declare	1 ident		based,
	  2 tok_no	fixed bin,
	  2 size		fixed bin;

	sp_no, rp_no = 0;				/* entry numbers in statement table */

	TN = sp -> ident.tok_no;
	p = TOK_TAB.ptr (TN);

	if p -> header.type = 9 | p -> header.type = 10
	then do;
		call get_st_num (TN);		/* entry num in statement table */
		sp_no = st_no;
	     end;

	TN = rp -> ident.tok_no;
	p = TOK_TAB.ptr (TN);

	if p -> header.type = 9 | p -> header.type = 10
	then do;
		call get_st_num (TN);		/* entry num in statement table */
		rp_no = st_no;
	     end;

	if sp_no ^= 0
	then do;
		call ED (sp_no);			/* emit code */

		if rp_no = 0 | rp_no = sp_no
		then return;

		call ED (rp_no);			/* emit code */

	     end;
	else if rp_no ^= 0
	then call ED (rp_no);

     end;

get_st_num:
     proc (tn);

declare	(tn, data_tok_num, i)
			fixed bin;

	st_no = 0;

	if statement.data.size ^= 0
	then do i = 1 by 1 to statement.data.size;

		data_tok_num = statement.data.entry.TOK (i);

		if data_tok_num < 0
		then data_tok_num = -data_tok_num;

		if tn = data_tok_num
		then do;
			st_no = i;
			return;
		     end;
	     end;
     end;

ED:
     proc (tn);

declare	tn		fixed bin;

	call emit_data (addr (statement.data.entry (tn)), addr (statement.data.data (tn)));
     end;

get_st_proc_num:
     proc (tn);

/* get entry num in statement table for proc name */

declare	(tn, i)		fixed bin;

	do i = 1 by 1 to statement.proc.size;

	     if statement.proc.entry.TOK (i) = tn
	     then do;
		     st_no = i;
		     return;
		end;
	end;
     end;

set_per_cond_ptr:
     proc;

	per_cond_ptr = addr (per_desc.loop.cond (per_desc.dim));
	per_desc.loop.cond.tok_count (per_desc.dim) = 0;

     end;

set_until_ptr:
     proc;

	per_cond_ptr = addr (per_desc.until);
	per_desc.until.tok_count = 0;

     end;

emit_db_cond:
     proc (p);

declare	p		ptr;

declare	1 cond_desc	based (p),
	  2 tok_no	fixed bin,
	  2 size		fixed bin,
	  2 copy_loc	fixed bin,
	  2 tok_count	fixed bin,
	  2 tok		(128) fixed bin;

	if cond_desc.tok_count > 0
	then do i = 1 by 1 to cond_desc.tok_count;

		call ED (cond_desc.tok (i));

	     end;
     end;

set_subs:
     proc;

	call PUT (item_tab.ptr (9));			/* MOVE */
	call PUT (item_tab.ptr (14));			/* SPACE */
	call PUT (item_tab.ptr (10));			/* TO */
	call PUT (item_tab.ptr (76));			/* DEBUG-SUBS */

     end;

declare	ST_NO		fixed bin,
	per_cond_ptr	ptr;

declare	st_no		fixed bin;		/* entry num in statement table */

declare	1 FR,
	  2 TOK		fixed bin,
	  2 TOK_size	fixed bin;

declare	e_res		fixed bin;

declare	save_addr_record	ptr;

declare	1 TOK_TAB,
	  2 size		fixed bin,
	  2 ptr		(1024) ptr;

declare	proc_ptr		ptr,
	proc_num		fixed bin;

declare	(tab_max, tab_size) fixed bin;

declare	1 TB		based (tab_ptr),
	  2 size		fixed bin,
	  2 entry		(tab_max),
	    3 num		fixed bin,
	    3 TOK		fixed bin;


declare	1 ST		(256),
	  2 parity	fixed bin,		/* 0 no NOT, 1 NOT */
	  2 end_word	fixed bin;

/*	end_word =	1	end-add
		2	end-call
		3	end-compute
		4	end-delete
		5	end-divide
		6	end-evaluate
		7	end-if
		8	end-multiply
		9	end-perform
		10	end-read
		11	end-receive
		12	end-return
		13	end-rewrite
		14	end-search
		15	end-start
		16	end-string
		17	end-subtract
		18	end-unstring
		19	end-write
*/

declare	(cd_size, end_word, nest_lev, PROC_NUM, pn_count)
			fixed bin;
declare	(tab_ptr, section_ptr)
			ptr;

declare	MODE		fixed bin,
	res		fixed bin;
declare	(data_size, proc_size, file_size, cd, i, last_line, last_col)
			fixed bin;
declare	DB_TYPE		fixed bin,
	PP		ptr,
	EN		fixed bin;
declare	(IN_LINE, dim, BEG_ID)
			fixed bin;

declare	TOK_ptr		ptr;
declare	TOK_NUM		fixed bin based (TOK_ptr);

declare	1 sm_desc,
	  2 ip_TOK	fixed bin,		/* input procedure */
	  2 op_TOK	fixed bin;		/* output procedure */

declare	1 item_tab,
	  2 size		fixed bin,
	  2 ptr		(128) ptr;

declare	1 statement_entry	based (QQ),
	  2 num		fixed bin,
	  2 TOK		fixed bin;

declare	1 statement_data_entry
			based (QQ),
	  2 TOK_size	fixed bin,
	  2 dimen		fixed bin,
	  2 sub_1,
	    3 TOK		fixed bin,
	    3 TOK_size	fixed bin,
	  2 sub_2,
	    3 TOK		fixed bin,
	    3 TOK_size	fixed bin,
	  2 sub_3,
	    3 TOK		fixed bin,
	    3 TOK_size	fixed bin,
	  2 sub_ptr	ptr;

declare	1 table		based (tab_ptr),
	  2 size		fixed bin,
	  2 num		(50) fixed bin;

declare	1 cd_entry	based (ENT_PTR),
	  2 cd_num	fixed bin,
	  2 proc_ptr	ptr;

declare	1 file_entry	based (ENT_PTR),
	  2 file_no	fixed bin,
	  2 proc_ptr	ptr;

declare	1 proc_entry	based (ENT_PTR),
	  2 section_name	bit (1),
	  2 section_num	fixed bin,
	  2 proc_num	fixed bin,
	  2 proc_ptr	ptr;

declare	1 data_entry	based (ENT_PTR),
	  2 seg_num	fixed bin,
	  2 offset	fixed bin,
	  2 level		fixed bin,
	  2 name_size	fixed bin,
	  2 name		char (32),
	  2 proc_ptr	ptr;

/* num: entry number in debug_table	*/
/* TOK: entry number in TOK_TAB	*/
declare	1 statement,
	  2 type		fixed bin,
	  2 line		fixed bin,
	  2 cd,					/* cd-names */
	    3 size	fixed bin,
	    3 entry	(5),
	      4 num	fixed bin,
	      4 TOK	fixed bin,
	  2 file,					/* file-names */
	    3 size	fixed bin,
	    3 entry	(20),
	      4 num	fixed bin,
	      4 TOK	fixed bin,
	  2 proc,					/* proc-names */
	    3 size	fixed bin,
	    3 entry	(50),
	      4 num	fixed bin,
	      4 TOK	fixed bin,
	  2 data,					/* identifiers */
	    3 size	fixed bin,
	    3 entry	(50),
	      4 num	fixed bin,
	      4 TOK	fixed bin,		/* neg if sending field */
	    3 data	(50),
	      4 TOK_size	fixed bin,
	      4 dimen	fixed bin,
	      4 sub_1,
	        5 TOK	fixed bin,
	        5 TOK_size	fixed bin,
	      4 sub_2,
	        5 TOK	fixed bin,
	        5 TOK_size	fixed bin,
	      4 sub_3,
	        5 TOK	fixed bin,
	        5 TOK_size	fixed bin,
	      4 sub_ptr	ptr;

dcl	1 debug_table,
	  2 cd,
	    3 first_ptr	ptr,
	    3 last_ptr	ptr,
	    3 size	fixed bin,
	    3 max		fixed bin,
	    3 entry	(5),			/* cd_names */
	      4 cd_num	fixed bin,
	      4 proc_ptr	ptr,
	  2 file,
	    3 first_ptr	ptr,
	    3 last_ptr	ptr,
	    3 size	fixed bin,
	    3 max		fixed bin,
	    3 entry	(20),			/* file names */
	      4 file_no	fixed bin,
	      4 proc_ptr	ptr,
	  2 proc,
	    3 first_ptr	ptr,
	    3 last_ptr	ptr,
	    3 size	fixed bin,
	    3 max		fixed bin,
	    3 entry	(50),			/* proc names */
	      4 section_name
			bit (1),
	      4 section_num fixed bin,
	      4 proc_num	fixed bin,
	      4 proc_ptr	ptr,
	  2 data,
	    3 first_ptr	ptr,
	    3 last_ptr	ptr,
	    3 size	fixed bin,
	    3 max		fixed bin,
	    3 entry	(50),			/* data names */
	      4 seg_num	fixed bin,		/* neg if all refs */
	      4 offset	fixed bin,
	      4 level	fixed bin,
	      4 name_size	fixed bin,
	      4 name	char (32),
	      4 proc_ptr	ptr,
	    3 all_refs	(256) bit (1);

declare	1 alt_tab		(128),			/* alter statement table */
	  2 pn1		fixed bin,
	  2 pn2		fixed bin;

dcl	(TAB_PTR, NEXT_PTR, ENT_PTR, QQ)
			ptr;
dcl	alt_ct		fixed bin;
dcl	ENT_NUM		fixed bin;

declare	1 CD		based,
	  2 first_ptr	ptr,
	  2 last_ptr	ptr,
	  2 size		fixed bin,
	  2 max		fixed bin,
	  2 cd_array	(5),
	    3 cd_num	fixed bin,
	    3 proc_ptr	ptr;

declare	1 FILE		based,
	  2 first_ptr	ptr,
	  2 last_ptr	ptr,
	  2 size		fixed bin,
	  2 max		fixed bin,
	  2 file_array	(20),
	    3 file_no	fixed bin,
	    3 proc_ptr	ptr;

declare	1 PROC		based,
	  2 first_ptr	ptr,
	  2 last_ptr	ptr,
	  2 size		fixed bin,
	  2 max		fixed bin,
	  2 proc_array	(50),
	    3 section_name	bit (1),
	    3 section_num	fixed bin,
	    3 proc_num	fixed bin,
	    3 proc_ptr	ptr;

declare	1 DATA		based,
	  2 first_ptr	ptr,
	  2 last_ptr	ptr,
	  2 size		fixed bin,
	  2 max		fixed bin,
	  2 data_array	(50),
	    3 seg_num	fixed bin,
	    3 offset	fixed bin,
	    3 level	fixed bin,
	    3 name_size	fixed bin,
	    3 name	char (32),
	    3 proc_ptr	ptr;

declare	1 ENTRY		based (ENT_PTR),
	  2 next		ptr,
	  2 data		fixed bin;

declare	1 TAB		based (TAB_PTR),
	  2 first_ptr	ptr,
	  2 last_ptr	ptr,
	  2 size		fixed bin,
	  2 max		fixed bin;

declare	(key, min_index, max_index)
			fixed bin;


declare	(file_org, seg_num, mod_num, act_num)
			fixed bin;
declare	last_seg_num	fixed bin init (1000);
declare	pigz_res		fixed bin;

declare	DIAG_NUM		fixed bin;
declare	tm1		fixed bin (24) init (1),
	tm2		fixed bin (24) init (2),
	tm3		fixed bin (24) init (3),
	tm4		fixed bin (24) init (4),
	tm5		fixed bin (24) init (5);

dcl	vfile_key		fixed bin;
dcl	kc		fixed bin;

declare	1 cond_desc	based (per_cond_ptr),
	  2 tok_no	fixed bin,
	  2 size		fixed bin,
	  2 copy_loc	fixed bin,
	  2 tok_count	fixed bin,
	  2 tok		(128) fixed bin;

declare	(RP, RP1)		ptr;

declare	1 copy_tab,
	  2 size		fixed bin,
	  2 ptr		(256) ptr;

declare	1 per_desc,				/* perform statement description */
	  2 format	fixed bin,		/* 1,2 ,3,4 */
	  2 pn1		fixed bin,		/* proc-name, 0 if in-line, TN */
	  2 pn2		fixed bin,		/* proc-name, 0 if in-line, TN */
	  2 dim		fixed bin,		/* dimension */
	  2 loop		(3),			/* format 4 */
	    3 var,				/* loop variable */
	      4 tok_no	fixed bin,
	      4 size	fixed bin,
	    3 from,				/*from variable */
	      4 tok_no	fixed bin,
	      4 size	fixed bin,
	    3 by,					/* by variable */
	      4 tok_no	fixed bin,
	      4 size	fixed bin,
	    3 cond,				/* condition */
	      4 tok_no	fixed bin,		/* first token, TN */
	      4 size	fixed bin,		/* token count */
	      4 copy_loc	fixed bin,		/* copy stack loc */
	      4 tok_count	fixed bin,
	      4 tok	(128) fixed bin,
	  2 count,				/* count control, format 2 */
	    3 tok_no	fixed bin,
	    3 size	fixed bin,
	  2 until,				/* condition, format 3 */
	    3 tok_no	fixed bin,		/* first token, TN */
	    3 size	fixed bin,		/* token count */
	    3 copy_loc	fixed bin,		/* copy stack loc */
	    3 tok_count	fixed bin,
	    3 tok		(128) fixed bin;



declare	lev_save		fixed bin (24);
declare	subs		(3) fixed bin;
declare	sub_loc		fixed bin;		/*[4.0-1]*/
declare	LN1		char (6),
	nines_ptr		ptr;


declare	1 indicators,
	  2 tbit		bit (1),
	  2 res		bit (1),
	  2 SAE		bit (1),
	  2 send_bit	bit (1),			/* 0 receiving, 1 sending */
	  2 from_pres	bit (1),			/* FROM clause present */
	  2 not_emitted	bit (1),			/* 0 no NOT generated, 1 NOT generated */
	  2 UB_ind	bit (1) init ("0"b),
	  2 subj_req	bit (1),
	  2 db_use_state	bit (1),
	  2 emrec		bit (1),
	  2 copy_mode	bit (1),			/*[4.0-1]*/
	  2 ln_not_emitted	bit (1),
	  2 inhibit_db	bit (1),
	  2 new_entry	bit (1),
	  2 N_L		bit (1),
	  2 db_use_bit	bit (1),
	  2 bad_token	bit (1),
	  2 eof		bit (1),			/* item not in table */
	  2 main_tab	bit (1),			/* entry to made in main table */
	  2 stne		bit (1),			/* statement table is not empty */
	  2 ref_bit	bit (1),
	  2 ALL_REFS	bit (1),			/* all refs phrase used */
	  2 DB		bit (1),			/* debug table is not empty */
	  2 all_procs	bit (1);			/* use for db on all procs used */


dcl	(cssub, db_res, lang_num)
			fixed bin;

dcl	st		bit (32);
dcl	tln		fixed bin;

/* common area */
declare	(a_ptr, w_ptr, sub_ptr)
			ptr;
declare	file_number	fixed bin;


dcl	ft_ptr		ptr;


dcl	gotodep		bit (1) static;		/*  for go to depending verb found in an if statement */

dcl	preospn_bit	bit (1) static;		/* used by EXIT verb */
dcl	(dg_ptr, lev_dg_ptr)
			ptr;			/* pointer to diag item passed to print routine*/
						/*  type 5 structure used to construct diagnostics issued by pdsyntax */
dcl	1 diag_item,
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin,
	  2 run		fixed bin,
	  2 number	fixed bin,
	  2 info		bit (8),
	  2 multics	char (3);

declare	1 lev_diag_item,
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin,
	  2 run		fixed bin,
	  2 number	fixed bin,
	  2 module	fixed bin;



dcl	srchfm2bit	bit (1) static;		/* format 2 of search verb */
dcl	srchbit		bit (1) static;		/* when set we are processing a search verb */
dcl	nestifcnt		fixed bin static;		/* counter for nested if statements */
dcl	common_recsize	fixed bin;		/* size of record just read from common file */

dcl	tempkey		fixed bin;		/* used to hold res word key */
dcl	litcnt		fixed bin;		/* used for size of numeric literal */
						/* used to save the subscript count */
dcl	(subcnt, dimensions)
			fixed bin;
dcl	impswitch		fixed bin static;		/* used for imp verbs */
dcl	decswitch		fixed bin static;		/* if prog has sectons */
dcl	secswitch		fixed bin static;		/* used for sections */
						/* used for debugging sections */



dcl	x		bit (8) based;		/* length of one line in syntax table */

declare	1 interp,
	  2 current_line	fixed bin (24),
	  2 phase		fixed bin (24),
	  2 addr_record	ptr,
	  2 pointer_to_internal
			ptr,
	  2 directory_ptr	ptr,
	  2 source_ptr	ptr;

/* the following dcls are used in conjunction with the syntax table subroutines */
/* the current nested limit is 75 */
declare	intrp_stack	(75) fixed bin (24),	/* used for syntax subroutine */
	i1		fixed bin static;		/* syntax table */
dcl	p		ptr;
declare	trace_ptr		ptr;
dcl	dumfix		fixed bin;

declare	1 syntax_table	(0:10000) based (pointer_to_internal),
	  2 b1		fixed bin,
	  2 b2		fixed bin,
	  2 b3		fixed bin,
	  2 b4		fixed bin,
	  2 b5		fixed bin;

declare	1 syntax_line	based (syntax_line_ptr),
	  2 s_bit		char (1),
	  2 o_bit		char (1),
	  2 t_type	fixed bin,
	  2 t_field	fixed bin,
	  2 s_exit	fixed bin,
	  2 a_num		fixed bin;

declare	syntax_line_ptr	ptr;

declare	1 sline,
	  2 s_bit		char (1),
	  2 o_bit		char (1),
	  2 t_type	fixed bin,
	  2 t_field	fixed bin,
	  2 s_exit	fixed bin,
	  2 a_num		fixed bin;

declare	1 header		based (addr_record),
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin;


dcl	occptr		ptr;


dcl	seqvarptr		ptr;
dcl	varrecaddr	char (5);

dcl	cobol$alloc	entry (fixed bin) returns (ptr);
dcl	(addr, size, fixed, null, substr, unspec, min, max, addrel, translate, string)
			builtin;
dcl	cobol_syntax_trace_$trace
			entry (ptr, fixed bin (24));
dcl	cobol_syntax_trace_$initialize_phase
			entry (ptr, fixed bin (24));
dcl	cobol_imp_word$lang_name
			entry (ptr) returns (fixed bin);
dcl	cobol_swf_get	entry (ptr, bit (32), ptr, fixed bin) ext;
dcl	cobol_read_rand_	entry (fixed bin, char (5), ptr);
dcl	cobol_read_ft	entry (fixed bin, ptr);
dcl	cobol_vdwf_dget	entry (ptr, bit (32), ptr, fixed bin, char (5)) ext;
dcl	ioa_$rsnnl	entry options (variable);
dcl	cobol_swf_put	entry (ptr, bit (32), ptr, fixed bin) ext;
dcl	cobol_db_put	entry (ptr, bit (32), ptr, fixed bin, ptr);
dcl	cobol_vdwf_sput	entry (ptr, bit (32), ptr, fixed bin, char (5)) ext;
dcl	cobol_vdwf_dput	entry (ptr, bit (32), ptr, fixed bin, char (5)) ext;
dcl	cobol_ddsyntax$get_file_key
			entry (fixed bin) returns (char (5));
dcl	cobol_c_list	entry (ptr) ext;		/*  called to print sources and diags */
dcl	cobol_db		entry (ptr, fixed bin) ext;
%include cobol_ext_;

%include cobol_fixed_common;


/* the layout of a file table */


%include cobol_file_table;
%include cobol_diag_file;
%include cobol_;

declare	1 alphabet_name	based (addr_record),
%include cobol_TYPE40;


dcl	1 reserved_word	based (addr_record),
%include cobol_TYPE1;

dcl	1 numeric_lit	based (addr_record),
%include cobol_TYPE2;

dcl	1 alphanum_lit	based (addr_record),
%include cobol_TYPE3;

dcl	1 proc_def	based (addr_record),
%include cobol_TYPE7;

dcl	1 data_name	based (addr_record),
%include cobol_TYPE9;

dcl	1 occurs		based (occptr),
%include cobol_OCCURS;

dcl	1 index_name	based (addr_record),
%include cobol_TYPE10;

dcl	1 fd_token	based (addr_record),
%include cobol_TYPE12;


%include cobol_type13;
dcl	1 mnemonic_name	based (addr_record),
%include cobol_TYPE17;
dcl	01 dumprocname	static,
%include cobol_TYPE18;
/* type18 procedure name stored here for go to depending */
dcl	01 store_label_1	static internal,
%include cobol_TYPE18;
/* store type 18 for go dependig */
dcl	01 store_label_2	static internal,
%include cobol_TYPE18;
%include cobol_file_desc_1;
     end cobol_db_phase;




		    cobol_ddact1.pl1                05/24/89  1044.4rew 05/24/89  0832.8      201897



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_ddact1.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 11/24/81 by FCH, [5.1-1], RECORD CONTAINS does not allow ZERO, BUG520(phx11821) */
/*  Modified on 07/09/79 by MHD, [4.0-1]  commented out  code that put type 17 tokens in name_table when DEBUG */
/* 1/5/77, FCH, fixed bin decls standardized */
/* Modified since version 2.0 */









/* format: style3 */
cobol_ddact1:
     proc (an);
	sv_ptr_auto = cobol_sv_ptr;
	goto actlbl (an);
/********** action routines **********/

/* set_wss_indicator */

actlbl (50):					/*action(5):*/
	substr (section_ind, 2, 1) = "1"b;
	substr (vector_part, 1, 6) = "010000"b;
	file_number = 0;
	rdf_01_sav = null_key;
	goto retrn;				/* end_of_wss */

actlbl (51):					/*action(6):*/
/****** not implemented ******/
	goto retrn;				/* set_cns_indicator */

actlbl (52):					/*action(7):*/
	substr (section_ind, 3, 1) = "1"b;

	substr (vector_part, 1, 6) = "001000"b;
	rdf_01_sav = null_key;
	goto retrn;

/* set_linkage_section_indicator */

actlbl (53):					/*action(9):*/
	substr (section_ind, 4, 1) = "1"b;

	substr (vector_part, 1, 6) = "000100"b;
	rdf_01_sav = null_key;
	goto retrn;				/* end_of_linkage_section */

actlbl (54):					/*action(10):*/
/****** not implemented ******/
	go to retrn;

/*usage comp-n*/

actlbl (55):					/* usage is comp-6 */
						/*action(11):*/
	vector_map.bin_36 = "1"b;
	vector_map.item_signed = "1"b;
	go to retrn;

/* create_dummy_data_name */

actlbl (56):					/*action(13):*/
	dnl = 6;

	save_dname = "FILLER";
	save_line = record.line;
	save_column = record.column;
	go to retrn;

/* set_77_elementary_bits */

actlbl (57):					/*action(15):*/
	vector_map.level_77 = "1"b;

	offset_ct = 0;
	ll77 = "1"b;				/* set 77 exist bit */
	vector_map.elementary = "1"b;
	h = 0;
	go to retrn;				/*item_size_77 */

actlbl (58):					/*action(16):*/
	call data_length;

	if ^vector_map.picture_clause
	then do;
		bit32_1 = substr (vector_part, 9, 32) & pic_suff_bits_mask;
		if bit32_1 = thirty_two_zeros
		then vector_map.no_picture = "1"b;
	     end;
	go to retrn;

/* conditioname_initialization */

actlbl (59):					/*action(19):*/
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;

	conditioname.level = 88;
	conditioname.size = cn_constant;
	conditioname.line = numeric_lit.line;
	conditioname.def_line = numeric_lit.line;
	conditioname.column = numeric_lit.column;
	conditioname.type = 11;
	go to retrn;



data_length:
     proc;
	bit32_1 = substr (vector_part, 9, 32) & non_display_bits_mask;

	if vector_map.item_signed & vector_map.numeric
	then do;

		if vector_map.sign_separate
		     | ((vector_map.ascii_packed_dec_b | vector_map.ascii_packed_dec_h) & vector_map.pic_has_s)
		then go to incr_lnth;
		else if bit32_1 = thirty_two_zeros	/* if display */
		then if vector_map.sign_type = "000"b
		     then if fixed_common.default_sign_type = "011"b | fixed_common.default_sign_type = "100"b
			then go to incr_lnth;
		goto no_incr;

incr_lnth:
		data_name.item_length = data_name.item_length + 1;

	     end;
no_incr:
	if bit32_1 = thirty_two_zeros
	then return;				/* display data */

	if vector_map.bin_16
	then do;
		data_name.item_length = 2;
		data_name.places_right = 0;
		data_name.places_left = 5;
		goto dl_end;
	     end;
	if vector_map.bin_18
	then do;
		data_name.item_length = 2;
		data_name.places_right = 0;
		data_name.places_left = 6;
		goto dl_end;
	     end;
	if vector_map.bin_32
	then do;
		data_name.item_length = 4;
		data_name.places_right = 0;
		data_name.places_left = 10;
		goto dl_end;
	     end;
	if vector_map.bin_36
	then do;
		data_name.item_length = 4;
		data_name.places_right = 0;
		data_name.places_left = 11;
		goto dl_end;
	     end;

/*test packed decimal*/
	if vector_map.ebcdic_packed_dec | vector_map.ascii_packed_dec_h | vector_map.ascii_packed_dec_b
	then do;
		data_name.item_length = divide (data_name.item_length + 1, 2, 15, 0);
		goto dl_end;
	     end;

	if vector_map.usage_index = "1"b
	then data_name.item_length = 6;
dl_end:
	vector_map.pic_integer = "1"b;
	return;
     end data_length;





diag:
     proc;

	message_ptr = addr (message_area);
	message.size = 32;
	message.line = record.line;
	message.column = record.column;
	message.type = 5;
	message.run3 = 3;
	message.info.para = "0"b;
	message.info.rep = "0"b;
	message.info.fillerx = "000000"b;
	message.length = 0;
	message.number = tf;

	call cobol_c_list (message_ptr);
     end diag;



/*set_usage_exist_bit */

actlbl (60):					/*action(24):*/
	vector_map.usage_clause = "1"b;

	go to retrn;				/* set_display_bit */

actlbl (61):					/* usage  is display */
						/*action(25):*/
	vector_map.display = "1"b;

	go to retrn;				/*usage is comp*/

actlbl (62):					/* usage is comp */
						/*action(26):*/
	if fixed_common.comp_defaults.comp_5
	then go to actlbl (73);
	else if fixed_common.disp_defaults.disp
	then go to actlbl (61);
	else if fixed_common.comp_defaults.comp_6
	then go to actlbl (55);
	else if fixed_common.comp_defaults.comp_7
	then go to actlbl (67);
	else if fixed_common.comp_defaults.comp_1
	then go to actlbl (63);
	else if fixed_common.comp_defaults.comp_8
	then go to actlbl (100);
	else if fixed_common.comp_defaults.comp_2
	then go to actlbl (64);
	else if fixed_common.comp_defaults.comp_3
	then go to actlbl (65);
	else if fixed_common.comp_defaults.comp_4
	then go to actlbl (66);
	else go to actlbl (73);


/* usage comp-n */

actlbl (63):					/* usage is comp-1 */
						/*action(27):*/
	vector_map.bin_16 = "1"b;

	vector_map.item_signed = "1"b;
	go to retrn;				/* usage comp-n */

actlbl (64):					/* usage is comp-2 */
						/*action(28):*/
	vector_map.bin_32 = "1"b;

	vector_map.item_signed = "1"b;
	go to retrn;				/*usage comp-n */

actlbl (65):					/* usage is comp-3 */
						/*action(29):*/
	vector_map.ebcdic_packed_dec = "1"b;

	go to retrn;				/* usage comp-n */

actlbl (66):					/* usage is comp-4 */
						/*action(30):*/
	vector_map.ascii_packed_dec_h = "1"b;
	go to retrn;				/* usage comp-n */

actlbl (67):					/* usage is comp-7 */
						/*action(31):*/
	vector_map.bin_18 = "1"b;
	vector_map.item_signed = "1"b;
	go to retrn;				/* set index_bit */

actlbl (68):					/*action(32):*/
	vector_map.usage_index = "1"b;

	go to retrn;				/* set_init_value_extension */

actlbl (69):					/*action(33):*/
	vector_map.value_clause = "1"b;

	vector_map.inherit_value = "1"b;
	initial_ptr = data_name.size + 1;
	go to retrn;				/* store_numeric_value */

actlbl (70):					/*action(34):*/
	vector_map.value_numeric = "1"b;

	if numeric_lit.sign ^= " "
	then vector_map.value_signed = "1"b;

	call store_nv;


store_nv:
     proc;
	numinit.initype.numeric = "1"b;

	if numeric_lit.rtdp = 0
	then numinit.info.integer = "1"b;

	numinit.info.floating = numeric_lit.info.floating;
	numinit.info.filler = numeric_lit.info.filler;
	numinit.expsign = numeric_lit.exp_sign;
	numinit.explaces = numeric_lit.exp_places;
	numinit.sign = numeric_lit.sign;
	numinit.ltdp = numeric_lit.ltdp;
	numinit.rtdp = numeric_lit.rtdp;
	numinit.length = numeric_lit.length;
	niv = nl;
	numinit.literal = numeric_lit.literal;
     end store_nv;


	initial_ptr = data_name.size + 1;
	data_name.size = data_name.size + niv_constant + numinit.length;
						/* add value extention to size */
	fixbin7_1 = mod (data_name.size, 4);
	if fixbin7_1 ^= 0
	then fixbin7_1 = 4 - fixbin7_1;
	data_name.size = data_name.size + fixbin7_1;
	ptr1 = addr (dn_ptr -> any_item (data_name.size + 1));
						/* set ptr1 to next */
	go to retrn;				/* store_alphanumeric_value */

actlbl (71):					/*action(35):*/
	vector_map.value_non_numeric = "1"b;

	call store_av;


store_av:
     proc;
	alphainit.initype.non_numeric = "1"b;
	alphainit.info.bit_string = alphanum_lit.info.bit_string;
	alphainit.length = alphanum_lit.length;
	aiv = al;
	alphainit.string = alphanum_lit.string;
     end store_av;


	initial_ptr = data_name.size + 1;
	initial_ptr = data_name.size + 1;
	data_name.size = data_name.size + aiv_constant + alphainit.length;
	fixbin7_1 = mod (data_name.size, 4);
	if fixbin7_1 ^= 0
	then fixbin7_1 = 4 - fixbin7_1;
	data_name.size = data_name.size + fixbin7_1;
	ptr1 = addr (dn_ptr -> any_item (data_name.size + 1));
	go to retrn;				/* store_fig_con_value */

actlbl (72):					/*action(36):*/
	call store_fcv;


store_fcv:
     proc;
	alphainit.initype.fig_con = "1"b;
	alphainit.info.fig_con_index = substr (unspec (rw.jump_index), 30, 7);
	alphainit.length = 0;
     end store_fcv;


	if alphainit.info.fig_con_index = "0000001"b
	then data_name.size = data_name.size + niv_constant + 1;
						/*leave room for pic_val_comp to change extension to numeric type if data item numeric*/
	else data_name.size = data_name.size + aiv_constant + 1;
						/*leave room for fixup phase to add one-byte literal string*/

	fixbin7_1 = mod (data_name.size, 4);
	if fixbin7_1 ^= 0
	then fixbin7_1 = 4 - fixbin7_1;
	data_name.size = data_name.size + fixbin7_1;

	ptr1 = addr (dn_ptr -> any_item (data_name.size + 1));

	if rw.jump_index = 1
	then vector_map.fig_zero = "1"b;

	go to retrn;				/* usage comp-n */

actlbl (73):					/* usage is comp-5 */
						/*action(37):*/
	vector_map.ascii_packed_dec_b = "1"b;
	go to retrn;				/* sign_clause */

actlbl (74):					/*action(38):*/
	vector_map.sign_clause = "1"b;

	go to retrn;				/* sign_type_overpunch_right_trailing */

actlbl (75):					/*action(39):*/
	vector_map.sign_type = "001"b;

	go to retrn;				/* sign_type_overpunch_left_leading */

actlbl (76):					/*action(40):*/
	vector_map.sign_type = "010"b;
	vector_map.sign_clause_occurred = "1"b;
	go to retrn;

/* sign_type_separate_right */

actlbl (77):					/*action(41):*/
	vector_map.sign_type = "011"b;
	vector_map.sign_separate = "1"b;
	go to retrn;

/* sign_type_separate_left */

actlbl (78):					/*action(42):*/
	vector_map.sign_type = "100"b;
	vector_map.sign_clause_occurred = "1"b;
	vector_map.sign_separate = "1"b;
	go to retrn;

/* set_sync_right */

actlbl (79):
	;

actlbl (80):					/*action(43):*/
	vector_map.sync_right = "1"b;

/*action(44):*/
/*sync*/

	sync_rdf = "1"b;
	fixed_common.sync_in_prog = "1"b;

	if data_name.level = 77
	then goto retrn;

/* set sync bit in 01 item */

	if data_name.level = 1
	then do;
		vector_map.sync_in_rec = "1"b;
		goto retrn;
	     end;

	if cobol_htbl.exp_redefining (1)
	then rnt_key = rdf_01_sav;
	else rnt_key = cobol_htbl.nt_rec (1);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	rnt_ptr -> data_name.sync_in_rec = "1"b;

	call cobol_vdwf_dput (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	go to retrn;				/* set_just_right */

actlbl (81):					/*action(45):*/
	vector_map.just_right = "1"b;

	go to retrn;				/* set_just_left */

actlbl (82):					/*action(46):*/
	go to retrn;				/* set_bwz */

actlbl (83):					/*action(47):*/
	vector_map.bwz = "1"b;

	go to retrn;

/* set_occurs_extension */

actlbl (84):					/*action(48):*/
	vector_map.occurs_clause = "1"b;

	vector_map.subscripted = "1"b;

	if data_name.occurs_ptr = 0
	then data_name.occurs_ptr = data_name.size + 1;

	ptr1 = addr (dn_ptr -> any_item (data_name.occurs_ptr));

	if h ^= 0					/*only under error condition*/
	then do;
		temp_bin1 = data_name.size + 1;
		fh = h;
		rnt_key = cobol_htbl.nt_rec (fh);

		call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

		save_ptr = dn_ptr;
		dn_ptr = rnt_ptr;

		if data_name.occurs_ptr = 0
		then do;
			dn_ptr = save_ptr;
			odim = 0;
		     end;
		else do;
			pdn_occ_ptr = addr (dn_ptr -> any_item (data_name.occurs_ptr));
			odim = pdn_occ_ptr -> occurs.dimensions;
			ptr1 = addr (save_ptr -> any_item (temp_bin1));
			temp_bin1 = occ_constant + occ_dim_constant * odim;
			substr (ptr1 -> anystring, 1, temp_bin1) = substr (pdn_occ_ptr -> anystring, 1, temp_bin1);

/*copies parent's occurs extension onto child*/

			ptr1 -> occurs.keyed = 0;
			dn_ptr = save_ptr;
		     end;
	     end;
	odim = odim + 1;
	occurs.dimensions = odim;
	data_name.size = data_name.size + occ_constant + occ_dim_constant * odim;

	fixbin7_1 = mod (data_name.size, 4);
	if fixbin7_1 ^= 0
	then fixbin7_1 = 4 - fixbin7_1;
	data_name.size = data_name.size + fixbin7_1;

/*POST-RELEASE CHANGE*/
	keycount = 0;
	index_ct = 0;
	occurs.level.indexedno (odim) = 0;
	go to retrn;

na48:
	odim = odim + 1;
	occurs.dimensions = odim;

	if odim > 1 & vector_map.exp_redefining = "1"b
	then data_name.size = data_name.size + occ_dim_constant;
	else data_name.size = data_name.size + (occ_constant + occ_dim_constant * odim);

	fixbin7_1 = mod (data_name.size, 4);
	if fixbin7_1 ^= 0
	then fixbin7_1 = 4 - fixbin7_1;
	data_name.size = data_name.size + fixbin7_1;
	occurs.keyed = 0;
	index_ct = 0;
	occurs.level.indexedno (odim) = 0;
	go to retrn;				/*occurs -integer-*/

actlbl (85):					/*action(49):*/
						/*[5.0-1]*/
	if record.type = 2
	then save_occno = fixed (numeric_lit.literal);
	else save_occno = 0;
	occurs.level.max (odim) = save_occno;
	go to retrn;

/*occurs -integer- to -integer-*/

actlbl (86):					/*action(50):*/
	occurs.level.min (odim) = occurs.level.max (odim);/*[5.0-1]*/
	if record.type = 2
	then save_occno = fixed (numeric_lit.literal);
	else save_occno = 0;
	occurs.level.max (odim) = save_occno;
	goto retrn;				/*occurs ... depending on*/
						/* store obj_rec for odo & create odo_rec */

actlbl (87):					/*action(51):*/
	com2_ptr = addr (cobol_wkbuf2_tbl.wkbuf2);
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;

	odo_rec.info = "00000001"b;			/*for occurs only*/
	odo_rec.next = null_key;
	odo_rec.descr = null_key;
	odo_rec.seg_no = 0;
	odo_rec.offset_l = 0;
	odo_rec.offset_r = 0;
	odo_rec.descr = null_key;
	odo_rec.seg_no = 0;
	odo_rec.offset_l = 0;
	odo_rec.offset_r = 0;

/* write odo_rec into common file */
	cm_ptr = com2_ptr;
	cm_size = odo_rec_constant;

	call cobol_vdwf_sput (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

/* store odo_rec record no in common into the do_rec in data_name item */

	data_name.do_rec = cm_key;

	if h ^= 0
	then do fh = h to 1 by -1;
		cobol_htbl.do_rec (fh) = cm_key;
		cobol_htbl.do_rec_valid (fh) = "1"b;
	     end;

	if prior_odo_rec ^= null_key
	then go to s_odo_next;

	fixed_common.odo_info = cm_key;
	prior_odo_rec = cm_key;
	go to odo_obj;

s_odo_next:
	rcm_key = prior_odo_rec;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	com2_ptr = cm_ptr;
	odo_rec.next = cm_key;

	call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	prior_odo_rec = cm_key;

/* create obj_rec for odo_rec */

odo_obj:
	com2_ptr = addr (cobol_wkbuf2_tbl.wkbuf2);
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;
	obj_rec.qual = null_key;

	if record.type = 8
	then do;					/* odo name exists */

		obj_rec.size = user_word.word_size;
		substr (obj_rec.name, 1, user_word.word_size) = substr (user_word.word, 1, user_word.word_size);
	     end;
	else do;					/* odo name missing or in error - use a dummy */

		obj_rec.size = 6;
		obj_rec.name = "FILLER";
	     end;

	obj_rec.line = record.line;
	obj_rec.column = record.column;
	cm_ptr = com2_ptr;
	cm_size = obj_rec_constant + obj_rec.size;

	call cobol_vdwf_sput (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

	prior_obj_rec = cm_key;
	prior_qual_rec = null_key;			/* store obj_rec record no into odo_rec */
	rcm_key = prior_odo_rec;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	com2_ptr = cm_ptr;
	odo_rec.descr = cm_key;

	call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	goto retrn;				/* store_odo_do_rec */

actlbl (88):					/*action(52):*/
	vector_map.occurs_do = "1"b;
	goto retrn;				/* key_ascending*/

actlbl (89):					/*action(53):*/
						/*POST-RELEASE CHANGE: 1 line deleted*/
	vector_map.key_a = "1"b;
	asc_des = 1;
	go to retrn;				/* key descending */

actlbl (90):					/*action(54):*/
						/*POST-RELEASE CHANGE: 1 line deleted*/
	vector_map.key_d = "1"b;
	asc_des = 2;
	go to retrn;				/* store first key dn into common */

actlbl (91):					/*action(55):*/
	keycount = keycount + 1;
	prior_qual_rec = null_key;

	skey_ptr = addr (cobol_wkbuf2_tbl.wkbuf2);
	skey_rec.next = null_key;
	skey_rec.qual = null_key;
	skey_rec.keyno = keycount;
	skey_rec.asc_des = asc_des;
	skey_rec.ref_line = user_word.line;
	skey_rec.ref_column = user_word.column;
	skey_rec.info = "00000000"b;
	skey_rec.size = user_word.word_size;

	substr (skey_rec.name, 1, user_word.word_size) = substr (user_word.word, 1, user_word.word_size);

	cm_ptr = skey_ptr;
	cm_size = skey_rec_constant + skey_rec.size;

	call cobol_vdwf_sput (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

/* store key dn record no in common into data_name item */

	if prior_skey_rec ^= null_key
	then go to s_next_key;

	rcm_key = prior_occ_key;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	com2_ptr = cm_ptr;
	occ_key.first_key = cm_key;

	call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	prior_skey_rec = cm_key;
	goto retrn;

s_next_key:
	rcm_key = prior_skey_rec;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	skey_ptr = cm_ptr;
	skey_rec.next = cm_key;
	prior_skey_rec = cm_key;
	goto retrn;

/* set_indexed_by_bit */

actlbl (92):					/*action(56):*/
	vector_map.indexed_by = "1"b;

	go to retrn;				/* generate_indexname_item */

actlbl (93):					/*action(57):*/
	index_ct = index_ct + 1;

	if index_ct = 1
	then do;
		counter2 = counter2 + 1;
		occurs.level.indexedno (odim) = counter2;

		ptr4 = addr (cobol_wkbuf2_tbl);
		ptr4 -> cntbuf2 = 0;

		indexname.type = 10;
		indexname.level = 99;
		indexname.index_no = counter2;
		indexname.min = occurs.level.min (odim);
		indexname.max = occurs.level.max (odim);
	     end;

	indexname.line = user_word.line;
	indexname.def_line = user_word.line;
	indexname.column = user_word.column;
	indexname.name_size = user_word.word_size;

	substr (indexname.name, 1, user_word.word_size) = substr (user_word.word, 1, user_word.word_size);

	indexname.size = in_constant + indexname.name_size;
						/* write index name item type=10 */
	rnt_size = indexname.size;

	call cobol_vdwf_sput (cobol_ntfp, fstatus, w2_ptr, rnt_size, w_key);

	ixix = ixix + 1;				/*save key for later retrieval to set struc_length*/

	if ixix > 50
	then do;
		tf = 196;
		call diag;
		goto pre_end;
	     end;

	ix_ino (ixix) = counter2;
	ix_key (ixix) = w_key;
	go to retrn;

/* rws_bit */

actlbl (94):					/*action(58):*/
	substr (section_ind, 6, 1) = "1"b;

	fixed_common.report = "1"b;
	go to retrn;				/*pd_bit */

actlbl (95):					/*action(59):*/
	substr (section_ind, 7, 1) = "1"b;

	go to retrn;				/* eop_bit */

actlbl (96):					/*action(60):*/
	substr (section_ind, 8, 1) = "1"b;

	go to retrn;				/*set pre_end_sw for interpreter termination */

actlbl (97):					/*action(61):*/
	go to pre_end;

/*write to name table if unwritten item exists*/

actlbl (98):					/*action(62):*/
	if bnw ^= 0
	then do;
		rnt_size = data_name.size;

		call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);

		bnw = 0;
	     end;
	go to retrn;				/* initialization */

actlbl (99):					/*action(3):*/
						/*generate TALLY*/
	ptr4 = addr (cobol_wkbuf1_tbl);
	ptr4 -> cntbuf = 0;
	dn_ptr = addr (cobol_wkbuf1_tbl);

	data_name.type = 9;
	data_name.level = 77;
	data_name.item_length = 5;			/* 5 is arbitrarily chosen */
	data_name.places_left = 5;
	data_name.name_size = 13;
	data_name.size = dn_constant + 13;

	substr (data_name.name, 1, data_name.name_size) = "SYSTEM-STATUS";

	addr (data_name.file_section) -> bit72 =
	     "010000100100000001000000000100000000000000000000000010000000000000000100"b;

/*working-storage section,level 77,elementary,numeric,display,integer*/
/*not user writable*/

	rnt_size = data_name.size;

	call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);
						/*write SYSTEM-STATUS*/

	fixed_common.first_dd_item = w_key;		/*for ddalloc file positioning*/

	substr (data_name.name, 1, data_name.name_size) = "TALLY";

	data_name.name_size = 5;
	data_name.not_user_writable = "0"b;
	data_name.size = dn_constant + 5;
	rnt_size = data_name.size;
	bnw = 1;					/*buf needs write*/
	goto retrn;


actlbl (100):
	vector_map.ascii_packed_dec_h = "1"b;
	goto retrn;

pre_end:
	pre_end_sw = "1"b;
	go to retrn;

comp_end:
	comp_end_sw = "1"b;

retrn:
	return;

dcl	an		fixed bin;
dcl	tf		fixed bin;
dcl	bit9		bit (9);
dcl	bit32		bit (32);
dcl	bit40		bit (40);
dcl	fstatus		bit (32);			/*io return code*/
dcl	null_func		ptr internal static init (null ());
dcl	null_key		char (5) internal static init ("00000");
dcl	asc_des		fixed bin internal static;

declare	(addr, divide, mod, substr, unspec, fixed)
			builtin;


%include cobol_spec_constants;
%include cobol_special_dcls;
%include cobol_ext_;
/* %include cobol_segdata_ddsyn;  */
%include cobol_ext_ddsyn;
dcl	bit32_1		bit (32);			/*work field for usage bits testing*/
dcl	thirty_two_zeros	bit (32) internal static init ("00000000000000000000000000000000"b);
dcl	non_display_bits_mask
			bit (32) init ("00000110000000000000111111100000"b) internal static;
dcl	pic_suff_bits_mask	bit (32) internal static init ("00000110000000000000000011100000"b);
						/*masks out all but picture_sufficient usage bits*/
dcl	sv_ptr_auto	ptr;
dcl	1 shared_var	based (sv_ptr_auto),
%include cobol_shared_var;
%include cobol_non_static;
%include cobol_type9;
%include cobol_occurs;
%include cobol_obj_rec;
%include cobol_odo_rec;
%include cobol_occ_key_rec;
%include cobol_skey_rec;
%include cobol_fixed_common;
%include cobol_fd_token;
%include cobol_file_table;
     end cobol_ddact1;




		    cobol_ddact2.pl1                05/24/89  1044.4rew 05/24/89  0832.8      512631



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_ddact2.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 11/24/81 by FCH, [5.1-1], RECORD CONTAINS may not contain ZERO, BUG520(phx11821) */
/* Modified on 07/22/81 by FCH, [4.4-1], set fixed_common.cd, BUG468 */
/* Modified on 08/11/79 by FCH, [4.0-1], debug statement added */
/* Modified on 04/14/78 by FCH, [3.0-2], fig con in level 88 item */
/* Modified on 04/12/78 by FCH, [3.0-1], include file change */
/* Modified since version 3.0 */


/* format: style3 */
cobol_ddact2:
     proc (an);

	sv_ptr_auto = cobol_sv_ptr;
	go to actlbl (an);

/* store condition names */

actlbl (150):					/*action(63):*/
	conditioname.name_size = user_word.word_size;
	substr (conditioname.name, 1, conditioname.name_size) = substr (user_word.word, 1, user_word.word_size);
	conditioname.size = conditioname.size + conditioname.name_size;

	conditioname.size = conditioname.size + mod (-conditioname.size, 4);

	save_ptr = ptr1;
	ptr1 = addr (w2_ptr -> any_item (conditioname.size + 1));
	conditioname.numlits = 0;
	save_ptr1 = null_func;			/*for compare_values*/
	go to retrn;				/* store numeric value for 88 entry */

actlbl (151):					/*action(64):*/
	conditioname.numlits = conditioname.numlits + 1;
	call store_nv;

store_nv:
     proc;

	numinit.initype.numeric = "1"b;
	if numeric_lit.rtdp = 0
	then numinit.info.integer = "1"b;
	numinit.info.floating = numeric_lit.info.floating;
	numinit.info.filler = numeric_lit.info.filler;
	numinit.expsign = numeric_lit.exp_sign;
	numinit.explaces = numeric_lit.exp_places;
	numinit.sign = numeric_lit.sign;
	numinit.ltdp = numeric_lit.ltdp;
	numinit.rtdp = numeric_lit.rtdp;
	numinit.length = numeric_lit.length;
	niv = nl;
	numinit.literal = numeric_lit.literal;
     end store_nv;


	conditioname.size = conditioname.size + niv_constant + niv;

	conditioname.size = conditioname.size + mod (-conditioname.size, 4);

	if save_ptr1 ^= null_func
	then do;
		numinit.initype.thru2 = "1"b;		/*numinit.initype fits alpha,figcon also*/
		tf = cobol_compare_values (save_ptr1, ptr1, data_name.item_length, ptr_to_char_tbl);

		if tf > 0
		then call diag;

		save_ptr1 = null_func;
	     end;
	go to retrn;				/* store non_numeric value for 88 entry */

actlbl (152):					/*action(65):*/
	conditioname.numlits = conditioname.numlits + 1;
	call store_av;


store_av:
     proc;
	alphainit.initype.non_numeric = "1"b;
	alphainit.info.bit_string = alphanum_lit.info.bit_string;
	alphainit.length = alphanum_lit.length;
	aiv = al;
	alphainit.string = alphanum_lit.string;
     end store_av;


	conditioname.size = conditioname.size + aiv_constant + aiv;

	conditioname.size = conditioname.size + mod (-conditioname.size, 4);

	if save_ptr1 ^= null_func
	then do;
		numinit.initype.thru2 = "1"b;		/*numinit.initype fits alpha,figcon also*/
		tf = cobol_compare_values (save_ptr1, ptr1, data_name.item_length, ptr_to_char_tbl);

		if tf > 0
		then call diag;

		save_ptr1 = null_func;
	     end;
	go to retrn;				/* store fig_con value for 88 entry */

actlbl (153):					/*action(66):*/
	conditioname.numlits = conditioname.numlits + 1;
	call store_fcv;


store_fcv:
     proc;
	alphainit.initype.fig_con = "1"b;
	alphainit.info.fig_con_index = substr (unspec (rw.jump_index), 30, 7);

	alphainit.length = 0;
     end store_fcv;



/* [3.0-2] */
/*[]*/
	if alphainit.info.fig_con_index = "0000001"b	/*fig zero*/
						/*[]*/
	then do;
		if vector_map.numeric		/*[]*/
		then do;
			conditioname.size = conditioname.size + niv_constant + 1;
						/*[]*/
			numinit.initype.numeric = "1"b;
						/*[]*/
			numinit.length = 1;		/*[]*/
		     end;				/*[]*/
		else do;
			conditioname.size = conditioname.size + aiv_constant + 1;
						/*[]*/
			alphainit.initype.non_numeric = "1"b;
						/*[]*/
			alphainit.length = 1;	/*[]*/
		     end;				/*[]*/
						/*[]*/
	     end;					/* [3.0-2] */
						/*PIC_VAL_COMP wmay replace fig con extension by numeric*/
	else conditioname.size = conditioname.size + aiv_constant;

	conditioname.size = conditioname.size + mod (-conditioname.size, 4);

	if save_ptr1 ^= null_func
	then do;
		numinit.initype.thru2 = "1"b;		/*numinit.initype fits alpha,figcon also*/
		tf = cobol_compare_values (save_ptr1, ptr1, data_name.item_length, ptr_to_char_tbl);

		if tf > 0
		then call diag;

		save_ptr1 = null_func;
	     end;

	go to retrn;				/* set ptr and first of thru value for 88 entry */

actlbl (154):					/*action(67):*/
	numinit.initype.thru1 = "1"b;
	save_ptr1 = ptr1;
	ptr1 = addr (w2_ptr -> any_item (conditioname.size + 1));
	go to retrn;				/* set pre for condition valuee in 88 entry */

actlbl (155):					/*action(68):*/
	ptr1 = addr (w2_ptr -> any_item (conditioname.size + 1));
	go to retrn;				/*object of ODO is TALLY*/

actlbl (156):					/*action(69):*/
						/*not implemented*/
	go to retrn;				/* write 88 entry type = 11 */

actlbl (157):					/*action(70):*/
	if bnw ^= 0
	then do;

/*non - level - 88 item to be written before first level - 88 item is written*/

		rnt_size = data_name.size;

		call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);

		bnw = 0;

		if data_name.level = 1
		then if data_name.exp_redefining
		     then rdf_01_sav = w_key;
		     else save_01 = w_key;
		save_wkey = w_key;

	     end;

	rnt_size = conditioname.size;

	call cobol_vdwf_sput (cobol_ntfp, fstatus, w2_ptr, rnt_size, w_key);

	ptr1 = save_ptr;
	save_switch_88 = "1"b;
	no_of_88s = no_of_88s + 1;
	go to retrn;				/* store subject of renames */

actlbl (158):					/*action(71):*/
	rnm_obj12 = 0;
	com2_ptr = addr (cobol_wkbuf2_tbl.wkbuf2);
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;
	rename_rec.lineno_66 = user_word.line;

	if save_line_for66 = 0
	then do;
		if h = 0
		then do;
			if rdf_01_sav ^= null_key
			then rnt_key = rdf_01_sav;
			else do;
				if save_01 = null_key
				then do;

					rnt_size = data_name.size;
					call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);
					bnw = 0;

					if data_name.exp_redefining
					then rdf_01_sav = w_key;
					else do;
						save_01 = w_key;
						rdf_01_sav = null_key;
					     end;

					save_wkey = w_key;
				     end;
				rnt_key = save_01;
			     end;
		     end;

		else rnt_key = cobol_htbl.nt_rec (1);


		call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

		rnt_ptr -> data_name.rnm_01 = "1"b;
		save_01_for66 = rnt_key;
		save_line_for66 = rnt_ptr -> data_name.line;

		call cobol_vdwf_dput (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	     end;

	rename_rec.rec_no_66 = save_01_for66;
	rename_rec.lineno_01 = save_line_for66;
	rename_rec.size = user_word.word_size;

	substr (rename_rec.name, 1, rename_rec.size) = substr (user_word.word, 1, user_word.word_size);

	rename_rec.next = null_key;
	rename_rec.obj1 = null_key;
	rename_rec.obj2 = null_key;
	go to retrn;				/* store object1 of rename */

actlbl (159):					/*action(72):*/
	if rnm_obj12 = 0
	then do;
		cm_ptr = com2_ptr;
		cm_size = rename_rec_constant + rename_rec.size;

		call cobol_vdwf_sput (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

		if prior_rename_rec = null_key
		then fixed_common.rename_info = cm_key;
		else do;
			rcm_key = prior_rename_rec;

			call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

			com2_ptr = cm_ptr;
			rename_rec.next = cm_key;

			call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

		     end;

		prior_rename_rec = cm_key;
	     end;

	prior_qual_rec = null_key;
	rnm_obj12 = rnm_obj12 + 1;
	com2_ptr = addr (cobol_wkbuf2_tbl.wkbuf2);
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;
	obj_rec.qual = null_key;
	obj_rec.size = user_word.word_size;

	substr (obj_rec.name, 1, obj_rec.size) = substr (user_word.word, 1, user_word.word_size);

	obj_rec.line = user_word.line;
	obj_rec.column = user_word.column;
	cm_ptr = com2_ptr;
	cm_size = obj_rec_constant + obj_rec.size;

	call cobol_vdwf_sput (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

/* store object 1 into rename_rec*/
	prior_obj_rec = cm_key;
	rcm_key = prior_rename_rec;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	com2_ptr = cm_ptr;

	if rnm_obj12 = 1
	then rename_rec.obj1 = cm_key;
	else rename_rec.obj2 = cm_key;

	call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);
	go to retrn;				/* store qualifier for rename adn occ object */

actlbl (160):					/*action(73):*/
	call qualifier;


qualifier:
     proc;
	com2_ptr = addr (cobol_wkbuf2_tbl.wkbuf2);
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;
	qual_rec.line = user_word.line;
	qual_rec.column = user_word.column;
	qual_rec.size = user_word.word_size;

	substr (qual_rec.name, 1, qual_rec.size) = substr (user_word.word, 1, user_word.word_size);

	qual_rec.next = null_key;
	cm_ptr = com2_ptr;
	cm_size = qual_rec_constant + qual_rec.size;

	call cobol_vdwf_sput (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

     end qualifier;


	if prior_qual_rec ^= null_key
	then go to s_qual;

	rcm_key = prior_obj_rec;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	com2_ptr = cm_ptr;
	obj_rec.qual = cm_key;
	prior_qual_rec = cm_key;

	call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	go to retrn;

s_qual:
	call store_qualifier;
	go to retrn;


store_qualifier:
     proc;
	rcm_key = prior_qual_rec;
	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);
	com2_ptr = cm_ptr;
	qual_rec.next = cm_key;
	prior_qual_rec = cm_key;

	call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

     end store_qualifier;




actlbl (161):					/*action(74):*/
	next_level = 1;
	go to retrn;

/* redefines processing */

actlbl (162):					/*action(75):*/
	if user_word.word = "FILLER"
	then do;
		tf = 180;
		call diag;
		go to retrn;
	     end;

	vector_map.s_of_rdf = "1"b;
	vector_map.exp_redefining = "1"b;

	if save_level = 77
	then do;
		rdf_level = 1;

		if data_name.level ^= 77
		then call enter_incorrect (32);

		else if ^data_name.exp_redefining
		then do;
			if user_word.word ^= data_name.name
			then call enter_correct_err (220);

			else do;

/*names match ... level 77*/

				data_name.o_of_rdf = "1"b;
				call enter_correct;
			     end;
		     end;

		else do;

/*dataname is s_of_rdf and levels match at 77*/

			if user_word.word ^= rdf_tbl (1)
			then call TF (220);		/*names match*/
			else call end75;
		     end;

		go to retrn;

	     end;

	rdf_level = next_level;

	if next_level = data_name.level
	then do;

		offset_ct = save_offsets (next_level);

		if ^data_name.exp_redefining
		then do;
			if user_word.word = data_name.name
			then do;

				if fixed_common.comp_level < "3"
				then do;
					if data_name.s_of_rdf
					then do;
						tf = 47;
						call diag_level;
					     end;

					if data_name.occurs_ptr ^= 0
					then do;
						tf = 48;
						call diag_level;
					     end;
				     end;
				data_name.o_of_rdf = "1"b;
				call enter_correct;
			     end;

/*levels match but not names*/

			else call enter_correct_err (220);
		     end;

		else do;

			if rdf_tbl (rdf_level) = user_word.word
			then call end75;
			else call TF (220);

		     end;
	     end;

	else if next_level > data_name.level
	then call enter_incorrect (32);

	else do;					/*next_level less than data_name.level*/

		offset_ct = save_offsets (next_level);

/*at this moment, cobol_htbl has been popped to last item with level
	less than next_level; however, the
	old items are still in there. If h indexes parent level item
	of next_level item, then h + 1 indexes either an item of level
	equal to next_level or greater than it. If equal, the cobol_htbl item
	represents object of redefines, or last redefinition of object
	at that level; if greater, the redefinition is
	in error.*/

		fh = h + 1;

		if cobol_htbl.level (fh) ^= next_level	/*level is greater than next_level*/
		then call enter_incorrect (32);

/*levels match*/

		else if ^cobol_htbl.exp_redefining (fh)
		then do;
			rnt_key = cobol_htbl.nt_rec (fh);

			call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

			save_ptr = dn_ptr;
			dn_ptr = rnt_ptr;

			if user_word.word = data_name.name
			then do;
				data_name.o_of_rdf = "1"b;
				rdf_tbl (next_level) = data_name.name;


				if data_name.exp_occurs
				then do;
					tf = 54;
					call diag;
				     end;

				if data_name.do_rec ^= null_key
				then do;
					tf = 55;
					call diag;
				     end;

				call cobol_vdwf_dput (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

				dn_ptr = save_ptr;

				call end75;
			     end;

/*names don't match*/

			else do;
				dn_ptr = save_ptr;
				call enter_correct_err (220);
			     end;

		     end;				/*cobol_htbl.exp_redefining(fh) is set*/

		else if user_word.word = rdf_tbl (next_level)
		then call end75;
		else call TF (220);

	     end;
	go to retrn;

enter_incorrect:
     proc (num);

declare	num		fixed bin;

	rdf_tbl (next_level) = user_word.word;

	call TF (num);

     end;

enter_correct_err:
     proc (num);

declare	num		fixed bin;

	tf = num;
	call diag;

	call enter_correct;

     end;

enter_correct:
     proc;

	rdf_tbl (next_level) = data_name.name;

	if data_name.exp_occurs
	then do;
		tf = 54;
		call diag;
	     end;

	if data_name.do_rec ^= null_key
	then do;
		tf = 55;
		call diag;
	     end;

	call end75;

     end;

TF:
     proc (num);

declare	num		fixed bin;

	tf = num;
	call diag;

	call end75;

     end;

end75:
     proc;

	if bnw ^= 0
	then do;

/*write completed (previous) dataname token*/

		rnt_ptr = dn_ptr;
		nt_size = data_name.size;

		call cobol_vdwf_sput (cobol_ntfp, fstatus, rnt_ptr, nt_size, w_key);

		if data_name.non_elementary
		then cobol_htbl.nt_rec (h) = w_key;

		if data_name.level = 1
		then do;
			if data_name.exp_redefining
			then rdf_01_sav = w_key;

			else do;
				save_01 = w_key;
				rdf_01_sav = null_key;
			     end;
		     end;
	     end;

	else do;

/* item was written already -  - but o_of_rdf description bit has been updated since*/

		if data_name.o_of_rdf
		then do;

			call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, save_wkey);
			call cobol_vdwf_dput (cobol_ntfp, fstatus, dn_ptr, rnt_size, save_wkey);

		     end;

	     end;

	ptr4 = addr (cobol_wkbuf1_tbl);
	ptr4 -> cntbuf = 0;

	data_name.type = 9;
	data_name.size = dn_constant;
	data_name.line = save_line;
	data_name.def_line = save_line;
	data_name.column = save_column;
	data_name.level = save_level;
	data_name.do_rec = null_key;

	if file_number ^= 0
	then data_name.file_num = file_number;
	else data_name.file_num = cdno;

	data_name.name_size = dnl;

	data_name.name = substr (save_dname, 1, data_name.name_size);

	data_name.size = dn_constant + dnl;

	data_name.size = data_name.size + mod (-data_name.size, 4);

	ptr1 = addr (dn_ptr -> any_item (data_name.size + 1));

	bnw = 1;					/*buf needs write*/

     end;

diag:
     proc;
	rn = 3;
	go to diag_start;
diag_level:
     entry;
	rn = 9;
diag_start:
	message_ptr = addr (message_area);
	message.size = 32;
	message.line = record.line;
	message.column = record.column;
	message.type = 5;
	message.run3 = rn;
	message.info.para = "0"b;
	message.info.rep = "0"b;
	message.info.fillerx = "000000"b;
	message.length = 0;
	message.number = tf;

	call cobol_c_list (message_ptr);

     end;



actlbl (163):					/*action(76):*/
	data_name.size = data_name.size + max_poss_extensions;
						/*maximum possible size*/
						/* save 66 entry record no in rename_rec */

	if prior_rename_rec ^= null_key
	then do;
		rcm_key = prior_rename_rec;

		call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

		com2_ptr = cm_ptr;
	     end;
	go to retrn;

/* set file section indicators */

actlbl (166):					/*action(79):*/
	substr (section_ind, 1, 1) = "1"b;
	substr (vector_part, 1, 6) = "100000"b;
	ll01 = "0"b;
	ll77 = "0"b;
	file_number = 0;
	name_string_index = 1;
	nsa_index = 0;
	go to retrn;				/* end of file section processing */

actlbl (167):					/*action(80):*/
	file_number = 0;

/* check data record names and label record names are defined */

	if nsa_index ^= 0
	then do nsa_work_index = 1 to nsa_index by 1;

		if ^nsa_cancelled (nsa_work_index)
		then do;

			if nsa_lbl_rec (nsa_work_index)
			then tf = 192;
			else tf = 193;

			call diag;
		     end;

	     end;

/* scan and report undefined files */
	go to retrn;				/* initialize current fd token entry */

actlbl (168):					/*action(81):*/
	if fixed_common.comp_level < "5"
	then if record.column < 8 | record.column > 11
	     then do;
		     tf = 133;
		     call diag_level;
		end;

	ll01 = "0"b;
	fd_clauses = "000000000000000000000000000000000000"b;
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;
	fd_token.def_line = record.line;
	fd_token.line = record.line;
	fd_token.column = record.column;
	fd_token.size = fd_constant;

	if rw.key = 219
	then fd_token.type = 12;
	if rw.key = 243
	then fd_token.type = 16;
	if rw.key = 242
	then fd_token.type = 15;

	nsa_index_last_fd = nsa_index + 1;
	save_block_desc = 0;
	save_block_min = 0;
	save_block_max = 0;
	save_record_min = 0;
	save_record_max = 0;
	go to retrn;				/*code - set bcd - 1400*/

actlbl (173):					/*action(86):*/
						/*label records c120*/
	if file_number ^= 0
	then file_table.label_format = 2;
	go to retrn;

actlbl (174):					/*action(87):*/
						/*label records c80*/
	if file_number ^= 0
	then file_table.label_format = 3;
	go to retrn;

actlbl (175):					/*action(88):*/
						/*label records e80*/
	if file_number ^= 0
	then file_table.label_format = 4;
	go to retrn;

actlbl (176):					/*action(89):*/
						/*code - set ascii*/
	go to retrn;				/* get file number from file table in common */

actlbl (181):					/*action(94):*/
	fd_token.file_no = file_table.file_no;
	file_number = fd_token.file_no;

	if fd_token.type = 16
	then file_table.sort_file = "1"b;
	else file_table.sort_file = "0"b;

	file_table.rec_do_info = null_key;
	go to retrn;				/*end of Communication Section*/

actlbl (177):					/*action(90):*/
	cdno = 0;
	go to retrn;				/*level 1 in Communication Section*/

actlbl (178):					/*action(91):*/
	data_name.file_num = cdno;
	data_name.s_of_rdf = "1"b;
	data_name.exp_redefining = "1"b;
	go to retrn;

/* store file name */

actlbl (182):					/*action(95):*/
						/*[4.0-1]*/
	call cobol_ddsyntax$init_file_tab;

	fd_token.name_size = user_word.word_size;
	substr (fd_token.name, 1, fd_token.name_size) = substr (user_word.word, 1, user_word.word_size);
	fd_token.size = fd_token.size + fd_token.name_size;

	fd_token.size = fd_token.size + mod (-fd_token.size, 4);

	ptr2 = addr (w2_ptr -> any_item (fd_token.size + 1));
	go to retrn;				/*record contains depending on dataname*/

actlbl (183):					/*action(96):*/
	if file_number ^= 0
	then do;
		file_table.rec_do = "1"b;

		if file_table.fixed_recs
		then do;
			tf = 189;
			call diag;
		     end;
	     end;

	if bnw ^= 0
	then do;
		rnt_size = data_name.size;

		call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);

		bnw = 0;
	     end;

	fkey_ptr = addr (cobol_wkbuf1_tbl.wkbuf1);
	file_key.next = null_key;
	file_key.next_alt = null_key;
	file_key.qual = null_key;
	addr (file_key.info) -> BIT8 = "0"b;		/* [3.0-1] */
	file_key.file_no = file_number;
	file_key.key_type = 6;
	file_key.line = user_word.line;
	file_key.column = user_word.column;
	file_key.temp_seg = 0;
	file_key.temp_offset = 0;
	file_key.name_size = user_word.word_size;

	substr (file_key.name, 1, file_key.name_size) = substr (user_word.word, 1, user_word.word_size);

	cm_size = fkey_constant + file_key.name_size;

	call cobol_vdwf_sput (cobol_cmfp, fstatus, fkey_ptr, cm_size, cm_key);

	if file_number ^= 0
	then if file_table.rec_do_info = null_key
	     then file_table.rec_do_info = cm_key;

	if fixed_common.file_keys = null_key
	then fixed_common.file_keys = cm_key;
	else do;
		rcm_key = fixed_common.last_file_key;

		call cobol_vdwf_dget (cobol_cmfp, fstatus, fkey_ptr, cm_size, rcm_key);

		file_key.next = cm_key;

		call cobol_vdwf_dput (cobol_cmfp, fstatus, fkey_ptr, cm_size, rcm_key);
	     end;
	fixed_common.last_file_key = cm_key;
	go to retrn;				/* end of fd processing */

actlbl (186):					/*action(99):*/
						/* store block record linage info into file table in common */
	if fd_token.file_no ^= 0
	then do;

		file_table.block_desc = save_block_desc;
		file_table.block_min = save_block_min;
		file_table.block_max = save_block_max;
		file_table.rec_min = save_record_min;
		file_table.rec_max = save_record_max;	/* generate LINAGE - COUNTER */
		if fd_ind.linage_is
		then do;
			cm_size = linage_rec_constant + 40 * linage_rec.name_count;

			call cobol_vdwf_sput (cobol_cmfp, fstatus, linage_ptr, cm_size, cm_key);

			file_table.linage_info = cm_key;
			file_table.linage = "1"b;

			if bnw ^= 0
			then do;
				rnt_size = data_name.size;

				call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);

			     end;

			ptr4 = addr (cobol_wkbuf1_tbl);
			ptr4 -> cntbuf = 0;
			data_name.size = dn_constant + 14;
			data_name.line = fd_token.line;
			data_name.column = fd_token.column;
			data_name.type = 9;
			data_name.level = 1;
			data_name.item_length = 5;	/* 5 is arbitrarily chosen */
			data_name.places_left = 5;
			data_name.places_right = 0;
			data_name.initial_ptr = 0;
			data_name.edit_ptr = 0;
			data_name.occurs_ptr = 0;
			data_name.file_num = file_number;
			data_name.offset = 0;
			data_name.name_size = 14;
			substr (data_name.name, 1, data_name.name_size) = "LINAGE-COUNTER";
			ptr8 = addr (data_name.file_section);

			ptr8 -> bit72 = "100000010100000001000000000100000000000000000000000000000000000000100000"b;

			bnw = 1;

		     end;				/*first write fd token*/
		rnt_size = fd_token.size;

		call cobol_vdwf_sput (cobol_ntfp, fstatus, w2_ptr, rnt_size, w_key);

		save_fd = w_key;
	     end;

	if fd_ind.report_is = "1"b & fd_ind.data_record = "1"b
	then do;
		tf = 66;
		call diag;
	     end;

	if fd_ind.report_is = "1"b & fd_ind.linage_is = "1"b
	then do;
		tf = 87;
		call diag;
	     end;

	go to retrn;				/* store file no into data record entry */
						/* check user label names and data record names if specified */

actlbl (187):					/*action(100):*/
	call cobol_vdwf_dget (cobol_ntfp, fstatus, save_w2, rnt_size, save_fd);

	data_name.file_num = save_w2 -> fd_token.file_no; /* set fno */
						/* check user label names */
	if fd_ind.label_type.user_spec ^= "1"b
	then go to na100;				/* check data record names */
na100:
	if nsa_index < nsa_index_last_fd
	then go to err100_191;

	do nsa_work_index = nsa_index_last_fd to nsa_index by 1;

	     if nsa_name_length (nsa_work_index) = dnl
	     then do;

		     if substr (name_string, nsa_name_index (nsa_work_index), dnl) = save_dname
		     then do;
			     nsa_cancelled (nsa_work_index) = "1"b;
			     data_name.label_record = nsa_lbl_rec (nsa_work_index);
			     go to endg100;
			end;

		end;
	end;
endg100:
	if nsa_work_index > nsa_index
	then do;
err100_191:					/*tf = 191;
			call diag;*/
	     end;
nna100:						/* store data record names */
	go to retrn;				/* set linage defaults for fd_token */

actlbl (188):					/*action(101):*/
	if fd_ind.linage_type.top = "0"b
	then do;
		linage_rec.top = 0;
		linage_rec.top_int = 0;
		linage_rec.top_name = null_key;
	     end;
	if fd_ind.linage_type.bottom = "0"b
	then do;
		linage_rec.bottom = 0;
		linage_rec.bottom_int = 0;
		linage_rec.bottom_name = null_key;
	     end;

	if fd_ind.linage_type.footing = "0"b
	then do;
		linage_rec.footing = 0;
		linage_rec.footing_int = 0;
		linage_rec.footing_name = null_key;
	     end;

	go to retrn;

/* Store linage footing info */

actlbl (189):					/*action(102):*/
	fd_ind.linage_type.footing = "1"b;
	linage_rec.footing = linage_rec.name_count + 1;
	linage_name_rec.desc = 2;

	call write_linage_name_rec;

	linage_rec.footing_name = cm_key;
	go to retrn;				/* Store integer for linage footing */

actlbl (190):					/*action(103):*/
	fd_ind.linage_type.footing = "1"b;
	linage_rec.footing = 5;			/*[5.1-1]*/
	if record.type = 2
	then linage_rec.footing_int = fixed (numeric_lit.literal);
	else linage_rec.footing_int = 0;
	go to retrn;

/* set fd recording mode indicator */

actlbl (191):					/*action(104):*/
	fd_ind.recording_mode = "1"b;
	go to retrn;				/* set fd recording mode index */

actlbl (192):					/*action(105):*/
						/* not done */
	go to retrn;				/* set block contain indicator */

actlbl (193):					/*action(106):*/
	fd_ind.block_contain = "1"b;
	go to retrn;				/* set record contain indicator */

actlbl (194):					/*action(107):*/
	fd_ind.record_contain = "1"b;
	go to retrn;				/* set label record indicator */

actlbl (195):					/*action(108):*/
	fd_ind.label_record = "1"b;
	go to retrn;				/* set value of indicator */

actlbl (196):					/*action(109):*/
	fd_ind.value_of = "1"b;
	go to retrn;				/* set data record indicator */

actlbl (197):					/*action(110):*/
	fd_ind.data_record = "1"b;
	go to retrn;				/* set report is indicator */

actlbl (198):					/*action(111):*/
	fd_ind.report_is = "1"b;
	go to retrn;

/* set linage is indicator */

actlbl (199):					/*action(112):*/
	if bnw ^= 0
	then do;
		rnt_size = data_name.size;

		call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);

		bnw = 0;
	     end;

	fd_ind.linage_is = "1"b;
	com2_ptr = addr (cobol_wkbuf1_tbl.wkbuf1);	/*ads linage_name_recs*/

	linage_ptr = addr (com2_ptr -> any_item (101));	/*ads linage rec -  -  - must be word aligned on 6180*/
	linage_rec.body = 0;
	linage_rec.top = 0;
	linage_rec.bottom = 0;
	linage_rec.footing = 0;
	linage_rec.name_count = 0;

	save_block_min = 0;
	save_block_max = 0;
	save_record_min = 0;
	save_record_max = 0;
	go to retrn;

/* set min_size for block */

actlbl (201):					/*action(114):*/
						/*[5.1-1]*/
	if record.type = 2
	then save_block_max = fixed (numeric_lit.literal);
	else save_block_max = 0;
	save_block_min = 0;
	go to retrn;				/* set record bit for block */

actlbl (202):					/*action(115):*/
	save_block_desc = 2;
	go to retrn;				/* set character bit for block */

actlbl (203):					/*action(116):*/
	save_block_desc = 1;
	go to retrn;

/* set max size for block */

actlbl (204):					/*action(117):*/
	save_block_min = save_block_max;		/*[5.1-1]*/
	if record.type = 2
	then save_block_max = fixed (numeric_lit.literal);
	else save_block_max = 0;

	if save_block_min >= save_block_max
	then do;
		tf = 211;
		call diag;
	     end;
	go to retrn;				/* Store data name for linage bottom */

actlbl (205):					/*action(118):*/
	fd_ind.linage_type.bottom = "1"b;
	linage_rec.bottom = linage_rec.name_count + 1;
	linage_name_rec.desc = 4;

	call write_linage_name_rec;

	linage_rec.bottom_name = cm_key;
	go to retrn;				/* Store integer for linage bottom */

actlbl (206):					/*action(119):*/
	fd_ind.linage_type.bottom = "1"b;
	linage_rec.bottom = 5;			/*[5.1-1]*/
	if record.type = 2
	then linage_rec.bottom_int = fixed (numeric_lit.literal);
	else linage_rec.bottom_int = 0;
	go to retrn;

/* store min size for record contain */

actlbl (207):					/*action(120):*/
						/*[5.1-1]*/
	if record.type = 2
	then save_record_max = fixed (numeric_lit.literal);
	else save_record_max = 0;

	if save_record_max > 262143
	then do;
		tf = 212;
		call diag;
	     end;

	save_record_min = 0;
	go to retrn;

/* Set linage top data name */

actlbl (208):					/*action(121):*/
	fd_ind.linage_type.top = "1"b;
	linage_rec.top = linage_rec.name_count + 1;
	linage_name_rec.desc = 3;

	call write_linage_name_rec;

	linage_rec.top_name = cm_key;
	go to retrn;

/* store max size for record contain */

actlbl (209):					/*action(122):*/
	save_record_min = save_record_max;		/*[5.1-1]*/
	if record.type = 2
	then save_record_max = fixed (numeric_lit.literal);
	else save_record_max = 0;

	if save_record_max > 262143
	then do;
		tf = 212;
		call diag;
	     end;
	go to retrn;				/* set label record omitted */

actlbl (210):					/*action(123):*/
	fd_ind.label_type.omitted = "1"b;

	if file_number ^= 0
	then file_table.label_format = 5;
	go to retrn;				/* set label record standard */

actlbl (211):					/*action(124):*/
	fd_ind.label_type.standard = "1"b;

	if file_number ^= 0
	then file_table.label_format = 1;
	go to retrn;				/* set label record user spec */

actlbl (212):					/*action(125):*/
	nsa_index = nsa_index + 1;
	nsa_name_index (nsa_index) = name_string_index;
	nsa_name_length (nsa_index) = user_word.word_size;
	nsa_lbl_rec (nsa_index) = "1"b;
	nsa_cancelled (nsa_index) = "0"b;

	substr (name_string, name_string_index, user_word.word_size) = substr (user_word.word, 1, user_word.word_size);

	name_string_index = name_string_index + user_word.word_size;
	go to retrn;

actlbl (213):					/* action(126) */
						/* value of label field is literal */
	if label_field_num ^= 0
	then go to LFL (label_field_num);

	go to retrn;

LFL (1):						/* file - id */
	call enter_key (113);

	if file_table.file_id_info ^= "00000"
	then do;
		tf = 208;
		call diag;
	     end;
	else file_table.file_id_info = common_key;

	go to retrn;

LFL (2):						/* retention */
	call enter_key (114);

	if file_table.retention_info ^= "00000"
	then do;
		tf = 208;
		call diag;
	     end;
	else file_table.retention_info = common_key;

	go to retrn;

LFL (3):						/* catalogue-name */
	if file_table.catalogued ^= 0
	then do;
		tf = 221;
		call diag;
	     end;

	else do;
		file_table.catalogued = 2;
		file_table.cat_nm = alphanum_lit.string;
	     end;

	if file_table.cat_id_info ^= "00000"
	then do;
		tf = 208;
		call diag;
	     end;
	else file_table.cat_id_info = common_key;

	go to retrn;

actlbl (214):					/* action(127) */
						/* value of label field is data name */
	if label_field_num ^= 0
	then go to LFD (label_field_num);

	go to retrn;

LFD (1):						/* file - id */
	call enter_key (13);

	if file_table.file_id_info ^= "00000"
	then do;
		tf = 208;
		call diag;
	     end;
	else file_table.file_id_info = common_key;

	go to retrn;

LFD (2):						/* retention */
	call enter_key (14);

	if file_table.retention_info ^= "00000"
	then do;
		tf = 208;
		call diag;
	     end;
	else file_table.retention_info = common_key;

	go to retrn;

LFD (3):						/* catalogue-name */
	if file_table.catalogued ^= 0
	then do;
		tf = 221;
		call diag;
	     end;

	else do;
		file_table.catalogued = 3;
		call enter_key (7);
	     end;

	if file_table.cat_id_info ^= "00000"
	then do;
		tf = 208;
		call diag;
	     end;
	else file_table.cat_id_info = common_key;

	go to retrn;

actlbl (215):					/* action(128) */
						/* name qualifier */
	if label_field_num ^= 0
	then call enter_qual;

	go to retrn;



/* enter key into var common */

enter_key:
     proc (type);

declare	(type, siz, lit_size)
			fixed bin;

	file_key.next = "00000";
	file_key.next_alt = "00000";
	file_key.qual = "00000";

	addr (file_key.info) -> BIT8 = "0"b;		/* [3.0-1] */

	file_key.file_no = file_table.file_no;

	file_key.line = user_word.line;
	file_key.column = user_word.column;

	file_key.temp_seg = 0;
	file_key.temp_offset = 0;

	file_key.desc = " ";

	file_key.key_type = type;

	qual_sw = "0"b;

	if user_word.type = 8			/* user word */
	then do;
		file_key.name_size = user_word.word_size;
		file_key.name = user_word.word;
	     end;

	else if alphanum_lit.type = 3			/* alphanumeric lit */
	then do;
		file_key.name_size = alphanum_lit.length;
		file_key.name = alphanum_lit.string;
	     end;

	else if numeric_lit.type = 2			/* numeric lit */
	then do;
		file_key.name_size = numeric_lit.length;
		file_key.name = numeric_lit.literal;
	     end;

	else if rw.type = 1				/* figurative const */
	then do;
		if label_field_num ^= 0
		then do;

			go to LFF (label_field_num);

LFF (1):						/* file - id */
			if all_ind = 0
			then file_key.name_size = 1;
			else file_key.name_size = 17;

			call form_lit;

			go to LFF1;

LFF (2):						/* retention */
			if all_ind = 0
			then file_key.name_size = 1;
			else file_key.name_size = 3;

			call form_lit;

			go to LFF1;

LFF (3):						/* catalogue-name */
			if all_ind = 0
			then file_key.name_size = 1;
			else file_key.name_size = 17;

			call form_lit;

			go to LFF1;

LFF1:
		     end;

	     end;

	siz = size (file_key) * 4 + file_key.name_size;

	call cobol_vdwf_sput (cobol_com_fileno, com_status, fkey_ptr, siz, common_key);

	if fixed_common.file_keys = "00000"
	then fixed_common.file_keys = common_key;

	else do;
		call cobol_vdwf_dget (cobol_com_fileno, com_status, work_ptr, siz, fixed_common.last_file_key);

		work_ptr -> file_key.next = common_key;

		call cobol_vdwf_dput (cobol_com_fileno, com_status, work_ptr, siz, fixed_common.last_file_key);

	     end;

	fixed_common.last_file_key = common_key;

     end;

form_lit:
     proc;					/* form lit from fig const */

declare	lit_char		char (1),
	p		ptr;
declare	lit_bit		bit (9) based;
declare	lit_bit_string	(256) char (1) based (p);

	lit_char = " ";

	if rw.key = 192
	then lit_char = " ";			/* is_word("SPACE") */
	else if rw.key = 180
	then lit_char = "0";			/* is_word("ZERO") */
	else if rw.key = 235
	then lit_char = """";			/* is_word("QUOTE") */
	else if rw.key = 229			/* is_word("LOW-VALUE") */
	then addr (lit_char) -> lit_bit = "0"b;
	else if rw.key = 221			/* is_word("HIGH-VALUE") */
	then addr (lit_char) -> lit_bit = "001111111"b;

	p = addr (file_key.name);

	do i = 1 by 1 to file_key.name_size;

	     lit_bit_string (i) = lit_char;

	end;

     end;

enter_qual:
     proc;					/* enter qualifier into var common */

declare	size		fixed bin;

declare	1 qual_rec	based (qual_ptr),
	  2 next		char (5),
	  2 size		fixed bin,
	  2 name		char (0 refer (qual_rec.size));

	size = user_word.word_size + key_qual_size;

	qual_rec.next = "00000";
	qual_rec.size = user_word.word_size;
	qual_rec.name = user_word.word;

	call cobol_vdwf_sput (cobol_com_fileno, com_status, qual_ptr, size, common_key);

	if qual_sw = "0"b
	then do;
		call cobol_vdwf_dget (cobol_com_fileno, com_status, work_ptr, size, fixed_common.last_file_key);

		work_ptr -> file_key.qual = common_key;

		call cobol_vdwf_dput (cobol_com_fileno, com_status, work_ptr, size, fixed_common.last_file_key);

	     end;

	else do;
		call cobol_vdwf_dget (cobol_com_fileno, com_status, work_ptr, size, prev_qual_key);
	     end;

	prev_qual_key = common_key;
	qual_sw = "1"b;

     end;


/* store data record name */

actlbl (216):					/*action(129):*/
	if file_number ^= 0
	then file_table.data_count = file_table.data_count + 1;

	nsa_index = nsa_index + 1;
	nsa_name_index (nsa_index) = name_string_index;
	nsa_name_length (nsa_index) = user_word.word_size;
	nsa_lbl_rec (nsa_index) = "0"b;
	nsa_cancelled (nsa_index) = "0"b;

	substr (name_string, name_string_index, user_word.word_size) = substr (user_word.word, 1, user_word.word_size);

	name_string_index = name_string_index + user_word.word_size;
	go to retrn;

/* store report name */

actlbl (217):					/*action(130):*/
	if file_number ^= 0
	then file_table.report_count = file_table.report_count + 1;
						/* write report_rec */
	if bnw ^= 0
	then do;
		rnt_size = data_name.size;

		call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);

		bnw = 0;
	     end;

	com2_ptr = addr (cobol_wkbuf1_tbl.wkbuf1);
	ptr4 = addr (cobol_wkbuf1_tbl);
	ptr4 -> cntbuf = 0;
	report_rec.next = null_key;
	report_rec.line = user_word.line;
	report_rec.column = user_word.column;
	report_rec.fileno = fd_token.file_no;
	report_rec.size = user_word.word_size;

	substr (report_rec.name, 1, report_rec.size) = substr (user_word.word, 1, user_word.word_size);

	cm_ptr = com2_ptr;
	cm_size = report_rec_constant + report_rec.size;

	call cobol_vdwf_sput (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

	if prior_report_rec ^= null_key
	then go to s_report_next;

	fixed_common.report_names = cm_key;
	prior_report_rec = cm_key;
	go to retrn;

s_report_next:
	rcm_key = prior_report_rec;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	if substr (fstatus, 17, 16) ^= "0000000000000000"b
	then go to retrn;

	com2_ptr = cm_ptr;
	report_rec.next = cm_key;

	call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	prior_report_rec = cm_key;
	go to retrn;				/* store body data name for linage */

actlbl (218):					/*action(131):*/
	fd_ind.linage_type.body = "1"b;
	linage_rec.body = linage_rec.name_count + 1;
	linage_name_rec.desc = 1;

	call write_linage_name_rec;

	linage_rec.body_name = cm_key;
	go to retrn;				/* store body integer for linage */

actlbl (219):					/*action(132):*/
	fd_ind.linage_type.body = "1"b;
	linage_rec.body = 5;			/*[5.1-1]*/
	if record.type = 2
	then linage_rec.body_int = fixed (numeric_lit.literal);
	else linage_rec.body_int = 0;
	go to retrn;				/* Store integer for linage top */

actlbl (220):					/*action(133):*/
	fd_ind.linage_type.top = "1"b;
	linage_rec.top = 5;				/*[5.1-1]*/
	if record.type = 2
	then linage_rec.top_int = fixed (numeric_lit.literal);
	else linage_rec.top_int = 0;
	go to retrn;


write_linage_name_rec:
     proc;					/*store linage data name into common*/
	linage_name_rec.next = null_key;
	linage_name_rec.line = user_word.line;
	linage_name_rec.column = user_word.column;
	linage_name_rec.fileno = fd_token.file_no;
	linage_name_rec.size = user_word.word_size;

	substr (linage_name_rec.name, 1, linage_name_rec.size) = substr (user_word.word, 1, user_word.word_size);

	cm_ptr = com2_ptr;
	cm_size = linage_name_rec_constant + linage_name_rec.size;

	call cobol_vdwf_sput (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

	linage_rec.name_count = linage_rec.name_count + 1;

	if prior_linage_name_rec ^= null_key
	then go to linage_next;

	fixed_common.linage_info = cm_key;
	prior_linage_name_rec = cm_key;

	return;

linage_next:
	rcm_key = prior_linage_name_rec;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	if substr (fstatus, 17, 16) ^= "0000000000000000"b
	then return;

	cm_ptr -> linage_name_rec.next = cm_key;

	prior_linage_name_rec = cm_key;
     end write_linage_name_rec;

actlbl (221):					/*action(134):*/
/**** not done *****/
	go to retrn;

/* all_lit */

actlbl (222):					/*action(135):*/
	alphainit.initype.all_lit = "1"b;

	go to retrn;

/* set ptr1 after occrus clause */

actlbl (223):					/*action(137):*/
	ptr1 = addr (dn_ptr -> any_item (data_name.size + 1));

	go to retrn;				/* set level indicator to 0 */

actlbl (224):					/*action(138):*/
	ll01 = "0"b;
	ll77 = "0"b;
	go to retrn;

/* add key structure length to size */

actlbl (225):					/*action(139):*/
						/*           data_name.size = data_name.size + ks_constant + ks_cnt_constant*keys.keycount;*/
	go to retrn;
/***** communication section action routines *****/
						/* cms section init */

actlbl (226):					/*action(140):*/
	substr (section_ind, 5, 1) = "1"b;
	substr (vector_part, 1, 6) = "000010"b;
	cd_initial = "0"b;
	ll01 = "1"b;
	cdno = 0;
	go to retrn;				/* cd entry init */

actlbl (227):					/*action(141):*/
	if fixed_common.comp_level < "5"
	then if record.column < 8 | record.column > 11
	     then do;
		     tf = 133;
		     call diag_level;
		end;

	if ll01 = "0"b
	then do;
		tf = 101;
		call diag;
	     end;

	ll01 = "0"b;
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;
	cdtoken.def_line = record.line;		/*	cdtoken.level = 0; */
	cdtoken.column = record.column;
	cdtoken.size = cd_constant;
	cdtoken.type = 13;
	cdno = cdno - 1;

	do i = 1 to 11;
	     cd_size (i) = 0;
	end;

	cd_clauses = "0"b;
	save_cdo = 0;
	go to retrn;				/* store cd name */

actlbl (228):					/*action(142):*/
						/*[4.4-1]*/
	fixed_common.cd = "1"b;
	cdtoken.name_size = user_word.word_size;

	substr (cdtoken.name, 1, cdtoken.name_size) = substr (user_word.word, 1, user_word.word_size);

	cdtoken.size = cdtoken.size + cdtoken.name_size;

	cdtoken.size = cdtoken.size + mod (-cdtoken.size, 4);

	go to retrn;				/* set cd output option indicator and write cd entry */

actlbl (229):					/*action(143):*/
	cdtoken.options.output = "1"b;
	cd_clauses = "0"b;

	call write_cd;
	call cdinit;

	data_name.level = 1;
	data_name.item_length = 16;

	ptr8 = addr (data_name.file_section);

	ptr8 -> bit72 = "000010010100000000010000000100000000000000000001000000000000000000000100"b;
	data_name.size = dn_constant;

	data_name.size = data_name.size + mod (-data_name.size, 4);

	data_name.initial_ptr = data_name.size + 1;
	ptr1 = addr (dn_ptr -> any_item (data_name.initial_ptr));
	alphainit.initype.non_numeric = "1"b;
	alphainit.length = data_name.item_length;
	ptr11 = addr (output_cd_prefix_initval);
	alphainit.string = output_cd_string;
	data_name.size = data_name.size + aiv_constant + alphainit.length;

/*	call cobol_vdwf_sput(cobol_ntfp,fstatus,dn_ptr,data_name.size,w_key); */

	data_name.initial_ptr = 0;
	index_ct = 0;
	go to retrn;



write_cd:
     proc;					/* write cd entry */
	rnt_size = cdtoken.size;
	cdtoken.cd_num = cdno;
	cdtoken.mdest = 1;

	call cobol_vdwf_sput (cobol_ntfp, fstatus, w2_ptr, rnt_size, w_key);

	save_fd = w_key;
	return;
     end write_cd;


/* set cd input bit and write cd entry */

actlbl (230):					/*action(144):*/
	cdtoken.options.input = "1"b;
	cd_clauses = "0"b;
	substr (cd_clauses, 12, 1) = "1"b;		/*stands for input cd*/

	call write_cd;
	call cdinit;

	data_name.level = 1;
	data_name.item_length = 16;

	ptr8 = addr (data_name.file_section);

	ptr8 -> bit72 = "000010010100000000010000000100000000000000000001000000000000000000000100"b;
	data_name.size = dn_constant;

	data_name.size = data_name.size + mod (-data_name.size, 4);

	data_name.initial_ptr = data_name.size + 1;
	ptr1 = addr (dn_ptr -> any_item (data_name.initial_ptr));
	alphainit.initype.non_numeric = "1"b;
	alphainit.length = data_name.item_length;
	ptr11 = addr (input_cd_prefix_initval);
	alphainit.string = input_cd_string;
	data_name.size = data_name.size + aiv_constant + alphainit.length;

/*	call cobol_vdwf_sput(cobol_ntfp,fstatus,dn_ptr,data_name.size,w_key); */

	data_name.initial_ptr = 0;
	go to retrn;

/* set cd initial bit */

actlbl (231):					/*action(145):*/
	cdtoken.options.initial = "1"b;
	cd_initial = "1"b;
	go to retrn;				/* set cd data name index to 1 */

actlbl (232):					/*action(146):*/
	cd_index = 0;
	go to retrn;				/* store data name for cd */

actlbl (233):					/*action(147):*/
	if cd_index > 11
	then go to na147;

	cd_index = cd_index + 1;
	go to act150;

na147:
	tf = 102;
	call diag;
	go to retrn;				/* store filler name for cd entry */

actlbl (234):					/*action(148):*/
	cd_index = cd_index + 1;

	if cd_index <= 11
	then do;
		cd_size (cd_index) = 6;
		substr (cd_name (cd_index), 1, 6) = "FILLER";
		go to retrn;
	     end;

	tf = 102;
	call diag;
	go to retrn;				/* generate cd input record based on options */

actlbl (235):					/*action(149):*/
	ll01 = "1"b;

	do i = 1 to 11;

	     if substr (cd_clauses, i, 1) ^= "0"b
	     then go to enda149;

	     cd_size (i) = 6;
	     substr (cd_name (i), 1, 6) = "FILLER";
enda149:
	end;

g149:						/*generate cd data name 0*/
	data_name.name_size = 6;

	substr (data_name.name, 1, data_name.name_size) = "FILLER";

	data_name.offset = 0;
	data_name.level = 1;
	data_name.item_length = 87;
	data_name.places_right = 0;
	ptr8 = addr (data_name.file_section);

	ptr8 -> bit72 = "0000100110100000000100000001000000000000000000000000000000000000"b;
	data_name.size = dn_constant + data_name.name_size;

	call write_dn;

	temp_bin1 = 0;

	call cdinit;				/*generate cd data names 1 - 4 */
	data_name.level = 2;
	data_name.item_length = 12;
	data_name.places_left = 12;

	ptr8 -> bit72 = "0000100001000000000100000001000000000000000000000000000000000000"b;

	do i = 1 to 4;
	     data_name.name_size = cd_size (i);

	     substr (data_name.name, 1, data_name.name_size) = substr (cd_name (i), 1, data_name.name_size);

	     data_name.size = dn_constant + data_name.name_size;

	     data_name.size = data_name.size + mod (-data_name.size, 4);

	     data_name.initial_ptr = data_name.size + 1;
	     ptr1 = addr (dn_ptr -> any_item (data_name.initial_ptr));

	     alphainit.initype.non_numeric = "1"b;
	     alphainit.length = 12;
	     alphainit.string = "            ";

	     data_name.size = data_name.size + aiv_constant + 12;
	     data_name.offset = temp_bin1;
	     temp_bin1 = temp_bin1 + 12;

	     call write_dn;
	end;

	data_name.initial_ptr = 0;			/* generate cd data name 5 */
	i = 5;
	data_name.item_length = 6;

	ptr8 -> bit72 = "0000100001000000010000000001000000000000000000000000100000000000"b;

	call gen_dn;				/* generate cd data name 6 */
	i = 6;
	data_name.item_length = 8;

	call gen_dn;				/* generate cd data name 7 */
	i = 7;
	data_name.item_length = 12;

	ptr8 -> bit72 = "0000100001000000000100000001000000000000000000000000000000000000"b;

	call gen_dn;				/* generae cd data name 8 */
	i = 8;
	data_name.item_length = 4;
	ptr8 -> bit72 = "0000100001000000010000000001000000000000000000000000100000000000"b;

	call gen_dn;				/* generate cd data name 9 */
	i = 9;
	data_name.item_length = 1;

	ptr8 -> bit72 = "0000100001000000000100000001000000000000000000000000000000000000"b;

	call gen_dn;				/* generate cd data name 10 */
	i = 10;
	data_name.item_length = 2;

	call gen_dn;				/* generate cd data name 11 */
	i = 11;
	data_name.item_length = 6;

	ptr8 -> bit72 = "0000100001000000010000000001000000000000000000000000100000000000"b;

	call gen_dn;
	go to retrn;

cdinit:
     proc;
	ptr4 = addr (cobol_wkbuf1_tbl);
	ptr4 -> cntbuf = 0;
	data_name.type = 9;
	data_name.def_line = cdtoken.def_line;
	data_name.column = cdtoken.column;
	data_name.file_num = cdno;
     end cdinit;



gen_dn:
     proc;
	data_name.name_size = cd_size (i);
	data_name.size = data_name.name_size + dn_constant;

	substr (data_name.name, 1, data_name.name_size) = substr (cd_name (i), 1, data_name.name_size);

	data_name.places_right = 0;

	data_name.places_left = data_name.item_length;


	data_name.offset = temp_bin1;
	temp_bin1 = temp_bin1 + data_name.item_length;

	call write_dn;

     end gen_dn;



write_dn:
     proc;
	rnt_size = data_name.size;

	call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);

     end write_dn;


/* cd index 1 */

actlbl (236):					/*action(150):*/
	cd_index = 1;
act150:
	substr (cd_clauses, cd_index, 1) = "1"b;

	call cd_dn;
	go to retrn;				/* cd index = 2 */

actlbl (237):					/*action(151):*/
	cd_index = 2;
	go to act150;				/* cd index = 3 */

actlbl (238):					/*action(152):*/
	cd_index = 3;
	go to act150;				/* cd index = 4 */

actlbl (239):					/*action(153):*/
	cd_index = 4;
	go to act150;				/* cd index = 5 */

actlbl (240):					/*action(154):*/
	cd_index = 5;
	go to act150;				/* cd index = 6 */

actlbl (241):					/*action(155):*/
	cd_index = 6;
	go to act150;				/* cd index = 7 */

actlbl (242):					/*action(156):*/
	cd_index = 7;
	go to act150;				/* cd index = 8 */

actlbl (243):					/*action(157):*/
	cd_index = 8;
	go to act150;				/* cd index = 9 */

actlbl (244):					/*action(158):*/
	cd_index = 9;
	go to act150;				/* cd index = 10 */

actlbl (245):					/*action(159):*/
	cd_index = 10;
	go to act150;				/* cd index = 11 */

actlbl (246):					/*action(160):*/
	cd_index = 11;
	go to act150;


cd_dn:
     proc;
	if rw.type = 1				/*FILLER*/
	then do;
		cd_size (cd_index) = 6;
		substr (cd_name (cd_index), 1, 6) = "FILLER";
	     end;
	else do;
		cd_size (cd_index) = user_word.word_size;

		substr (cd_name (cd_index), 1, cd_size (cd_index)) = substr (user_word.word, 1, user_word.word_size);

	     end;

	return;
     end cd_dn;


/* generate cd output data names and indexed names */

actlbl (247):					/*action(161):*/
	ll01 = "1"b;

	do i = 1 to 5;
	     if substr (cd_clauses, i, 1) ^= "0"b
	     then go to enda161;

	     cd_size (i) = 6;
	     substr (cd_name (i), 1, 6) = "FILLER";
enda161:
	end;

	if save_cdo = 0
	then save_cdo = 1;				/* generate cd output data name 0 */
	data_name.name_size = 6;

	substr (data_name.name, 1, data_name.name_size) = "FILLER";

	data_name.offset = 0;
	data_name.level = 1;
	data_name.item_length = (10 + (13 * save_cdo));
	data_name.places_right = 0;
	ptr8 = addr (data_name.file_section);

	ptr8 -> bit72 = "0000100110100000000100000001000000000000000000000000000000000000"b;
	data_name.size = dn_constant + data_name.name_size;

	call write_dn;
	call cdinit;				/* generate cd output data name 1 2 */
	data_name.level = 2;
	temp_bin1 = 0;
	data_name.item_length = 4;

	ptr8 -> bit72 = "0000100001000000010000000001000000000000000000000000100000000000"b;

	do i = 1 to 2;
	     call gen_dn;
	end;

/* generate data name 3 for cd output */
	data_name.item_length = 2;
	data_name.places_left = 2;
	ptr8 -> bit72 = "0000100001000000000100000001000000000000000000000000000000000000"b;

	call gen_dn;

	if save_cdo > 1
	then ;
	else go to gend4;

	ptr8 -> bit72 = "000010001000000000010000000000000000000001000000000000000000000001"b;
	data_name.name_size = 6;

	substr (data_name.name, 1, data_name.name_size) = "FILLER";

	data_name.item_length = 13;
	data_name.places_left = 0;
	data_name.size = dn_constant + data_name.name_size;

	data_name.size = data_name.size + mod (-data_name.size, 4);

	ptr1 = addr (dn_ptr -> any_item (data_name.size + 1));
	data_name.occurs_ptr = data_name.size + 1;
	occurs.keyed = 0;
	occurs.key_number = 0;
	odim = 1;

	occurs.dimensions = 1;
	occurs.level.max (1) = save_cdo;
	occurs.level.struclength (1) = 13;
	occurs.level.cswd (1) = 0;

	if index_ct = 0
	then occurs.level.indexedno (odim) = 0;
	else do;
		counter2 = counter2 + 1;
		occurs.level.indexedno (odim) = counter2;
		data_name.indexed_by = "1"b;
	     end;
size161:
	data_name.size = data_name.size + occ_constant + occ_dim_constant;

	if index_ct <= 0
	then go to wcddn3;

/* write index name for occurs cd */
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;

	indexname.type = 10;
	indexname.level = 99;
	indexname.index_no = counter2;
	indexname.min = occurs.level.min (1);
	indexname.max = occurs.level.max (1);

	do i = 6 to 5 + index_ct;
	     indexname.name_size = cd_size (i);


	     substr (indexname.name, 1, indexname.name_size) = substr (cd_name (i), 1, cd_size (i));

	     indexname.size = in_constant + indexname.name_size;
	     rnt_size = indexname.size;

	     call cobol_vdwf_sput (cobol_ntfp, fstatus, w2_ptr, rnt_size, w_key);

	end;

wcddn3:
	rnt_size = data_name.size;

	call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);

/* generate data name 4 for cd output */
gend4:						/* save occurs extension in buffer2 */
	if save_cdo > 1
	then substr (cobol_wkbuf2_tbl.wkbuf2, 1, occ_constant + occ_dim_constant) =
		substr (cobol_wkbuf1_tbl.wkbuf1, data_name.occurs_ptr, occ_constant + occ_dim_constant);

	do i = 4 to 5;
	     data_name.name_size = cd_size (i);
	     data_name.size = dn_constant + data_name.name_size;

	     data_name.size = data_name.size + mod (-data_name.size, 4);

	     data_name.offset = temp_bin1;
	     substr (data_name.name, 1, data_name.name_size) = cd_name (i);

	     if i = 4
	     then do;
		     data_name.item_length = 1;
		     data_name.places_left = 1;
		end;
	     else do;
		     data_name.item_length = 12;
		     data_name.places_left = 12;
		end;

	     if save_cdo > 1
	     then do;

		     ptr8 -> bit72 = "0000100001000000000100000001000000000000010000000000000000000000"b;

/* inherit occurs extension */
		     data_name.occurs_ptr = data_name.size + 1;

		     substr (cobol_wkbuf1_tbl.wkbuf1, data_name.occurs_ptr, occ_constant + occ_dim_constant) =
			substr (cobol_wkbuf2_tbl.wkbuf2, 1, occ_constant + occ_dim_constant);

		     data_name.size = data_name.size + occ_constant + occ_dim_constant;
		     data_name.level = 3;

		end;
	     else ptr8 -> bit72 = "0000100001000000000100000001000000000000000000000000000000000000"b;

	     temp_bin1 = temp_bin1 + data_name.item_length;
	     rnt_size = data_name.size;

	     call cobol_vdwf_sput (cobol_ntfp, fstatus, dn_ptr, rnt_size, w_key);

	end;

	data_name.level = 2;

	if save_cdo > 1
	then do;
		save_wkey = w_key;
		w_key = save_fd;

		call cobol_vdwf_dget (cobol_ntfp, fstatus, cd_ptr, rnt_size, w_key);

		cd_ptr -> cdtoken.mdest = save_cdo;

		call cobol_vdwf_dput (cobol_ntfp, fstatus, cd_ptr, rnt_size, w_key);

		w_key = save_wkey;
	     end;

	go to retrn;				/* save integer for destination table */

actlbl (248):					/*action(162):*/
						/*[5.1-1]*/
	if record.type = 2
	then save_cdo = fixed (numeric_lit.literal);
	else save_cdo = 0;

	if fixed_common.comp_level < "3"
	then if save_cdo > 1
	     then do;
		     tf = 164;
		     call diag_level;
		end;
	go to retrn;

/* initialize cd output index names */

actlbl (249):					/*action(163):*/
	go to retrn;				/* generate index names for cd output */

actlbl (250):					/*action(164):*/
	index_ct = index_ct + 1;

	if 5 + index_ct <= 11
	then go to na164;

	tf = 95;
	call diag;
	go to retrn;

na164:
	cd_index = 5 + index_ct;

	call cd_dn;

	go to retrn;				/* save index names in 6 - 11 cd name array */

/* create occ_key item for odo key */

actlbl (251):					/*action(165):*/
	vector_map.subject_of_keyis = "1"b;
	prior_skey_rec = null_key;
	com2_ptr = addr (cobol_wkbuf2_tbl.wkbuf2);
	ptr4 = addr (cobol_wkbuf2_tbl);
	ptr4 -> cntbuf2 = 0;
	occ_key.next = null_key;
	occ_key.rec_no = save_01;
	occ_key.lineno = record.line;			/* write occ_key item into common */
	cm_ptr = com2_ptr;
	cm_size = occ_key_constant;

	call cobol_vdwf_sput (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

	if prior_occ_key ^= null_key
	then go to occ_key_next;

	fixed_common.search_keys = cm_key;
	prior_occ_key = cm_key;
	go to retrn;

occ_key_next:
	rcm_key = prior_occ_key;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	com2_ptr = cm_ptr;
	occ_key.next = cm_key;

	call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	prior_occ_key = cm_key;
	go to retrn;

/* store qualifier for occ_key item */

actlbl (252):					/*action(166):*/
	call qualifier;

	if prior_qual_rec ^= null_key
	then go to skey_qual;

	rcm_key = prior_skey_rec;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	skey_ptr = cm_ptr;
	skey_rec.qual = cm_key;

	call cobol_vdwf_dput (cobol_cmfp, fstatus, cm_ptr, cm_size, rcm_key);

	prior_qual_rec = cm_key;
	go to retrn;

skey_qual:
	call store_qualifier;
	go to retrn;

actlbl (253):					/* action(78) */
	fixed_common.init_cd = "1"b;

	go to retrn;

/*action(92):*/
	;

/*action(93):*/
	;

/*action(97):*/
	;

/*action(98):*/


retrn:
	return;

/*[4.0-1]*/
declare	cobol_ddsyntax$init_file_tab
			entry;

dcl	rn		fixed bin;
dcl	an		fixed bin;
dcl	max_poss_extensions fixed bin internal static init (314);
dcl	tf		fixed bin;
dcl	fstatus		bit (32);			/*io return code*/
dcl	null_func		ptr init (null ()) internal static;
dcl	null_key		char (5) internal static init ("00000");
dcl	ptr11		ptr;
declare	BIT8		bit (8) based;		/* [3.0-1] */
dcl	input_cd_string	char (16) based (ptr11);

dcl	output_cd_string	char (16) based (ptr11);

declare	cd_ptr		ptr;

dcl	1 input_cd_prefix_initval
			static,
	  2 cdtype	bit (1) init ("1"b),
	  2 usertype	bit (1) init ("1"b),
	  2 convert	bit (1) init ("1"b),
	  2 textln	fixed bin init (0),
	  2 mcount	fixed bin init (0),
	  2 seqno		fixed bin init (0);

dcl	1 output_cd_prefix_initval
			static,
	  2 cdtype	bit (1) init ("0"b),
	  2 usertype	bit (1) init ("1"b),
	  2 convert	bit (1) init ("1"b),
	  2 textln	fixed bin init (0),
	  2 dcount	fixed bin init (1),
	  2 seqno		fixed bin init (0);

declare	(addr, size, mod, substr, unspec, fixed)
			builtin;


%include cobol_ext_;

%include cobol_ext_ddsyn;
dcl	sv_ptr_auto	ptr;
%include cobol_special_dcls;
%include cobol_spec_constants;
dcl	1 shared_var	based (sv_ptr_auto),
%include cobol_shared_var;
%include cobol_non_static;
%include cobol_type9;
%include cobol_occurs;
%include cobol_fd_token;
declare	1 cdtoken		based (cdtoken_ptr),
%include cobol_TYPE13;
%include cobol_qual_rec;
%include cobol_obj_rec;
%include cobol_occ_key_rec;
%include cobol_report_rec;
%include cobol_rename_rec;
%include cobol_skey_rec;
%include cobol_file_key;
%include cobol_linage_rec;
%include cobol_linage_name_rec;
%include cobol_fixed_common;
%include cobol_file_table;
     end cobol_ddact2;




		    cobol_ddalloc.pl1               05/24/89  1044.4rew 05/24/89  0830.0      513279



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1981 *
        *                                                         *
        *********************************************************** */




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_ddalloc.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 09/28/83 by FCH, [5.2...], trace added */
/* Modified on 12/30/81 by FCH, [5.1-2], [4.2-2] is removed, phx11821(BUG520) */
/* Modified on 10/13/81 by FCH, [5.1-1], major rewrite of redefines, BUG516, BUG513(phx11673) */
/* Modified on 04/03/80 by FCH, [4.2-3], -rck does not work with odo, BUG430(TR4533) */
/* Modified on 09/24/79 by FCH, [4.2-2], constant sect becomes working-storage sect */
/* Modified on 08/23/79 by FCH, [4.2-1] just_right = "0"b during initialization */
/* Modified on 12/28/78 by FCH, [3.0-2], fix  son_cnt */
/* Modified on 05/12/78 by FCH, [3.0-1], fix incorrect unequal size diag */
/* Modified since Version 3.0 */









/* format: style3 */
cobol_ddalloc:
     proc;/***.....if Trace_Bit="1"b then call ioa_("^a^a",substr(Trace_Line,1,Trace_Lev),"COBOL_DDALLOC:");/**/

/*[5.1-1]*/
	addr (stk (0)) -> bit32400 = "0"b;

	stk.redef_ptr (1) = null ();
	redef_object_offset = 1;
	ddseg.next_offset = 8;

	fixed_common.number_of_dd_segs = 1;
	fixed_common.size_seg = record_segment;
	fixed_common.size_offset = 0;

/*[5.1-1]*/
	hisi_slack = substr (fixed_common.compile_mode, 5, 1);

	if fixed_common.sra_clauses > 0
	then do i = 1 to fixed_common.sra_clauses;

		same_rec_area_info.clause_no (i) = i;
		same_rec_area_info.seg_num (i) = 0;
		same_rec_area_info.cra_size (i) = 0;

	     end;

	current_fno = 0;
	file_key = "00000";
	procdef.section_name = fixed_common.pd_section;
	reswd.jump_index = 0;
	numlit.line, numlit.column = 0;
	numlit.type = 2;
	nonnumlit.line, nonnumlit.column = 0;
	nonnumlit.type = 3;

	if fixed_common.odo_info ^= "00000"
	then do;					/* size routines must be generated */

		procname_sw = 1;

		call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (type25), type25.size);
						/* write type25 for pdstax */

		if procdef.section_name
		then do;

			procdef.section_num = fixed_common.spec_tag_counter + 1;
			procdef.proc_num = fixed_common.spec_tag_counter + 1;

			call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (procdef), procdef.size);

			reswd.key = reswd_SECTION;
			reswd.class = "000000000000000000110000000"b;

			call put_rw_token;		/* write out SECTION key */

			reswd.key = reschar_PERIOD;
			reswd.class = "000100000000000000000000000"b;

			call put_rw_token;		/* write out period key */

			fixed_common.spec_tag_counter = procdef.proc_num;
			procdef.section_name = "0"b;

		     end;

	     end;
	else procname_sw = 0;

	do i = 1 to fixed_common.file_count;

	     call cobol_read_ft_ (i, ft_ptr);

	     if ^file_table.sort_file
	     then do;

		     if ^file_table.external
		     then do;

			     temp = index (file_table.ifn, " ") - 1;

			     if temp < 0
			     then temp = 16;

			     file_table.id =
				substr (file_table.ifn, 1, temp) || "." || unique_chars_ (unique_bits_ ());

			end;
		     else file_table.id = file_table.ifn;

		     call cobol_make_fsb_link_ (ft_ptr);

		end;
	end;

/* FIRST PASS */

	eof = 0;
	first_name_key = fixed_common.first_dd_item;

	if first_name_key = "00000"
	then eof = -1;
	else call cobol_ntio$dget (dn_ptr, first_name_key);

	do while (eof = 0);

	     if data_name.type = 12 | data_name.type = 16
	     then do;

		     current_fno = dn_ptr -> fd_token.file_no;

		     if current_fno = 0
		     then ft_ptr = null ();		/* a fatal error was encountered */
		     else call cobol_read_ft_ (current_fno, ft_ptr);


		     call GET;

		end;

	     else if data_name.type = 9
	     then do;

		     if data_name.level ^= 66
		     then do;

			     if data_name.file_num ^= current_fno
			     then current_fno = 0;

			     call set_size;

			     if current_fno > 0
			     then do;		/* processing a record description */

				     temp_size = stk.nt_ptr (1) -> data_name.item_length;

				     if file_table.same_rec_clause ^= 0
				     then do;

					     if temp_size
						> same_rec_area_info.cra_size (file_table.same_rec_clause)
					     then same_rec_area_info.cra_size (file_table.same_rec_clause) =
						     temp_size;

					end;

				     if file_table.max_cra_size ^= 0
				     then if temp_size ^= file_table.max_cra_size
					then file_table.unequal_recs = "1"b;

				     if stk.nt_ptr (1) -> data_name.variable_length
				     then file_table.unequal_recs = "1"b;

				     if temp_size > file_table.max_cra_size
				     then file_table.max_cra_size = temp_size;

				end;

			end;
		     else call GET;

		end;
	     else call GET;

	end;

/* SECOND PASS */

	if eof = 1
	then do;

		eof = 0;
		index_cnt = 0;

		call cobol_ntio$dget (dn_ptr, first_name_key);
		call cobol_ntio$sget (dn_ptr, eof);
		;				/* discard SYSTEM-STATUS */
		call cobol_ntio$sget (dn_ptr, eof);
		;				/* discard TALLY */

	     end;





	do while (eof = 0);

	     if data_name.type = 9
	     then do;

		     if data_name.level ^= 66
		     then do;			/* replacement will patch renames items */

			     if data_name.level = 01 | data_name.level = 77
			     then do;

				     odo_proc_num = 0;
				     occurs_level = 0;

				     if ^data_name.exp_redefining
				     then do;

					     if data_name.o_of_rdf
					     then temp_size = data_name.max_red_size;
					     else temp_size = data_name.item_length;

					     if data_name.working_storage
					     then do;

						     cobol_$ws_charcnt = cobol_$ws_charcnt + temp_size;

						     if cobol_$ws_wdoff = 0
						     then cobol_$ws_wdoff =
							     divide (ddseg.next_offset, 4, 35, 0);

						end;

					     else if data_name.linkage_section
					     then do;

						     cobol_$ls_charcnt = cobol_$ls_charcnt + temp_size;
						     fixed_common.number_of_ls_pointers =
							fixed_common.number_of_ls_pointers + 1;

						end;


/*[5.1-2]*/
					     else if data_name.constant_section
						/*[5.1-2]*/
					     then cobol_$cons_charcnt = cobol_$cons_charcnt + temp_size;


					end;
				end;
			     else call test_occurs;

			     if data_name.variable_length
			     then call variable_size;



/*[5.1-2]*/
			     if data_name.constant_section
						/*[5.1-2]*/
			     then do;

/*[5.1-2]*/
				     call cobol_IVAL (dn_ptr);

/*[5.1-2]*/
				     data_name.seg_num = 3000;
						/*[5.1-2]*/
				     curr_wd_off = con_wd_off;
						/*[5.1-2]*/
				     curr_char_off = (curr_wd_off * 4) - data_name.offset;
						/*[5.1-2]*/
				     curr_char_pos = mod (curr_char_off, 4);

/*[5.1-2]*/
				     if curr_char_pos > 0
						/*[5.1-2]*/
				     then do;

/*[5.1-2]*/
					     if curr_char_pos = 1
					     then curr_char_pos = 3;
						/*[5.1-2]*/
					     else if curr_char_pos = 3
					     then curr_char_pos = 1;

/*[5.1-2]*/
					     curr_wd_off = divide (curr_char_off, 4, 17, 0) + 1;
						/*[5.1-2]*/
					     curr_char_off = curr_wd_off * 4;
						/*[5.1-2]*/
					end;

/*[5.1-2]*/
				     data_name.offset = curr_char_off + curr_char_pos;
						/*[5.1-2]*/
				end;		/*[5.1-2]*/
						/*[5.1-2]*/
			     else if ^data_name.linkage_section
			     then do;		/* allocate in cobol ^data.	*/

				     if data_name.level = 01 | data_name.level = 77
				     then do;

					     if data_name.file_num ^> 0
					     then do;
						/* record area for file already allocated */

						     if data_name.exp_redefining
						     then record_offset = redef_object_offset;
						     else do;

							     if data_name.communication_section
							     then do;

								     redef_object_offset, record_offset =
									cd_offsets (data_name.file_num);

								end;
							     else do;

								     if data_name.o_of_rdf
								     then temp_len =
									     data_name.max_red_size;
								     else temp_len =
									     data_name.item_length;

								     if data_name.double_word
								     then temp_mod = 8;
								     else if data_name.word
								     then temp_mod = 4;
								     else if data_name.half_word
								     then temp_mod = 2;
								     else temp_mod = 1;

								     temp_slack =
									mod (ddseg.next_offset,
									temp_mod);

								     if temp_slack > 0
								     then record_offset =
									     ddseg.next_offset
									     + temp_mod - temp_slack;
								     else record_offset =
									     ddseg.next_offset;

								     ddseg.next_offset =
									record_offset + temp_len;

								     if data_name.o_of_rdf
								     then redef_object_offset =
									     record_offset;

								end;

							end;

						end;

					     else if ft_ptr ^= null ()
					     then record_offset = file_table.cra_offset;

					end;

				     data_name.seg_num = record_segment;
				     data_name.offset = data_name.offset + record_offset;

				     if data_name.initial_ptr ^= 0
				     then do;

					     cobol_$value_cnt = cobol_$value_cnt + 1;

					     call mc_initval_seg2;

					end;
				end;
			end;




		     if index_cnt > 0
		     then do;

			     temp_slack = mod (ddseg.next_offset, 8);

			     if temp_slack > 0
			     then ddseg.next_offset = ddseg.next_offset + 8 - temp_slack;

			     do i = 1 to index_cnt;

				ind_ptr = index_ptr (i);
				index_name.seg_num = record_segment;
				index_name.offset = ddseg.next_offset;
				index_name.struc_length = occurs_info.struclength (occurs_level);
				ddseg.next_offset = ddseg.next_offset + 8;
				cobol_$ws_charcnt = cobol_$ws_charcnt + 8;

			     end;

			     index_cnt = 0;

			end;
		end;
	     else if data_name.type = 10
	     then do;				/* index-name token */

		     index_cnt = index_cnt + 1;
		     index_ptr (index_cnt) = dn_ptr;	/* defer allocation until following type 9 is processed */

		end;

	     else if data_name.type = 13
	     then do;				/* cd token */

		     cdtoken_ptr = dn_ptr;
		     temp_slack = mod (ddseg.next_offset, 16);
						/* double word align */

		     if temp_slack > 0
		     then record_offset, ddseg.next_offset = ddseg.next_offset + 16 - temp_slack;
		     else record_offset = ddseg.next_offset;

		     if cdtoken.options.input
		     then do;

			     dn_ptr = addr (icdhdr_type9);
			     ddseg.next_offset = ddseg.next_offset + 60;
			     temp = 87;

			end;
		     else do;

			     dn_ptr = addr (ocdhdr_type9);
			     ddseg.next_offset = ddseg.next_offset + 20;
			     ocdhdr_type9.binary_max_station_count = cdtoken.mdest;

			     call bin_to_dec (cdtoken.mdest, temp_char5, temp);

			     ocdhdr_type9.max_station_count = "0000";
			     substr (ocdhdr_type9.max_station_count, 5 - temp, temp) = temp_char5;
			     temp = 10 + 13 * cdtoken.mdest;

			end;

		     data_name.offset = record_offset;

		     call mc_initval_seg2;

		     if cobol_$coms_wdoff = 0
		     then cobol_$coms_wdoff = divide (record_offset, 4, 35, 0);

		     record_offset = ddseg.next_offset; /* offset of data i.e. following header */
		     cdtoken.cd_seg = record_segment;
		     cd_offsets (cdtoken.cd_num), cdtoken.cd_off = record_offset;

		     if cdtoken.options.initial
		     then do;

			     fixed_common.init_cd_seg = record_segment;
			     fixed_common.init_cd_offset = record_offset;

			end;

		     ddseg.next_offset = ddseg.next_offset + temp;
		     cobol_$coms_charcnt = cobol_$coms_charcnt + temp;
		     cobol_$cd_cnt = cobol_$cd_cnt + 1;

		end;

	     else if data_name.type = 12 | data_name.type = 16
	     then do;				/* file-name */

		     name_ptr = dn_ptr;

		     if fd_token.file_no > 0
		     then do;

			     call cobol_read_ft_ (fd_token.file_no, ft_ptr);

			     file_table.locate_mode = "0"b;
			     temp_slack = mod (ddseg.next_offset, 8);

			     if temp_slack > 0
			     then record_offset = ddseg.next_offset + 8 - temp_slack;
			     else record_offset = ddseg.next_offset;

			     if file_table.same_rec_clause ^= 0
			     then do;

				     i = file_table.same_rec_clause;

				     if same_rec_area_info.seg_num (i) = 0
				     then do;	/* hasn't been allocated yet */

					     same_rec_area_info.seg_num (i) = record_segment;
					     same_rec_area_info.offset (i) = record_offset;
					     ddseg.next_offset =
						record_offset + same_rec_area_info.cra_size (i);
					     cobol_$fs_charcnt =
						cobol_$fs_charcnt + same_rec_area_info.cra_size (i);

					end;

				     file_table.cra_seg = same_rec_area_info.seg_num (i);
				     file_table.cra_offset = same_rec_area_info.offset (i);

				end;
			     else do;

				     file_table.cra_seg = record_segment;
				     file_table.cra_offset = record_offset;
				     ddseg.next_offset = record_offset + file_table.max_cra_size;
				     cobol_$fs_charcnt = cobol_$fs_charcnt + file_table.max_cra_size;

				end;

			     if cobol_$fs_wdoff = 0
			     then cobol_$fs_wdoff = divide (file_table.cra_offset, 4, 35, 0);
			end;

		     call set_file_table;

		end;



	     call cobol_ntio$sget (dn_ptr, eof);
	     ;

	end;

	if procname_sw > 0
	then do;					/* output END COBOL. minpral */

		reswd.key = reswd_END;
		reswd.class = "000100010000100000010000000"b;

		call put_rw_token;

		reswd.key = reswd_COBOL;
		reswd.class = "000010000000000000010000000"b;

		call put_rw_token;

		reswd.key = reschar_PERIOD;
		reswd.class = "000100000000000000000000000"b;

		call put_rw_token;

	     end;

	con_wd_off = con_wd_off + 1;
	cobol_$cobol_data_wd_off = cobol_$cobol_data_wd_off + divide (ddseg.next_offset, 4, 35, 0) + 1;

	if cobol_$coms_wdoff = 0
	then cobol_$coms_wdoff = divide (ddseg.next_offset, 4, 35, 0);
	if cobol_$ws_wdoff = 0
	then cobol_$ws_wdoff = cobol_$coms_wdoff;
	if cobol_$fs_wdoff = 0
	then cobol_$fs_wdoff = cobol_$ws_wdoff;


	call cobol_vdwf_sput (cobol_ext_$cobol_cmfp, st, addr (ddseg), ddseg_size, fixed_common.seg_info);

	return;



set_file_table:
     proc;

	if (file_table.variable_recs | file_table.spanned_recs)
	     | (^file_table.fixed_recs & (file_table.unequal_recs | file_table.rec_do))
	then do;

		file_table.record_format = file_table.record_format + 100;
		file_table.variable = "1"b;

		if file_table.rec_max > 0
		then if file_table.rec_min = 0
		     then call issue_file_diag (warn_MIN_RECSIZE_MISSING);

	     end;

	if file_table.rec_max > 0
	then do;					/* RECORD CONTAINS specified */

		if ^file_table.rec_do
		then if file_table.rec_max ^= file_table.max_cra_size
		     then do;

			     call issue_file_diag (warn_RECSIZE_INCONSISTENT);

			     if file_table.rec_max > file_table.max_cra_size
			     then do;

				     call issue_file_diag (obs_CRASIZE_ADJUSTED);

				     file_table.max_cra_size = file_table.rec_max;

				end;
			     else do;

				     call issue_file_diag (obs_RECSIZE_ADJUSTED);

				     file_table.rec_max = file_table.max_cra_size;

				end;
			end;
	     end;

	if file_table.device = 5
	then do;					/* TAPE */

		if file_table.max_cra_size < 18
		then do;

			call issue_file_diag (warn_RECSIZE_TOO_SMALL);
			call issue_file_diag (obs_RECSIZE_ADJUSTED);

			file_table.max_cra_size = 18;

		     end;
		else do;

			if file_table.variable_recs
			then do;
				if file_table.max_cra_size > 8188
				then do;

					call issue_file_diag (warn_VLR_RECSIZE_EXCEEDED);
					call issue_file_diag (obs_RECSIZE_ADJUSTED);

					file_table.max_cra_size = 8188;

				     end;
			     end;
			else if file_table.spanned_recs
			then do;

				if file_table.max_cra_size > 1044480
				then do;

					call issue_file_diag (warn_SPANNED_RECSIZE_EXCEEDED);
					call issue_file_diag (obs_RECSIZE_ADJUSTED);

					file_table.max_cra_size = 1044480;

				     end;
			     end;
			else if file_table.max_cra_size > 8192
			then do;			/* FLR assumed */

				call issue_file_diag (warn_FLR_RECSIZE_EXCEEDED);
				call issue_file_diag (obs_RECSIZE_ADJUSTED);

				file_table.max_cra_size = 8192;

			     end;
		     end;

		if file_table.block_desc = 1
		then if file_table.block_max < 18
		     then do;

			     call issue_file_diag (warn_BLKSIZE_TOO_SMALL);
			     call issue_file_diag (obs_BLKSIZE_ADJUSTED);

			     file_table.block_max = 18;

			end;

		if file_table.block_desc = 1
		then do;				/* block size given in characters */

			if file_table.block_max < file_table.max_cra_size
			then if ^file_table.spanned_recs
			     then do;

				     call issue_file_diag (warn_BLKSIZE_LESS_THAN_RECSIZE);
				     call issue_file_diag (obs_BLKSIZE_ADJUSTED);

				     file_table.block_max = file_table.max_cra_size;

				end;
			     else ;
			else if file_table.fixed_recs
			then do;

				if mod (file_table.block_max, file_table.max_cra_size) ^= 0
				then do;

					call issue_file_diag (warn_BLKSIZE_NOT_MULT_OF_RECSIZE);
					call issue_file_diag (obs_BLKSIZE_ADJUSTED);

					file_table.block_max =
					     divide (file_table.block_max, file_table.max_cra_size, 35, 0)
					     * file_table.max_cra_size;

				     end;

			     end;
		     end;
	     end;
	else do;					/* not TAPE */

		if file_table.block_desc > 0
		then call issue_file_diag (obs_BLOCKING_IGNORED);

	     end;

	if (file_table.block_desc = 2 & file_table.block_max > 1)
	     | (file_table.block_desc = 1 & file_table.block_max > file_table.max_cra_size)
	then do;

		file_table.record_format = file_table.record_format + 1;
		file_table.blocked = "1"b;

	     end;

	file_table.record_format = file_table.record_format + 1;

	if file_table.device = 2 | file_table.device = 3
	then do;

		if file_table.max_cra_size > 80
		then call issue_fd_diag (warn_REC_EXCEEDS_DEVICE_LIMIT);

	     end;

	else if file_table.device = 1
	then do;					/* PRINTER */

		if file_table.max_cra_size > 132
		then call issue_fd_diag (warn_REC_EXCEEDS_DEVICE_LIMIT);

	     end;

     end set_file_table;



put_rw_token:
     proc;

	call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (reswd), reswd.size);

     end put_rw_token;



set_size:
     proc;

dcl	rec_off		fixed bin;
dcl	next_rec_off	fixed bin;
dcl	cur_lev		fixed bin;
dcl	occ_lev		fixed bin;
dcl	sign_lev		fixed bin;
dcl	(n, fill)		fixed bin;

dcl	code_set_sw	bit (1);
dcl	sync_bits		bit (5) unal based;
dcl	(comp7_sync, comp8_sync)
			bit (1);

dcl	(N, R)		ptr;

	comp7_sync, comp8_sync = "0"b;
	rec_off, next_rec_off, occ_lev, n = 0;


	code_set_sw = "0"b;

	if current_fno > 0
	then code_set_sw = file_table.code_set_clause;

	cur_lev = 1;
	sign_lev = 0;
	stk.son_cnt (0) = 0;
	stk.level (0) = 0;
	stk.offset (1) = 0;

/*[5.1-1]*/
	addr (stk_occurs (0)) -> bit100 = "0"b;


	do while (cur_lev > 0);

	     /***.....if Trace_Bit="1"b/**/
	     /***.....then do;/**/
	     /***.....   call ioa_("^a(^d)",substr(Trace_Line,1,Trace_Lev),cur_lev);/**/
	     /***.....   Trace_Lev=Trace_Lev+3;/**/
	     /***.....     end;/**/
/* PUSH */

	     do while (cur_lev > stk.level (n));


		n = n + 1;
		/***.....   if Trace_Bit="1"b then call ioa_("^a(^d)^p",substr(Trace_Line,1,Trace_Lev),n,N);/**/

		stk.son_cnt (n), stk.init_slack (n) = 0;
		stk.son_cnt (n - 1) = stk.son_cnt (n - 1) + 1;
		stk.nt_ptr (n) = dn_ptr;
		addr (data_name.bitt) -> sync_bits = ""b;
		stk.level (n) = data_name.level;

		if data_name.non_elementary
		then if n = 1
		     then do;

			     data_name.double_word = "1"b;
			     stk.bound (1) = 16;

			end;
		     else do;			/* non-elementary with level greater than 01 */

			     data_name.byte = "1"b;
			     stk.bound (n) = 2;

			end;

		else do;				/* elementary */

			if code_set_sw
			then if ^data_name.display | (data_name.item_signed & ^data_name.sign_separate)
			     then call issue_diag (warn_CODE_SET_VIOLATION, dn_ptr);

			if data_name.numeric & data_name.item_signed
			then if n > sign_lev
			     then sign_lev = n;

			stk.size (n) = data_name.item_length * 2;

			if data_name.display | data_name.comp | data_name.ascii_packed_dec
			then do;

				data_name.byte = "1"b;
				stk.bound (n) = 2;

			     end;
			else if data_name.ascii_packed_dec_h
			then do;

				data_name.ascii_packed_dec = "1"b;

				if data_name.sync | comp8_sync
				then do;		/* either this or last one */

					data_name.byte = "1"b;
					stk.bound (n) = 2;

				     end;
				else do;

					data_name.bitt = "1"b;
					stk.bound (n) = 1;

				     end;

				stk.size (n) = data_name.places_left + data_name.places_right;

				if data_name.item_signed
				then do;

					stk.size (n) = stk.size (n) + 1;
					data_name.sign_type = "100"b;
						/* leading separate */

				     end;
			     end;

			else if data_name.bin_18
			then do;

				if data_name.sync
				then do;

					data_name.word = "1"b;
					stk.bound (n) = 8;
					comp7_sync = "1"b;
						/* indicate offset adj needed */
					stk.size (n) = 8;
						/* allocate full word */

				     end;
				else do;

					data_name.half_word = "1"b;
					stk.bound (n) = 4;

				     end;
			     end;
			else if data_name.usage_index
			then do;

				data_name.double_word = "1"b;
				stk.bound (n) = 16;

			     end;
			else do;			/* bin_36 or anything else	*/

				data_name.word = "1"b;
				stk.bound (n) = 8;

			     end;

			if n = 1
			then do;

				addr (data_name.bitt) -> sync_bits = ""b;
						/* undo any previous determination */
				data_name.double_word = "1"b;
						/* in case of redefinition or argument usage */
				stk.bound (n) = 16;

			     end;
		     end;

		if ^data_name.non_elementary & (data_name.level = 01 | data_name.level = 77)
		then do;

			cur_lev = 0;
			call GET;

		     end;
		else do;




			stk.max_bound (n) = stk.bound (n);

			if data_name.exp_redefining
			then do;

/*[3.0-2]*/
				stk.son_cnt (n - 1) = stk.son_cnt (n - 1) - 1;
				rec_off = stk.redef_offset (n);

			     end;

/*[5.1-1]*/
			else stk.redef_offset (n) = rec_off;








			temp_mod = mod (rec_off, stk.bound (n));

			if temp_mod > 0
			then do;

/*[5.1-1]*/
				stk.init_slack (n) = stk.bound (n) - temp_mod;
						/*[5.1-1]*/
				rec_off = rec_off + stk.init_slack (n);

				if data_name.sync
				then temp = obs_EXPLICIT_SYNC;
				else if comp8_sync
				then temp = obs_PREVIOUS_SYNC;
				else do;

					if data_name.non_elementary
					then temp = obs_IMPLICIT_SYNC_FOR_GROUP;
					else if data_name.display
					then temp = obs_IMPLICIT_SYNC_FOR_DISPLAY;
					else temp = obs_IMPLICIT_SYNC;

				     end;

				call issue_diag (temp, dn_ptr);

			     end;

/*[5.1-1]*/
			if hisi_slack		/*[5.1-1]*/
			then do;
				if data_name.elementary
						/*[5.1-1]*/
				then do;
					stk.offset (n) = rec_off;
						/*[5.1-1]*/
					data_name.offset = divide (rec_off, 2, 35, 0);
						/*[5.1-1]*/
					m = n - 1;

/*[5.1-1]*/
					if m > 0
					then call inherit_offset;
						/*[5.1-1]*/
				     end;

/*[5.1-1]*/
			     end;			/*[5.1-1]*/
			else do;

				stk.offset (n) = rec_off;
				data_name.offset = divide (rec_off, 2, 35, 0);

/*[5.1-1]*/
			     end;

			if mod (rec_off, 2) = 1
			then data_name.bit_offset = "0101"b;
			else data_name.bit_offset = "0000"b;




			stk_occurs (n) = "0"b;	/* set only for explicit occurs */

			if data_name.occurs_ptr ^= 0
			then do;

				stk.occ_ptr (n), occurs_ptr = addr (nt_array (data_name.occurs_ptr));

				if occurs.dimensions > occ_lev
				then do;

					occ_lev = occ_lev + 1;
					stk_occurs (n) = "1"b;

					if occurs.level.max (occurs.dimensions) > 0
					then stk.max_occ (n) = occurs.level.max (occurs.dimensions);
					else stk.max_occ (n) = occurs.level.min (occurs.dimensions);

				     end;
			     end;

			if data_name.ascii_packed_dec_h & data_name.sync
			then comp8_sync = "1"b;	/* indicate NEXT item must be byte aligned */
			else comp8_sync = "0"b;

			found = "0"b;

			do while (cur_lev > 0 & ^found);

			     call GET;

			     if eof ^= 0
			     then cur_lev = 0;
			     else if data_name.type = 12 | data_name.type = 16
			     then cur_lev = 0;
			     else if data_name.type = 9
			     then do;

				     if data_name.level = 01 | data_name.level = 66 | data_name.level = 77
				     then cur_lev = 0;
				     else do;

					     found = "1"b;
					     cur_lev = data_name.level;

					end;

				end;
			end;

		     end;

		if comp7_sync
		then do;

			stk.nt_ptr (n) -> data_name.offset = stk.nt_ptr (n) -> data_name.offset + 2;
			comp7_sync = "0"b;

		     end;
	     end;

	     /***.....if Trace_Bit="1"b then Trace_Lev=Trace_Lev-3;/**/

	     do while (cur_lev <= stk.level (n) & n > 0);
		N = stk.nt_ptr (n);
		/***.....if Trace_Bit="1"b/**/
		/***..... then do;/**/
		/***.....   call ioa_("^a^a^x^d",substr(Trace_Line,1,Trace_Lev),"LEVEL:",cur_lev);/**/
		/***.....   call ioa_("^a(^d)^p",substr(Trace_Line,1,Trace_Lev),n,N);/**/
		/***.....      end;/**/

		if N -> data_name.non_elementary
		then do;

			temp_size = rec_off - stk.offset (n);
			temp_size = temp_size + mod (temp_size, 2);

			N -> data_name.item_length = divide (temp_size, 2, 35, 0);


			if n < sign_lev
			then N -> data_name.item_signed = "1"b;

/* contains signed data */

			N -> data_name.son_cnt = substr (unspec (stk.son_cnt (n)), 21, 16);

		     end;

		else temp_size = stk.size (n);

		if stk_occurs (n)
		then do;



			temp_mod = mod (temp_size, stk.max_bound (n));

			if temp_mod > 0
			then do;

/*[5.1-1]*/
				fill = stk.max_bound (n) - temp_mod;
				temp_size = temp_size + fill;

				call issue_diag (obs_IMPLICIT_SYNC_IN_ARRAY, stk.nt_ptr (n));

			     end;			/*[5.1-1]*/
			else fill = 0;

			occurs_ptr = stk.occ_ptr (n);
			occurs.level.struc_length (occurs.dimensions) = temp_size;

			rec_off = rec_off + temp_size * (stk.max_occ (n) - 1);

			if ^N -> data_name.non_elementary
			then rec_off = rec_off + temp_size;
						/* add size of one more element */
						/*[5.1-1]*/
			else rec_off = rec_off + mod (rec_off, 2) + fill;


/*[3.0-1]*/
			temp_size = temp_size * stk.max_occ (n);

/*[5.1-1]*/
			if hisi_slack		/*[5.1-1]*/
			then N -> data_name.item_length = N -> data_name.item_length + divide (fill, 2, 31, 0);
						/*[5.1-1]*/
			else rec_off = rec_off - fill;

			occ_lev = occ_lev - 1;

		     end;
		else if ^N -> data_name.non_elementary
		then rec_off = rec_off + temp_size;
		else rec_off = rec_off + mod (rec_off, 2);

/* integral number of bytes in all groups */


		stk.max_bound (n - 1) = max (stk.max_bound (n - 1), stk.max_bound (n));

		if N -> data_name.exp_redefining
		then do;

			R = stk.redef_ptr (n);	/*[5.1-1]*/
			temp_size = temp_size + stk.init_slack (n);




			if R ^= null ()		/* possible only if error in source */
			then if n = 1		/* level 01 */
			     then if temp_size > stk.redef_size (n)
				then if R -> data_name.file_num = 0
				     then do;

					     call issue_diag (obs_GREATER_SIZE_REDEFINES, N);

					     R -> data_name.max_red_size =
						max (R -> data_name.max_red_size, N -> data_name.item_length);

					end;

				     else ;	/* size greater,but in a file - OK */

				else ;		/* size unequal,but not greater - OK */

			     else do;		/* not a level 01 - an error in any case */

				     if rec_off ^= stk.next_rec_off (n)
				     then call issue_diag (warn_UNEQUAL_SIZE_REDEFINES, stk.nt_ptr (n));

				     if rec_off > stk.next_rec_off (n)
				     then call issue_diag (obs_ALLOC_ADJUSTED, stk.redef_ptr (n));

				     rec_off, stk.next_rec_off (n) = max (rec_off, stk.next_rec_off (n));




				end;



		     end;

/*[5.1-1]*/
		else do;
			stk.next_rec_off (n) = rec_off;

			stk.redef_size (n) = temp_size;
			N -> data_name.max_red_size = N -> data_name.item_length;

			if stk_occurs (n)
			then stk.redef_ptr (n) = null ();
			else stk.redef_ptr (n) = N;

/*[5.1-1]*/
		     end;

		n = n - 1;
		/***.....if Trace_Bit="1"b/**/
		/***.....  then do;/**/
		/***.....   if N->data_name.bit_offset=""b then Off="BYTE OFFSET:"; else Off="DIGIT OFFSET:";/**/
		/***.....   call ioa_$nnl("^a^a^x^a^x^a^x^d^x",substr(Trace_Line,1,Trace_Lev)/**/
		/***.....                       ,"NAME:",substr(N->data_name.name,1,N->data_name.name_size)/**/
		/***.....                         ,Off,N->data_name.offset);/**/
		/***.....   call ioa_("^a^x^d","SIZE:",N->data_name.item_length);/**/
		/***.....       end;/**/
	     end;

	end;

     end set_size;

/*[5.1-1]*/



inherit_offset:
     proc;

declare	(off, stk_off)	fixed bin,
	p		ptr;
declare	OFF		fixed bin based (p);

	off = data_name.offset;
	stk_off = 2 * off;

	do while ("1"b);

	     p = addr (stk.nt_ptr (m) -> data_name.offset);

	     if OFF < 0
	     then do;
		     OFF = off;
		     stk.offset (m) = stk_off;
		end;
	     else return;

	     m = m - 1;

	     if m = 0
	     then return;

	end;

     end;

GET:
     proc;

	call cobol_ntio$sget (dn_ptr, eof);

	if hisi_slack & eof = 0
	then if data_name.type = 9 & data_name.non_elementary
	     then do;
		     data_name.offset = -1;
		     data_name.item_length = 0;
		end;

     end;

/*[5.1-1]*/



test_occurs:
     proc;

/* test_occurs maintains the occurs_info table and checks the current data item to see if it is
subscripted.  if it is,the OCCURS extension for the item is updated.  if the item has an
explicit OCCURS clause(rather than simply being subordinate to an OCCURring item),a
compute-subscript-word is allocated for the clause; and a new entry is added to the occurs_info
table so that items subordinate to the new OCCURS clause can be properly patched */

start_test_occurs:
	if occurs_level = 0
	then go to test_item;			/* go if no entries in occurs_info table */

	if data_name.level > occurs_info.level (occurs_level)
	then go to test_item;

/* all current entries
		in occurs_info table must still apply to current item if this condition is met */

	occurs_level = occurs_level - 1;

	go to start_test_occurs;

test_item:
	if data_name.subscripted = "0"b
	then return;

/* set occurs_ptr to point to OCCURS extension for current item */

	occurs_ptr = addr (nt_array (data_name.occurs_ptr));

/* go to update_occ_ext if this item does not have an explicit OCCURS clause */

	if occurs.dimensions ^> occurs_level
	then go to update_occ_ext;

/* add new entry in occurs_info table for this item's OCCURS clause */

	occurs_level = occurs_level + 1;
	occurs_info.level (occurs_level) = data_name.level;
	occurs_info.struclength (occurs_level) = occurs.level.struc_length (occurs.dimensions);

/* occurs.level.struc_length of minor /* occurs.level filled by set_size,if set_size
			 is executed for this record.  Otherwise the value is left from ddsyntax */

	if data_name.occurs_do = "0"b
	then go to update_occ_ext;

	call odo_item;				/* generate size routine for this item */

	if data_name.linkage_section = "1"b
	then go to link_odo;

	odo_rec_ptr -> odo_rec.seg_no = record_segment;
	odo_rec_ptr -> odo_rec.offset_l = data_name.offset + record_offset;

	odo_rec_ptr -> odo_rec.offset_r =
	     odo_rec_ptr -> odo_rec.offset_l
	     + divide (occurs.level.struc_length (occurs.dimensions), 2, 35, 0)
	     * (occurs.level.max (occurs.dimensions) - 1) + data_name.item_length - 1;

	go to replace_odo_rec;

link_odo:
	odo_rec_ptr -> odo_rec.seg_no = fixed_common.number_of_ls_pointers + 20000;

/* add 20000 to identify link sec item */

	odo_rec_ptr -> odo_rec.offset_l = data_name.offset;
	odo_rec_ptr -> odo_rec.offset_r =
	     data_name.offset
	     + divide (occurs.level.struc_length (occurs.dimensions), 2, 35, 0)
	     * (occurs.level.max (occurs.dimensions) - 1) + data_name.item_length - 1;

replace_odo_rec:
	call cobol_vdwf_dput (cobol_ext_$cobol_cmfp, st, odo_rec_ptr, odo_recsize, odo_key);


update_occ_ext:
	do i = 1 to occurs.dimensions;
	     occurs.level.struc_length (i) = occurs_info.struclength (i);
	end;

/*	
call cobol_vdwf_dput(cobol_ext_$cobol_name_fileno,st,dn_ptr,name_recsize,name_key);  */

     end test_occurs;




variable_size:
     proc;

/* variable_size is 
called when a variable-length item is encountered during the second pass

(allocation pass) over the name table.  If the item has variable length because it contains an
OCCURS  DEPENDING ON item,the procedure number of the appropriate size routine is filled into
the size_rtn field in the name table entry for the variable-length item.  If the item has
variable length because it has a PICTURE  DEPENDING ON clause,its size routine is created
in the minpral-2 file.  The size routine generated for a PICTURE  DEPENDING ON item consists
of a paragraph header followed by the statement IF DO-item < 1 OR DO-item > max-item-size
DISPLAY "out-of-range depending on item" ELSE SUBTRACT DO-item FROM max-item-size GIVINGresult-field */

/*	if ^data_name.pic_has_l then do;	*/

	if odo_proc_num = 0
	then do;

		fixed_common.spec_tag_counter = fixed_common.spec_tag_counter + 1;
		odo_proc_num = fixed_common.spec_tag_counter;
		odo_do_rec = data_name.do_rec;	/* save key in common of odo_rec entry for this item */

	     end;

	data_name.size_rtn = odo_proc_num;		/* set with procno of size rtn to be generated */

/**/
/*	end;
/*	else do;					/* picture has L */
/*		
call gen_true_path(0);			/* generate first half of IF statement */

/*		reswd.key = reswd_SUBTRACT;
/*		reswd.class = "100100000000000000110000000"b;
/*		
call put_rw_token;

/*
/*		
call issue_name;

/*
/*		reswd.key = reswd_FROM;
/*		reswd.class = "000000000000000000110000000"b;
/*		
call put_rw_token;

/* 
/*		
call bin_to_dec(data_name.item_length,sizertn_numlit.literal,sizertn_numlit.places);

/*		sizertn_numlit.size = numlit_size + sizertn_numlit.places;
/*		sizertn_numlit.places_left = sizertn_numlit.places;
/*		
call cobol_swf_put(cobol_ext_$cobol_m2fp,st,addr(numlit),numlit.size);

/* 
/*		reswd.key = reswd_GIVING;
/*		reswd.class = "000000000000000000010000000"b;
/*		
call put_rw_token;

/* 
/*		
call cobol_swf_put(cobol_ext_$cobol_m2fp,st,addr(sizedn),sizedn.size);

/*
/*		reswd.key = reschar_PERIOD;
/*		reswd.class = "000100000000000000000000000"b;
/*		
call put_rw_token;

/*	end;
/**/
	return;

     end variable_size;




odo_item:
     proc;

/* odo_item generates the size routine needed for an OCCURS  DEPENDING ON item.  The size routine
	generated for an OCCURS  DEPENDING ON item consists of a paragraph header followed by the
	statement IF DO-item < minimum-number-of-occurrences OR DO-item > maximum-number-of-occurrences
	DISPLAY "out-of-range depending on item" ELSE COMPUTE result-field EQUALS structure-length *
				(maximum-number-of-occurrences - DO-item). */

	call gen_true_path (1);


	reswd.key = reswd_COMPUTE;
	reswd.class = "100100100000000000110000000"b;

	call put_rw_token;



	call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (sizedn), sizedn.size);


	reswd.key = reswd_EQUALS;			/*[4.2-3]*/
	reswd.class = "000001100000000000011000000"b;

	call put_rw_token;


	call bin_to_dec (divide (occurs.level.struc_length (occurs.dimensions), 2, 24, 0), sizertn_numlit.literal,
	     sizertn_numlit.places);
	sizertn_numlit.size = numlit_size + sizertn_numlit.places;
	sizertn_numlit.places_left = sizertn_numlit.places;

	call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (sizertn_numlit), sizertn_numlit.size);


	reswd.key = reschar_STAR;
	reswd.class = "010000000000000000000000000"b;

	call put_rw_token;


	reswd.key = reschar_LPARENS;
	reswd.class = "000000000000000000000000000"b;

	call put_rw_token;



	call bin_to_dec (occurs.level.max (occurs.dimensions), sizertn_numlit.literal, sizertn_numlit.places);

	sizertn_numlit.size = numlit_size + sizertn_numlit.places;
	sizertn_numlit.places_left = sizertn_numlit.places;

	call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (sizertn_numlit), sizertn_numlit.size);


	reswd.key = reschar_MINUS;
	reswd.class = "010000000000000000000000000"b;

	call put_rw_token;



	call issue_name;				/* write out name of DEPENDING ON item */


	reswd.key = reschar_RPARENS;
	reswd.class = "000000000000000000000000000"b;

	call put_rw_token;


	reswd.key = reschar_PERIOD;
	reswd.class = "000100000000000000000000000"b;

	call put_rw_token;


	return;

     end odo_item;



gen_true_path:
     proc (calling_param);



/* gen_true_path generates the first part of the size routine produced for a variable-length item,
	consisting of the true path of the appropriate IF statement(see pic_l_item and odo_item). */


dcl	calling_param	fixed bin;


start_gen_true_path:				/**/
						/*	if 
calling_param = 0 then odo_key = data_name.do_rec;  /* picture has L */
						/*	else  */
	odo_key = odo_do_rec;			/* record contains depending on */

	call cobol_vdwf_dget (cobol_ext_$cobol_cmfp, st, odo_rec_ptr, odo_recsize, odo_key);


	call cobol_vdwf_dget (cobol_ext_$cobol_cmfp, st, depend_ptr, common_recsize, odo_rec_ptr -> odo_rec.descr);


/**/
/*	if 
	calling_param = 0 then do;

/*		fixed_common.spec_tag_counter = fixed_common.spec_tag_counter + 1;
/*		data_name.size_rtn = fixed_common.spec_tag_counter;
/*		
	call cobol_vdwf_dput(cobol_ext_$cobol_name_fileno,st,dn_ptr,name_recsize,name_key);

/*		procdef.proc_num = fixed_common.spec_tag_counter;
/*	end;
/*	else */

	procdef.proc_num = odo_proc_num;

	call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (procdef), procdef.size);
						/* write paragraph name */

/*[4.2-3]*/
	reswd.key = reschar_PERIOD;
	reswd.class = "0001"b;			/*[4.2-3]*/

	call put_rw_token;

/* add paragraph name to list of performed procedures */
	perform_ptr = addr (work_area);
	perform_entry.proc_number = procdef.proc_num;
	perform_entry.code = 0;
	perform_entry.next = "00000";
	perform_entry.next1 = "00000";
	perform_entry.priority = 0;
	perform_entry.address = 0;

	call cobol_vdwf_sput (cobol_ext_$cobol_cmfp, st, perform_ptr, perform_size, common_key);

	if fixed_common.size_perform_info = "00000"
	then fixed_common.size_perform_info = common_key;
	else do;

		call cobol_vdwf_dget (cobol_ext_$cobol_cmfp, st, work_ptr, common_recsize, last_perform_key);

		work_ptr -> perform_entry.next = common_key;

		call cobol_vdwf_dput (cobol_ext_$cobol_cmfp, st, work_ptr, common_recsize, last_perform_key);

	     end;

	last_perform_key = common_key;

	if fixed_common.options.oc
	then do;					/* generate code to check result */

		reswd.key = reswd_MOVE;
		reswd.class = "100100100000000000110000000"b;

		call put_rw_token;


		reswd.key = reswd_ZERO;
		reswd.class = "001000000000000000010000000"b;
		reswd.jump_index = 1;

		call put_rw_token;

		reswd.jump_index = 0;

		reswd.key = reswd_TO;
		reswd.class = "000000000000000000010000000"b;

		call put_rw_token;



		call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (sizedn), sizedn.size);


		reswd.key = reswd_IF;
		reswd.class = "100100000000000000010000000"b;

		call put_rw_token;



		call issue_name;


		reswd.key = reschar_LT;		/*[4.2-3]*/
		reswd.class = "000011000000000000000000000"b;

		call put_rw_token;


/**/
/*		if 
calling_param = 0 then do;

/*		sizertn_numlit.size = numlit_size + 1;
/*		sizertn_numlit.places_left = 1;
/*		sizertn_numlit.places = 1;
/*		sizertn_numlit.literal = "1";
/*		end;
/*		else do;
/**/

		call bin_to_dec (occurs.level.min (occurs.dimensions), sizertn_numlit.literal, sizertn_numlit.places);

		sizertn_numlit.size = numlit_size + sizertn_numlit.places;
		sizertn_numlit.places_left = sizertn_numlit.places;
						/*		end;  */


		call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (sizertn_numlit), sizertn_numlit.size);


		reswd.key = reswd_OR;
		reswd.class = "000000000000000000010000000"b;

		call put_rw_token;



		call issue_name;


		reswd.key = reschar_GT;		/*[4.2-3]*/
		reswd.class = "000011000000000000000000000"b;

		call put_rw_token;



		call bin_to_dec (occurs.level.max (occurs.dimensions), sizertn_numlit.literal, sizertn_numlit.places);

		sizertn_numlit.size = numlit_size + sizertn_numlit.places;
		sizertn_numlit.places_left = sizertn_numlit.places;

		call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (sizertn_numlit), sizertn_numlit.size);


		reswd.key = reswd_STOP;
		reswd.class = "100100100000000000110000000"b;

		call put_rw_token;



		call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (errormes_lit), errormes_lit.size);


		reswd.key = reswd_ELSE;
		reswd.class = "000000000000000000010000000"b;

		call put_rw_token;

	     end;
     end gen_true_path;



issue_name:
     proc;

/* issue_name is 
called during generation of a size routine for a variable-length item.  issue_name

writes the name of the DEPENDING ON item,including any specified qualifiers,out to the minpral-2 file. */

	usrwd.size = usrwd_size + depend_ptr -> obj_rec.size;
	usrwd.length = depend_ptr -> obj_rec.size;
	usrwd.word = substr (depend_ptr -> obj_rec.name, 1, depend_ptr -> obj_rec.size);

	call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (usrwd), usrwd.size);



	if depend_ptr -> obj_rec.qual = "00000"
	then return;


	call cobol_vdwf_dget (cobol_ext_$cobol_cmfp, st, qual_ptr, common_recsize, depend_ptr -> obj_rec.qual);


	reswd.key = reswd_OF;
	reswd.class = "000000000000000000010000000"b;

	do while ("1"b);


	     call put_rw_token;			/* write out OF key */


	     usrwd.size = usrwd_size + qual_ptr -> qual_rec.size;
	     usrwd.length = qual_ptr -> qual_rec.size;
	     usrwd.word = substr (qual_ptr -> qual_rec.name, 1, qual_ptr -> qual_rec.size);


	     call cobol_swf_put (cobol_ext_$cobol_m2fp, st, addr (usrwd), usrwd.size);


/* write out qualifier */

	     if qual_ptr -> qual_rec.next = "00000"
	     then return;


	     call cobol_vdwf_dget (cobol_ext_$cobol_cmfp, st, qual_ptr, common_recsize, qual_ptr -> qual_rec.next);


	end;

     end issue_name;




/* bin_to_dec converts the value in a 15-bit fixed binary field to its decimal equivalent. */

b_to_d:
     entry (btd_i, btd_o, btd_s);

dcl	btd_i		fixed bin;
dcl	btd_o		char (5);
dcl	btd_s		fixed bin;


	call bin_to_dec (btd_i, btd_o, btd_s);

	return;



bin_to_dec:
     proc (bd_input, bd_output, bd_size);

dcl	bd_input		fixed bin;
dcl	bd_output		char (5);
dcl	bd_size		fixed bin;
dcl	bd_work1		fixed bin;
dcl	bd_work2		fixed bin;
dcl	result		char (4) based (addr (bd_work2));
dcl	bd_work3		char (5);
dcl	loc		fixed bin;

	loc = 6;

	if bd_input = 0
	then do;

		bd_size = 1;
		bd_output = "0";
		return;

	     end;

	bd_work1 = bd_input;

	do while (bd_work1 > 0);

	     bd_work2 = mod (bd_work1, 10) + 48;
	     loc = loc - 1;
	     substr (bd_work3, loc, 1) = substr (result, 4, 1);
	     bd_work1 = divide (bd_work1, 10, 15, 0);
	end;

	bd_size = 6 - loc;
	bd_output = substr (bd_work3, loc);

     end bin_to_dec;




issue_fd_diag:
     proc (diag_no);

dcl	diag_no		fixed bin;

	diag.line = dn_ptr -> fd_token.def_line;
	diag.column = 8;
	diag.number = diag_no;

	call cobol_c_list (addr (diag));		/* issue diagnostic */

     end issue_fd_diag;

issue_file_diag:
     proc (diag_no);

dcl	diag_no		fixed bin;

	diag.line = dn_ptr -> fd_token.line;
	diag.column = dn_ptr -> fd_token.column;
	diag.number = diag_no;

	call cobol_c_list (addr (diag));

     end issue_file_diag;

issue_diag:
     proc (diag_no, dn_ptr);

dcl	diag_no		fixed bin;
dcl	dn_ptr		ptr;

	diag.line = dn_ptr -> data_name.line;
	diag.column = dn_ptr -> data_name.column;
	diag.number = diag_no;

	call cobol_c_list (addr (diag));

     end issue_diag;



mc_initval_seg2:
     proc;

/* This procedure will generate tokens to a separate minpral file
				for initial value non-constant items during a MCOBOL run.
			*/

dcl	keyindex		(7) fixed bin;

	keyindex (1) = reswd_ZERO;
	keyindex (2) = reswd_SPACE;
	keyindex (3) = 999;				/* upper-bound */
	keyindex (4) = 999;				/* lower-bound */
	keyindex (5) = reswd_HIGH_VALUE;
	keyindex (6) = reswd_LOW_VALUE;
	keyindex (7) = reswd_QUOTE;

	valueptr = addr (dn (data_name.initial_ptr));
	cobol_$data_init_flag = cobol_$data_init_flag + 1;/* current count of Cobol data items to be initialized */
	reswd.key = reswd_MOVE;
	reswd.class = "100100100000000000110000000"b;



	call cobol_swf_put (cobol_$initval_file_ptr, st, addr (reswd), reswd.size);
						/*write key */


	if data_name.value_numeric
	then do;					/* numeric literal */

		numlit.size = numlit_size + numinit.length;
						/* type 2 numeric value */
		numlit.places = numinit.length;
		numlit.places_left = numinit.ltdp;
		substr (numlit.literal, 1, numinit.length) = substr (numinit.literal, 1, numinit.length);
		numlit.info = string (numinit.info);
		numlit.sign = numinit.sign;
		numlit.exp_sign = numinit.expsign;
		numlit.exp_places = numinit.explaces;
		numlit.places_right = numinit.rtdp;


		call cobol_swf_put (cobol_$initval_file_ptr, st, addr (numlit), numlit.size);


	     end;

	else if alphainit.info.figconindex ^= "0000000"b
	then do;					/* figurative constant */

		reswd.key = keyindex (fixed (alphainit.info.figconindex, 18));
		reswd.class = "101000000000000000000000000"b;
		reswd.jump_index = 1;


		call cobol_swf_put (cobol_$initval_file_ptr, st, addr (reswd), reswd.size);


		reswd.jump_index = 0;

	     end;
	else do;					/* nonnumeric literal */

		nonnumlit.size = nonnumlit_size + alphainit.length;
		nonnumlit.length = alphainit.length;

		substr (nonnumlit.string, 1, alphainit.length) = substr (alphainit.string, 1, alphainit.length);

		if alphainit.allit = "1"b
		then nonnumlit.info = "01000000"b;
		else nonnumlit.info = "00000000"b;


		call cobol_swf_put (cobol_$initval_file_ptr, st, addr (nonnumlit), nonnumlit.size);


	     end;

/*[4.2-1]*/
	sv_bit = data_name.just_right;
	data_name.just_right = "0"b;

	if data_name.numeric ^= "1"b
	then do;

		valhd_ptr = addr (data_name.numeric);
		valhd = substr (valhd_ptr -> valhd_based, 1, 6);
		substr (valhd_ptr -> valhd_based, 1, 6) = "001000"b;
		valhdbit = data_name.variable_length;
		data_name.variable_length = "0"b;


		call cobol_swf_put (cobol_$initval_file_ptr, st, dn_ptr, data_name.size);


		data_name.variable_length = valhdbit;
		substr (valhd_ptr -> valhd_based, 1, 6) = valhd;

	     end;
	else call cobol_swf_put (cobol_$initval_file_ptr, st, dn_ptr, data_name.size);


/*[4.2-1]*/
	data_name.just_right = sv_bit;

	do ieos = 1 to 10;				/* initialize EOS token to zeros */
						/*MCO*/

	     eos_token (ieos) = 0;

dcl	ieos		fixed bin (24);

	end;

	eos_ptr = addr (eos_token);
	end_stmt.type = 19;
	end_stmt.verb = 18;
	end_stmt.e = 1;
	end_stmt.size = 38;


	call cobol_swf_put (cobol_$initval_file_ptr, st, eos_ptr, end_stmt.size);
						/* type19 EOS */


dcl	eos_token		(10) fixed bin (24);

     end mc_initval_seg2;

	/***.....	dcl Trace_Bit bit(1) static external;/**/
	/***.....	dcl Trace_Lev fixed bin static external;/**/
	/***.....	dcl Trace_Line char(60) static external;/**/
	/***.....	dcl ioa_ entry options(variable); /**/
	/***.....   dcl ioa_$nnl entry options(variable);/**/
	/***.....   dcl Off char(13);/**/

/*[4.2-1]*/
declare	sv_bit		bit (1);


dcl	temp_char5	char (5);
dcl	temp_size		fixed bin;
dcl	procname_sw	fixed bin;
dcl	temp		fixed bin;
dcl	eof		fixed bin;
dcl	temp_len		fixed bin (24);
dcl	temp_mod		fixed bin;
dcl	redef_object_offset fixed bin;
dcl	(curr_char_off, curr_wd_off, curr_char_pos)
			fixed bin;

dcl	cd_offsets	(-256:0) fixed bin;		/* 0 is invalid */

dcl	dn_ptr		ptr;			/* name table pointer */
dcl	com2_ptr		ptr;
dcl	valueptr		ptr;
dcl	valhd_ptr		ptr;
dcl	valhdbit		bit (1);
dcl	valhd		bit (6);
dcl	valhd_based	bit (6) based;
dcl	dn		(500) char (1) based (dn_ptr);
dcl	index_name_ptr	ptr;

dcl	ft_ptr		ptr;			/* pointer to current file table record in common */
dcl	save_red_nptr	ptr;
dcl	odo_rec_ptr	ptr;			/* pointer to odo_rec item */
dcl	depend_ptr	ptr;			/* pointer to obj_rec item */
dcl	qual_ptr		ptr;			/* pointer to qual_rec items in common */

dcl	1 rw_area,
	  2 dummy		(5) fixed bin,
	  2 verb		bit (27),
	  2 dummy1	fixed bin;

dcl	last_perform_key	char (5);
dcl	work_ptr		ptr;
dcl	name_ptr		ptr;
dcl	nt_buf		char (1000) based (dn_ptr);
dcl	nt_array		(1000) char (1) based (dn_ptr);
dcl	index_cnt		fixed bin;
dcl	index_ptr		(200) ptr;

dcl	1 same_rec_area_info
			(cobol_ext_$cobol_com_ptr -> fixed_common.sra_clauses),
	  2 clause_no	fixed bin,
	  2 cra_size	fixed bin (24),
	  2 seg_num	fixed bin,
	  2 offset	fixed bin (24);

dcl	1 occurs_info	(3),
	  2 level		fixed bin,
	  2 cswd_seg	fixed bin,
	  2 cswd_offset	fixed bin (24),
	  2 struclength	fixed bin;		/* character string work fields */
dcl	work_area		char (100);
dcl	index_area	char (120);
dcl	odo_key		char (5);
dcl	odo_do_rec	char (5);
dcl	common_recsize	fixed bin;
dcl	common_key	char (5);
dcl	name_recsize	fixed bin;
dcl	first_name_key	char (5) aligned;
dcl	file_key		char (5);
dcl	report_key	char (5);
dcl	group_key		char (5);
dcl	rec_offset	fixed bin (24);
dcl	record_offset	fixed bin (24);
dcl	temp_slack	fixed bin;
dcl	i		fixed bin;
dcl	occurs_level	fixed bin;
dcl	odo_proc_num	fixed bin;
dcl	odo_recsize	fixed bin;
dcl	ft_size		fixed bin;
dcl	current_fno	fixed bin;
dcl	st		bit (32);
dcl	(found, first_pop)	bit (1);

/*[5.1-1]*/
dcl	hisi_slack	bit (1),
	m		fixed bin;

/*[5.1-1]*/
dcl	bit32400		bit (32400) based,
	bit648		bit (648) based;		/*[5.1-1]*/
dcl	bit100		bit (100) based;

dcl	1 stk		(0:49),
	  2 nt_ptr	ptr,
	  2 redef_ptr	ptr,
	  2 occ_ptr	ptr,
	  2 level		fixed bin,
	  2 size		fixed bin,
	  2 offset	fixed bin,
	  2 bound		fixed bin,
	  2 max_bound	fixed bin,
	  2 max_occ	fixed bin,
	  2 redef_size	fixed bin,
	  2 son_cnt	fixed bin,		/*[5.1-1]*/
	  2 init_slack	fixed bin,		/*[5.1-1]*/
	  2 redef_offset	fixed bin,		/*[5.1-1]*/
	  2 next_rec_off	fixed bin;

/*[5.1-1]*/
dcl	1 STK		(0:49),
	  2 stk_occurs	bit (1),
	  2 redef_sw	bit (1);

dcl	1 procdef		static,
	  2 size		fixed bin init (53),
	  2 line		fixed bin init (0),
	  2 column	fixed bin init (0),
	  2 type		fixed bin init (7),
	  2 string_ptr	ptr init (null ()),
	  2 prev_rec	ptr init (null ()),
	  2 filler1	bit (4) init (""b),
	  2 section_name	bit (1),
	  2 filler2	bit (4) init (""b),
	  2 priority	char (2) init (""),
	  2 filler3	bit (9) init (""b),
	  2 section_num	fixed bin init (0),
	  2 proc_num	fixed bin,
	  2 def_line	fixed bin init (0),
	  2 name_size	fixed bin init (1),
	  2 name		char (1) init ("$");

dcl	1 reswd		static,
	  2 size		fixed bin init (28),
	  2 line		fixed bin init (0),
	  2 column	fixed bin init (0),
	  2 type		fixed bin init (1),
	  2 key		fixed bin,
	  2 class		bit (27),
	  2 jump_index	fixed bin;

dcl	1 diag		static,
	  2 size		fixed bin init (32),
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin init (5),
	  2 run		fixed bin init (2),
	  2 number	fixed bin,
	  2 info		bit (8) init (""b),
	  2 image_size	fixed bin init (0);

dcl	1 usrwd		static,
	  2 size		fixed bin,
	  2 line		fixed bin init (0),
	  2 column	fixed bin init (0),
	  2 type		fixed init (8),
	  2 info		bit (8) init (""b),
	  2 length	fixed bin,
	  2 word		char (30);

dcl	1 sizertn_numlit	static,
	  2 size		fixed bin,
	  2 line		fixed bin init (0),
	  2 column	fixed bin init (0),
	  2 type		fixed bin init (2),
	  2 info		bit (8) init ("10000000"b),
	  2 sign		char (1) init (" "),
	  2 exp_sign	char (1) init (" "),
	  2 exp_places	fixed bin init (0),
	  2 places_left	fixed bin,
	  2 places_right	fixed bin init (0),
	  2 places	fixed bin,
	  2 literal	char (5);

dcl	1 icdhdr_type9	static,
	  2 header	(4) fixed bin init (184, 0, 0, 9),
	  2 repl_ptr	(2) ptr init ((2) null ()),
	  2 fill1		bit (108) init (""b),
	  2 file_key_info,
	    3 fb1		(3) fixed bin init (0, 0, 0),
	    3 size	fixed bin init (60),
	    3 fb2		(2) fixed bin init (0, 0),
	    3 flags1	bit (36) init ("010000100100000000010000000100000000"b),
	    3 flags2	bit (36) init (""b),
	    3 seg		fixed bin init (2),
	    3 off		fixed bin,
	  2 init_ptr	fixed bin init (117),
	  2 edit_ptr	fixed bin init (0),
	  2 occurs_ptr	fixed bin init (0),
	  2 do_rec	char (5) init ("00000"),
	  2 fill2		bit (27) unal init (""b),
	  2 max_red_size	fixed bin init (0),
	  2 name_size	fixed bin init (4),
	  2 name		char (4) init ("IHDR"),
	  2 ext		bit (36) init ("01"b),
	  2 value_len	fixed bin init (60),
	  2 value,
	    3 qp		bit (72) init ("000111111111111111000000000000100011000000000000000001"b),
	    3 flags	bit (36) init ("11"b),
	    3 last_full_q_name
			char (48) init ("");

dcl	1 ocdhdr_type9	static,
	  2 header	(4) fixed bin init (144, 0, 0, 9),
	  2 repl_ptr	(2) ptr init ((2) null ()),
	  2 fill1		bit (108) init (""b),
	  2 file_key_info,
	    3 fb1		(3) fixed bin init (0, 0, 0),
	    3 size	fixed bin init (20),
	    3 fb2		(2) fixed bin init (0, 0),
	    3 flags1	bit (36) init ("010000100100000000010000000100000000"b),
	    3 flags2	bit (36) init (""b),
	    3 seg		fixed bin init (2),
	    3 off		fixed bin,
	  2 init_ptr	fixed bin init (117),
	  2 edit_ptr	fixed bin init (0),
	  2 occurs_ptr	fixed bin init (0),
	  2 do_rec	char (5) init ("00000"),
	  2 fill2		bit (27) unal init (""b),
	  2 max_red_size	fixed bin init (0),
	  2 name_size	fixed bin init (4),
	  2 name		char (4) init ("OHDR"),
	  2 ext		bit (36) init ("01"b),
	  2 value_len	fixed bin init (60),
	  2 value,
	    3 last_station_info_ptr
			bit (72) init ("000111111111111111000000000000100011000000000000000001"b),
	    3 flags	bit (36) init ("01"b),
	    3 binary_max_station_count
			fixed bin,
	    3 max_station_count
			char (4);

dcl	1 numlit		auto,
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin,
	  2 info		bit (8),
	  2 sign		char (1),
	  2 exp_sign	char (1),
	  2 exp_places	fixed bin,
	  2 places_left	fixed bin,
	  2 places_right	fixed bin,
	  2 places	fixed bin,
	  2 literal	char (30);

dcl	1 nonnumlit	auto,
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin,
	  2 info		bit (8),
	  2 length	fixed bin,
	  2 string	char (256);


dcl	1 ddseg		static,
	  2 next		char (5) init ("00000"),
	  2 seg_no	fixed bin init (2),
	  2 next_offset	fixed bin (24),
	  2 duplicate_next_loc
			fixed bin (24) init (0),
	  2 read_only	bit (1) init ("0"b);	/*~*/
dcl	record_segment	fixed bin static options (constant) init (2);
dcl	perform_size	fixed bin static options (constant) init (28);
dcl	usrwd_size	fixed bin static options (constant) init (24);
dcl	numlit_size	fixed bin static options (constant) init (36);
dcl	nonnumlit_size	fixed bin static options (constant) init (24);
dcl	ddseg_size	fixed bin static options (constant) init (21);

dcl	1 type25		static options (constant),
	  2 size		fixed bin init (53),
	  2 line		fixed bin init (0),
	  2 column	fixed bin init (0),
	  2 type		fixed bin init (25),
	  2 string_ptr	ptr init (null ()),
	  2 prev_rec	ptr init (null ()),
	  2 filler	bit (36) init (""b),
	  2 section_num	fixed bin init (0),
	  2 proc_num	fixed bin init (0),
	  2 def_line	fixed bin init (0),
	  2 name_size	fixed bin init (1),
	  2 name		char (1) init ("$");

dcl	1 errormes_lit	static options (constant),
	  2 size		fixed bin init (76),
	  2 line		fixed bin init (0),
	  2 column	fixed bin init (0),
	  2 type		fixed bin init (3),
	  2 info		bit (8) init (""b),
	  2 length	fixed bin init (52),
	  2 string	char (52) init ("Value of DEPENDING ON item is outside defined range.");

dcl	1 sizedn		static options (constant),
	  2 size		fixed bin init (113),
	  2 line		fixed bin init (0),
	  2 column	fixed bin init (0),
	  2 type		fixed bin init (9),
	  2 repl_ptr	(2) ptr init ((2) null ()),
	  2 fill1		bit (108) init (""b),
	  2 file_key_info,
	    3 fb1		(3) fixed bin init (0, 0, 0),
	    3 size	fixed bin init (4),
	    3 places_left	fixed bin init (11),
	    3 places_right	fixed bin init (0),
	    3 flags1	bit (36) init ("010000100100001001"b),
						/* ws,77,elem,bin36,num */
	    3 flags2	bit (36) init (""b),
	    3 seg		fixed bin init (2),
	    3 off		fixed bin init (0),
	  2 fill2		(6) fixed bin init (0, 0, 0, 0, 0, 0),
	  2 name_size	fixed bin init (1),
	  2 name		char (1) init ("$");

dcl	cobol_make_fsb_link_
			entry (ptr);
dcl	cobol_read_ft_	entry (fixed bin, ptr);
dcl	unique_bits_	entry returns (bit (70));
dcl	unique_chars_	entry (bit (*)) returns (char (15));
dcl	cobol_IVAL	entry (ptr);
dcl	cobol_vdwf_dput	entry (ptr, bit (32), ptr, fixed bin, char (5)) ext;
dcl	cobol_vdwf_dget	entry (ptr, bit (32), ptr, fixed bin, char (5)) ext;
dcl	cobol_swf_put	entry (ptr, bit (32), ptr, fixed bin) ext;
dcl	cobol_vdwf_sput	entry (ptr, bit (32), ptr, fixed bin, char (5)) ext;
dcl	cobol_ntio$sget	entry (ptr, fixed bin);
dcl	cobol_ntio$dget	entry (ptr, char (5) aligned);
dcl	cobol_c_list	entry (ptr);

dcl	(addr, addrel, divide, fixed, index, mod, null, string, substr, unspec, max)
			builtin;



/***************************************/
%include cobol_perform_entry;
%include cobol_obj_rec;
%include cobol_qual_rec;
%include cobol_odo_rec;
%include cobol_occurs_ext;
%include cobol_ext_num;
%include cobol_ext_nonnum;
%include cobol_ext_;
%include cobol_;
%include cobol_fixed_common;
%include cobol_file_table;
%include cobol_type9;
%include cobol_type10;
%include cobol_type12;
%include cobol_type13;
%include cobol_type19;
%include cobol_type20;
%include cobol_ddal_diag_values;
%include cobol_reswd_values;
%include cobol_size_values;
     end;




		    cobol_ddst.alm                  05/24/89  1044.4rew 05/24/89  0837.3      646533



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

" HISTORY COMMENTS:
"  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8083),
"     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
"     MCR8083 cobol_ddst.alm Fix bug detecting illegal level 77 group item.
"                                                      END HISTORY COMMENTS


name	cobol_ddst
	entry	cobol_ddst
cobol_ddst:	save
	epp2	cobol_ddst
	spri2	ap|2,*
	return
		equ i_r,0
		equ i_c,1
		equ i_s,3
		equ i_n,2
		equ i_k,4
		equ i_K,5
		equ l_org,*-5
		vfd a36/s   ,36/i_r,36/r_per,36/(l_1-l_org)/5,36/0
l_1:	start:	vfd a36/    ,36/i_n,36/0,36/(l_2-l_org)/5,36/a_3
l_2:	sj:	vfd a36/    ,36/i_c,36/c_1,36/(l_3-l_org)/5,36/a_4
		vfd a36/    ,36/i_n,36/001,36/(r1dg-l_org)/5,36/0
l_3:	jumpbase0:	vfd a36/s   ,36/i_n,36/0,36/(fs-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(l_4-l_org)/5,36/a_138
		vfd a36/    ,36/i_n,36/0,36/(cns-l_org)/5,36/a_138
		vfd a36/    ,36/i_n,36/0,36/(lks-l_org)/5,36/a_138
		vfd a36/    ,36/i_n,36/0,36/(cms-l_org)/5,36/a_138
		vfd a36/s   ,36/i_n,36/0,36/(rs-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(pd-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(eop-l_org)/5,36/0
l_4:		vfd a36/s   ,36/i_r,36/r_section,36/(l_5-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/002,36/(l_5-l_org)/5,36/0
l_5:		vfd a36/s   ,36/i_r,36/r_per,36/(l_6-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/003,36/(l_6-l_org)/5,36/a_168
l_6:		vfd a36/    ,36/i_c,36/c_74,36/(l_7-l_org)/5,36/0
l_7:	wssstrt:	vfd a36/    ,36/i_c,36/c_2,36/(l_8-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/005,36/(l_8-l_org)/5,36/0
l_8:		vfd a36/    ,36/i_c,36/c_3,36/(l_9-l_org)/5,36/a_5
		vfd a36/    ,36/i_n,36/027,36/(l_9-l_org)/5,36/0
l_9:		vfd a36/    ,36/i_s,36/(databody-l_org)/5,36/(sj-l_org)/5,36/a_6
		vfd a36/    ,36/i_n,36/129,36/(sj-l_org)/5,36/a_6
	rs:	vfd a36/s   ,36/i_r,36/r_section,36/(l_10-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_10-l_org)/5,36/0
l_10:		vfd a36/s   ,36/i_r,36/r_per,36/(l_11-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_11-l_org)/5,36/0
l_11:		vfd a36/    ,36/i_s,36/(databody-l_org)/5,36/(sj-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(sj-l_org)/5,36/0
	cns:	vfd a36/s5  ,36/i_n,36/103,36/(l_12-l_org)/5,36/25
l_12:		vfd a36/s   ,36/i_r,36/r_section,36/(l_13-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/002,36/(l_13-l_org)/5,36/0
l_13:		vfd a36/s   ,36/i_r,36/r_per,36/(l_14-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/003,36/(l_14-l_org)/5,36/a_168
l_14:		vfd a36/    ,36/i_c,36/c_4,36/(l_15-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/005,36/(l_15-l_org)/5,36/0
l_15:		vfd a36/    ,36/i_c,36/c_5,36/(l_16-l_org)/5,36/a_7
		vfd a36/    ,36/i_n,36/133,36/(l_16-l_org)/5,36/a_7
l_16:		vfd a36/    ,36/i_s,36/(databody-l_org)/5,36/(sj-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(sj-l_org)/5,36/0
	lks:	vfd a36/s2  ,36/i_n,36/128,36/(l_17-l_org)/5,36/13
l_17:		vfd a36/s   ,36/i_r,36/r_section,36/(l_18-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/002,36/(l_18-l_org)/5,36/0
l_18:		vfd a36/s   ,36/i_r,36/r_per,36/(l_19-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/003,36/(l_19-l_org)/5,36/a_168
l_19:		vfd a36/    ,36/i_c,36/c_6,36/(l_20-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/005,36/(l_20-l_org)/5,36/0
l_20:		vfd a36/    ,36/i_c,36/c_7,36/(l_21-l_org)/5,36/a_9
		vfd a36/    ,36/i_n,36/131,36/(l_21-l_org)/5,36/a_9
l_21:		vfd a36/    ,36/i_s,36/(databody-l_org)/5,36/(sj-l_org)/5,36/a_10
		vfd a36/    ,36/i_n,36/0,36/(sj-l_org)/5,36/a_10
	databody:	vfd a36/    ,36/i_c,36/c_int,36/(l_22-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(success-l_org)/5,36/a_1
		vfd a36/    ,36/i_n,36/038,36/(r7dg-l_org)/5,36/0
l_22:	test77:	vfd a36/    ,36/i_c,36/c_lev77,36/(entry77-l_org)/5,36/0
	test01:	vfd a36/    ,36/i_c,36/c_lev01,36/(name01-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/038,36/(r7dg-l_org)/5,36/0
	name01:	vfd a36/s   ,36/i_n,36/0,36/(l_23-l_org)/5,36/a_8
l_23:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_24-l_org)/5,36/a_12
		vfd a36/s   ,36/i_r,36/r_filler,36/(l_24-l_org)/5,36/a_14
		vfd a36/    ,36/i_n,36/020,36/(l_24-l_org)/5,36/a_13
l_24:		vfd a36/    ,36/i_s,36/(record01-l_org)/5,36/(databody-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(databody-l_org)/5,36/0
	entry77:	vfd a36/    ,36/i_n,36/0,36/(l_25-l_org)/5,36/a_8
l_25:		vfd a36/s   ,36/i_n,36/0,36/(l_26-l_org)/5,36/a_15
l_26:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_27-l_org)/5,36/a_12
		vfd a36/s   ,36/i_r,36/r_filler,36/(l_27-l_org)/5,36/a_14
		vfd a36/    ,36/i_n,36/020,36/(l_27-l_org)/5,36/a_13
l_27:		vfd a36/    ,36/i_c,36/c_12,36/(cl77-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_per,36/(l_28-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/226,36/(r10dg-l_org)/5,36/0
l_28:		vfd a36/    ,36/i_n,36/225,36/(r10dg-l_org)/5,36/a_84
	cl77:	vfd a36/    ,36/i_s,36/(ddclauses-l_org)/5,36/(l_29-l_org)/5,36/a_16
		vfd a36/    ,36/i_n,36/0,36/(l_29-l_org)/5,36/0
l_29:	apre77:	vfd a36/    ,36/i_c,36/c_lev0177,36/(l_30-l_org)/5,36/a_17
l_30:		vfd a36/    ,36/i_c,36/c_lev77,36/(entry77-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(name01-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev88s,36/(l88_1-l_org)/5,36/a_19
		vfd a36/    ,36/i_n,36/0,36/(l_31-l_org)/5,36/a_17
l_31:		vfd a36/    ,36/i_c,36/c_62,36/(success-l_org)/5,36/a_1
		vfd a36/    ,36/i_c,36/c_lev66s,36/(l66_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/028,36/(r7dg-l_org)/5,36/0
	l88_1:	vfd a36/s3  ,36/i_n,36/139,36/(l_32-l_org)/5,36/2
l_32:	s7788:	vfd a36/    ,36/i_s,36/(entry88-l_org)/5,36/(apre77-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(apre77-l_org)/5,36/0
	l66_1:	vfd a36/s3  ,36/i_n,36/140,36/(l_33-l_org)/5,36/2
l_33:	di66:	vfd a36/    ,36/i_n,36/034,36/(r7dg-l_org)/5,36/0
	record01:	vfd a36/    ,36/i_n,36/0,36/(l_34-l_org)/5,36/a_20
l_34:	avant01dd:	vfd a36/    ,36/i_c,36/c_12,36/(av01-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_renames,36/(av01-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_per,36/(apre01dd-l_org)/5,36/a_18
		vfd a36/    ,36/i_n,36/0,36/(l_35-l_org)/5,36/a_18
l_35:		vfd a36/    ,36/i_n,36/35,36/(apre01dd-l_org)/5,36/a_84
	av01:	vfd a36/    ,36/i_s,36/(ddclauses-l_org)/5,36/(l_36-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_36-l_org)/5,36/0
l_36:	apre01dd:	vfd a36/    ,36/i_n,36/0,36/(l_37-l_org)/5,36/a_136
l_37:	testnext:	vfd a36/    ,36/i_c,36/c_lev0249,36/(son_1-l_org)/5,36/a_21
		vfd a36/    ,36/i_c,36/c_55,36/(consisck-l_org)/5,36/a_21
		vfd a36/    ,36/i_r,36/r_cd,36/(l_38-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(consisck-l_org)/5,36/a_21
		vfd a36/    ,36/i_c,36/c_lev0177,36/(consisck-l_org)/5,36/a_21
		vfd a36/    ,36/i_c,36/c_lev88s,36/(l88_2-l_org)/5,36/a_19
		vfd a36/    ,36/i_c,36/c_lev66s,36/(l66_2-l_org)/5,36/a_21
		vfd a36/s   ,36/i_c,36/c_77,36/(testnext-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/028,36/(r8dg-l_org)/5,36/0
l_38:		vfd a36/    ,36/i_n,36/0,36/(l_39-l_org)/5,36/a_74
l_39:		vfd a36/    ,36/i_n,36/0,36/(l_40-l_org)/5,36/a_21
l_40:	consisck:	vfd a36/    ,36/i_n,36/0,36/(l_41-l_org)/5,36/a_17
l_41:		vfd a36/    ,36/i_n,36/0,36/(success-l_org)/5,36/a_1
	sonitem:	vfd a36/    ,36/i_n,36/0,36/(l_42-l_org)/5,36/a_17
l_42:		vfd a36/s   ,36/i_n,36/0,36/(l_43-l_org)/5,36/a_8
l_43:		vfd a36/s   ,36/i_c,36/c_type8,36/(avant01dd-l_org)/5,36/a_12
	son_2:	vfd a36/s   ,36/i_r,36/r_filler,36/(avant01dd-l_org)/5,36/a_14
		vfd a36/    ,36/i_n,36/020,36/(avant01dd-l_org)/5,36/a_13
	son_1:	vfd a36/    ,36/i_n,36/0,36/(l_44-l_org)/5,36/a_17
l_44:		vfd a36/s   ,36/i_n,36/0,36/(l_45-l_org)/5,36/a_8
l_45:		vfd a36/    ,36/i_c,36/c_dup_type8,36/(l_46-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(son_2-l_org)/5,36/0
l_46:		vfd a36/s   ,36/i_n,36/0,36/(avant01dd-l_org)/5,36/a_12
	l88_2:	vfd a36/s3  ,36/i_n,36/139,36/(l_47-l_org)/5,36/2
l_47:	sub88:	vfd a36/    ,36/i_s,36/(entry88-l_org)/5,36/(testnext-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(testnext-l_org)/5,36/0
	l66_2:	vfd a36/ 3  ,36/i_n,36/140,36/(l_48-l_org)/5,36/2
l_48:	sub66:	vfd a36/    ,36/i_n,36/0,36/(l_49-l_org)/5,36/a_17
l_49:		vfd a36/s   ,36/i_n,36/0,36/(l_50-l_org)/5,36/a_8
l_50:		vfd a36/    ,36/i_s,36/(entry66-l_org)/5,36/(success-l_org)/5,36/a_1
		vfd a36/    ,36/i_n,36/0,36/(success-l_org)/5,36/a_1
	like:	vfd a36/s   ,36/i_c,36/c_type8,36/(l_51-l_org)/5,36/a_77
		vfd a36/    ,36/i_n,36/0,36/(failure-l_org)/5,36/0
l_51:	like_1:	vfd a36/s   ,36/i_r,36/r_of,36/(like_2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_in,36/(like_2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_per,36/(l_52-l_org)/5,36/a_170
		vfd a36/    ,36/i_n,36/35,36/(r9dg-l_org)/5,36/a_84
l_52:		vfd a36/    ,36/i_n,36/0,36/(success-l_org)/5,36/a_1
	like_2:	vfd a36/s   ,36/i_c,36/c_type8,36/(like_1-l_org)/5,36/a_169
		vfd a36/    ,36/i_n,36/0,36/(failure-l_org)/5,36/0
	ddclauses:	vfd a36/s   ,36/i_r,36/r_redefines,36/(redefines-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_53-l_org)/5,36/a_18
l_53:		vfd a36/s   ,36/i_r,36/r_renames,36/(like-l_org)/5,36/0
l_54:		vfd a36/    ,36/i_s,36/(ddcls_1-l_org)/5,36/(success-l_org)/5,36/a_1
		vfd a36/    ,36/i_n,36/0,36/(failure-l_org)/5,36/a_2
	ddcls_1:	vfd a36/    ,36/i_c,36/c_12,36/(l_55-l_org)/5,36/a_4
		vfd a36/s   ,36/i_r,36/r_per,36/(success-l_org)/5,36/a_1
		vfd a36/    ,36/i_n,36/35,36/(r9dg-l_org)/5,36/a_84
l_55:		vfd a36/    ,36/i_n,36/0,36/(picture-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(usage-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(just-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(occurs-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(value-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(blank-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(sync-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(sign-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/029,36/(r9dg-l_org)/5,36/0
	picture:	vfd a36/s   ,36/i_c,36/c_18,36/(l_56-l_org)/5,36/a_22
		vfd a36/s   ,36/i_n,36/044,36/(r9dg-l_org)/5,36/0
l_56:		vfd a36/s   ,36/i_r,36/r_is,36/(l_57-l_org)/5,36/0
l_57:		vfd a36/s   ,36/i_c,36/c_19,36/(ddcls_1-l_org)/5,36/a_23
		vfd a36/    ,36/i_n,36/066,36/(r9dg-l_org)/5,36/0
	usage:	vfd a36/    ,36/i_c,36/c_20,36/(l_58-l_org)/5,36/a_24
		vfd a36/s   ,36/i_n,36/045,36/(r9dg-l_org)/5,36/0
l_58:		vfd a36/s   ,36/i_r,36/r_usage,36/(l_59-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(udisp-l_org)/5,36/0
l_59:		vfd a36/s   ,36/i_r,36/r_is,36/(l_60-l_org)/5,36/0
l_60:	udisp:	vfd a36/    ,36/i_r,36/r_display,36/(l_61-l_org)/5,36/a_25
		vfd a36/    ,36/i_r,36/r_comp,36/(l_61-l_org)/5,36/a_26
		vfd a36/    ,36/i_r,36/r_comp_1,36/(udisp_2-l_org)/5,36/a_27
		vfd a36/    ,36/i_r,36/r_comp_2,36/(udisp_2-l_org)/5,36/a_28
		vfd a36/    ,36/i_r,36/r_comp_3,36/(udisp_2-l_org)/5,36/a_29
		vfd a36/    ,36/i_r,36/r_comp_4,36/(utp1-l_org)/5,36/a_30
		vfd a36/    ,36/i_r,36/r_comp_5,36/(utp1-l_org)/5,36/a_37
		vfd a36/    ,36/i_r,36/r_comp_6,36/(utp1-l_org)/5,36/a_11
		vfd a36/    ,36/i_r,36/r_comp_7,36/(utp1-l_org)/5,36/a_31
		vfd a36/    ,36/i_r,36/r_comp_8,36/(utp1-l_org)/5,36/a_167
		vfd a36/    ,36/i_r,36/r_index,36/(udisp_1-l_org)/5,36/a_32
		vfd a36/    ,36/i_n,36/135,36/(r9dg-l_org)/5,36/0
l_61:	udisp_1:	vfd a36/    ,36/i_c,36/c_21,36/(l_62-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/070,36/(l_62-l_org)/5,36/0
l_62:		vfd a36/    ,36/i_c,36/c_31,36/(l_63-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_76,36/(l_63-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/169,36/(l_63-l_org)/5,36/0
l_63:		vfd a36/s   ,36/i_c,36/c_75,36/(ddcls_1-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/071,36/(ddcls_1-l_org)/5,36/0
	udisp_2:	vfd a36/ 5  ,36/i_n,36/101,36/(l_64-l_org)/5,36/25
l_64:	utm:	vfd a36/    ,36/i_n,36/0,36/(udisp_1-l_org)/5,36/0
	utp1:	vfd a36/ 5  ,36/i_n,36/101,36/(l_65-l_org)/5,36/25
l_65:	utp:	vfd a36/    ,36/i_c,36/c_44,36/(udisp_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/209,36/(udisp_1-l_org)/5,36/0
	value:	vfd a36/s   ,36/i_c,36/c_22,36/(l_66-l_org)/5,36/a_33
		vfd a36/s   ,36/i_n,36/046,36/(r9dg-l_org)/5,36/0
l_66:		vfd a36/    ,36/i_c,36/c_26,36/(l_67-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/068,36/(igval-l_org)/5,36/0
l_67:		vfd a36/s   ,36/i_r,36/r_is,36/(l_68-l_org)/5,36/0
l_68:		vfd a36/    ,36/i_c,36/c_type2,36/(value_1-l_org)/5,36/a_34
		vfd a36/    ,36/i_c,36/c_type3,36/(value_1-l_org)/5,36/a_35
		vfd a36/    ,36/i_c,36/c_figcon,36/(value_1-l_org)/5,36/a_36
		vfd a36/    ,36/i_r,36/r_all,36/(l_69-l_org)/5,36/a_135
		vfd a36/    ,36/i_n,36/076,36/(r9dg-l_org)/5,36/0
l_69:		vfd a36/s3  ,36/i_n,36/144,36/(l_70-l_org)/5,36/2
l_70:		vfd a36/    ,36/i_c,36/c_type3,36/(l_71-l_org)/5,36/a_35
		vfd a36/    ,36/i_c,36/c_figcon,36/(l_71-l_org)/5,36/a_36
		vfd a36/s   ,36/i_c,36/c_type2,36/(value_2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/076,36/(r9dg-l_org)/5,36/0
l_71:	value_1:	vfd a36/s   ,36/i_n,36/0,36/(ddcls_1-l_org)/5,36/0
	value_2:	vfd a36/    ,36/i_n,36/205,36/(r9dg-l_org)/5,36/0
	igval:	vfd a36/s   ,36/i_r,36/r_is,36/(l_72-l_org)/5,36/0
l_72:		vfd a36/s   ,36/i_c,36/c_type2,36/(ddcls_1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_type3,36/(ddcls_1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figcon,36/(ddcls_1-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_all,36/(l_73-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/076,36/(r9dg-l_org)/5,36/0
l_73:		vfd a36/s3  ,36/i_n,36/144,36/(l_74-l_org)/5,36/2
l_74:		vfd a36/s   ,36/i_c,36/c_type3,36/(ddcls_1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_figcon,36/(ddcls_1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_type2,36/(value_2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/076,36/(r9dg-l_org)/5,36/0
	sign:	vfd a36/    ,36/i_c,36/c_27,36/(l_75-l_org)/5,36/a_38
		vfd a36/s   ,36/i_n,36/051,36/(r9dg-l_org)/5,36/0
l_75:		vfd a36/    ,36/i_c,36/c_28,36/(l_76-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/077,36/(l_76-l_org)/5,36/0
l_76:		vfd a36/s   ,36/i_r,36/r_sign,36/(l_77-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(slead-l_org)/5,36/0
l_77:		vfd a36/s   ,36/i_r,36/r_is,36/(l_78-l_org)/5,36/0
l_78:	slead:	vfd a36/s   ,36/i_r,36/r_leading,36/(l_79-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_trailing,36/(trailsp-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/53,36/(r9dg-l_org)/5,36/0
l_79:		vfd a36/s   ,36/i_r,36/r_separate,36/(l_80-l_org)/5,36/a_42
		vfd a36/    ,36/i_n,36/0,36/(l_80-l_org)/5,36/a_40
l_80:	schar:	vfd a36/    ,36/i_c,36/c_29,36/(l_81-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/091,36/(l_81-l_org)/5,36/0
l_81:		vfd a36/s   ,36/i_r,36/r_character,36/(ddcls_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(ddcls_1-l_org)/5,36/0
	trailsp:	vfd a36/s   ,36/i_r,36/r_separate,36/(schar-l_org)/5,36/a_41
		vfd a36/    ,36/i_n,36/0,36/(schar-l_org)/5,36/a_39
	sync:	vfd a36/s   ,36/i_c,36/c_30,36/(l_82-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/050,36/(r9dg-l_org)/5,36/0
l_82:		vfd a36/s   ,36/i_r,36/r_right,36/(l_83-l_org)/5,36/a_43
		vfd a36/s   ,36/i_r,36/r_left,36/(l_83-l_org)/5,36/a_44
		vfd a36/    ,36/i_n,36/0,36/(l_83-l_org)/5,36/a_43
l_83:		vfd a36/    ,36/i_c,36/c_26,36/(l_84-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/075,36/(l_84-l_org)/5,36/0
l_84:		vfd a36/    ,36/i_c,36/c_31,36/(ddcls_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/081,36/(ddcls_1-l_org)/5,36/0
	just:	vfd a36/s   ,36/i_c,36/c_32,36/(l_85-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/048,36/(r9dg-l_org)/5,36/0
l_85:		vfd a36/s   ,36/i_r,36/r_right,36/(l_86-l_org)/5,36/a_45
		vfd a36/s   ,36/i_r,36/r_left,36/(l_86-l_org)/5,36/a_46
		vfd a36/    ,36/i_n,36/0,36/(l_86-l_org)/5,36/a_45
l_86:		vfd a36/    ,36/i_c,36/c_26,36/(l_87-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/073,36/(l_87-l_org)/5,36/0
l_87:		vfd a36/    ,36/i_c,36/c_31,36/(ddcls_1-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/080,36/(ddcls_1-l_org)/5,36/0
	blank:	vfd a36/s   ,36/i_n,36/0,36/(l_88-l_org)/5,36/a_47
		vfd a36/s   ,36/i_n,36/049,36/(r9dg-l_org)/5,36/0
l_88:		vfd a36/s   ,36/i_r,36/r_when,36/(l_89-l_org)/5,36/0
l_89:		vfd a36/s   ,36/i_r,36/r_zero,36/(l_90-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/079,36/(r9dg-l_org)/5,36/0
l_90:		vfd a36/    ,36/i_n,36/0,36/(ddcls_1-l_org)/5,36/0
	occurs:	vfd a36/s   ,36/i_c,36/c_34,36/(l_91-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/047,36/(r5dg-l_org)/5,36/0
l_91:		vfd a36/    ,36/i_c,36/c_35,36/(l_92-l_org)/5,36/a_48
		vfd a36/    ,36/i_n,36/083,36/(r5dg-l_org)/5,36/0
l_92:		vfd a36/s   ,36/i_c,36/c_int,36/(l_93-l_org)/5,36/a_49
		vfd a36/    ,36/i_n,36/084,36/(r16dg-l_org)/5,36/0
l_93:		vfd a36/s   ,36/i_r,36/r_times,36/(l_94-l_org)/5,36/0
		vfd a36/ 3  ,36/i_r,36/r_to,36/(maxint-l_org)/5,36/143
l_94:		vfd a36/    ,36/i_c,36/c_37,36/(occ_adi-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/085,36/(occ_adi-l_org)/5,36/0
	maxint:	vfd a36/s   ,36/i_n,36/0,36/(l_95-l_org)/5,36/a_83
l_95:		vfd a36/s   ,36/i_c,36/c_int,36/(l_96-l_org)/5,36/a_50
		vfd a36/    ,36/i_n,36/118,36/(r16dg-l_org)/5,36/0
l_96:		vfd a36/    ,36/i_c,36/c_38,36/(l_97-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/086,36/(l_97-l_org)/5,36/0
l_97:		vfd a36/s   ,36/i_r,36/r_times,36/(l_98-l_org)/5,36/0
l_98:	odpdon:	vfd a36/s   ,36/i_r,36/r_depending,36/(l_99-l_org)/5,36/a_52
		vfd a36/    ,36/i_n,36/197,36/(r16dg-l_org)/5,36/0
l_99:		vfd a36/s   ,36/i_r,36/r_on,36/(l_100-l_org)/5,36/0
l_100:		vfd a36/    ,36/i_n,36/0,36/(l_101-l_org)/5,36/a_51
l_101:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_102-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r16dg-l_org)/5,36/0
l_102:	cdnof:	vfd a36/s3  ,36/i_r,36/r_of,36/(dodn2-l_org)/5,36/5
		vfd a36/s3  ,36/i_r,36/r_in,36/(dodn2-l_org)/5,36/5
	cdnof1:	vfd a36/    ,36/i_c,36/c_39,36/(occ_adi-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/088,36/(occ_adi-l_org)/5,36/0
	dodn2:	vfd a36/s   ,36/i_c,36/c_type8,36/(cdnof-l_org)/5,36/a_73
		vfd a36/    ,36/i_n,36/20,36/(r16dg-l_org)/5,36/0
	occ_adi:	vfd a36/    ,36/i_r,36/r_ascending,36/(l_103-l_org)/5,36/a_53
		vfd a36/    ,36/i_r,36/r_descending,36/(l_103-l_org)/5,36/a_54
		vfd a36/s   ,36/i_r,36/r_indexed,36/(indby-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(ddcls_1-l_org)/5,36/a_137
l_103:		vfd a36/ 3  ,36/i_n,36/136,36/(l_104-l_org)/5,36/4
l_104:		vfd a36/s   ,36/i_n,36/0,36/(l_105-l_org)/5,36/a_165
l_105:		vfd a36/s   ,36/i_r,36/r_key,36/(l_106-l_org)/5,36/0
l_106:		vfd a36/s   ,36/i_r,36/r_is,36/(l_107-l_org)/5,36/0
l_107:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_108-l_org)/5,36/a_55
		vfd a36/s   ,36/i_n,36/20,36/(r16dg-l_org)/5,36/0
l_108:	knof:	vfd a36/s   ,36/i_r,36/r_of,36/(l_109-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_in,36/(l_109-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_type8,36/(knof-l_org)/5,36/a_55
		vfd a36/    ,36/i_n,36/0,36/(occ_adi-l_org)/5,36/a_139
l_109:		vfd a36/s   ,36/i_c,36/c_type8,36/(knof-l_org)/5,36/a_166
		vfd a36/    ,36/i_n,36/20,36/(r16dg-l_org)/5,36/0
	indby:	vfd a36/    ,36/i_c,36/c_42,36/(l_110-l_org)/5,36/a_56
		vfd a36/    ,36/i_n,36/092,36/(r16dg-l_org)/5,36/0
l_110:		vfd a36/s   ,36/i_r,36/r_by,36/(l_111-l_org)/5,36/0
l_111:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_112-l_org)/5,36/a_57
		vfd a36/    ,36/i_n,36/089,36/(r16dg-l_org)/5,36/0
l_112:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_112-l_org)/5,36/a_57
		vfd a36/    ,36/i_n,36/0,36/(occ_adi-l_org)/5,36/0
	l88_3:	vfd a36/s3  ,36/i_n,36/139,36/(l_113-l_org)/5,36/2
l_113:	entry88:	vfd a36/s   ,36/i_c,36/c_type8,36/(l_114-l_org)/5,36/a_63
		vfd a36/    ,36/i_n,36/036,36/(r11dg-l_org)/5,36/0
l_114:		vfd a36/s   ,36/i_r,36/r_value,36/(l_115-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/158,36/(r11dg-l_org)/5,36/0
l_115:		vfd a36/s   ,36/i_r,36/r_are,36/(lit88-l_org)/5,36/0
	lit88:	vfd a36/s   ,36/i_c,36/c_type2,36/(a67-l_org)/5,36/a_64
		vfd a36/s   ,36/i_c,36/c_type3,36/(a67-l_org)/5,36/a_65
		vfd a36/s   ,36/i_c,36/c_figcon,36/(a67-l_org)/5,36/a_66
		vfd a36/    ,36/i_r,36/r_all,36/(l_116-l_org)/5,36/a_135
		vfd a36/    ,36/i_n,36/037,36/(r11dg-l_org)/5,36/0
l_116:		vfd a36/s3  ,36/i_n,36/144,36/(l_117-l_org)/5,36/2
l_117:		vfd a36/s   ,36/i_c,36/c_type3,36/(l_118-l_org)/5,36/a_65
		vfd a36/s   ,36/i_c,36/c_figcon,36/(l_118-l_org)/5,36/a_66
		vfd a36/    ,36/i_n,36/37,36/(r11dg-l_org)/5,36/0
l_118:	a67:	vfd a36/s   ,36/i_r,36/r_thru,36/(l_119-l_org)/5,36/a_67
		vfd a36/s   ,36/i_r,36/r_per,36/(c46-l_org)/5,36/a_70
		vfd a36/    ,36/i_n,36/0,36/(lit88-l_org)/5,36/a_68
l_119:		vfd a36/s   ,36/i_c,36/c_type2,36/(a68-l_org)/5,36/a_64
		vfd a36/s   ,36/i_c,36/c_type3,36/(a68-l_org)/5,36/a_65
		vfd a36/s   ,36/i_c,36/c_figcon,36/(a68-l_org)/5,36/a_66
		vfd a36/    ,36/i_r,36/r_all,36/(l_120-l_org)/5,36/a_135
		vfd a36/    ,36/i_n,36/162,36/(r11dg-l_org)/5,36/0
l_120:		vfd a36/s3  ,36/i_n,36/144,36/(l_121-l_org)/5,36/2
l_121:		vfd a36/s   ,36/i_c,36/c_type3,36/(l_122-l_org)/5,36/a_65
		vfd a36/s   ,36/i_c,36/c_figcon,36/(l_122-l_org)/5,36/a_66
		vfd a36/    ,36/i_n,36/162,36/(r11dg-l_org)/5,36/0
l_122:	a68:	vfd a36/    ,36/i_c,36/c_45,36/(l_123-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/041,36/(l_123-l_org)/5,36/0
l_123:	end88:	vfd a36/s   ,36/i_r,36/r_per,36/(l_124-l_org)/5,36/a_70
		vfd a36/    ,36/i_n,36/0,36/(lit88-l_org)/5,36/a_68
l_124:	c46:	vfd a36/    ,36/i_c,36/c_46,36/(l_125-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/040,36/(l_125-l_org)/5,36/0
l_125:		vfd a36/    ,36/i_c,36/c_lev88s,36/(l88_3-l_org)/5,36/a_19
		vfd a36/    ,36/i_n,36/0,36/(success-l_org)/5,36/a_1
	l66_3:	vfd a36/s3  ,36/i_n,36/140,36/(l_126-l_org)/5,36/2
l_126:	entry66:	vfd a36/    ,36/i_c,36/c_type8,36/(l_127-l_org)/5,36/a_12
		vfd a36/    ,36/i_n,36/059,36/(r12dg-l_org)/5,36/0
l_127:		vfd a36/s   ,36/i_n,36/0,36/(l_128-l_org)/5,36/a_71
l_128:		vfd a36/    ,36/i_n,36/0,36/(l_129-l_org)/5,36/a_18
l_129:		vfd a36/s   ,36/i_r,36/r_renames,36/(l_130-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/060,36/(r12dg-l_org)/5,36/0
l_130:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_131-l_org)/5,36/a_72
		vfd a36/    ,36/i_n,36/020,36/(r12dg-l_org)/5,36/0
l_131:	obj1of:	vfd a36/s3  ,36/i_r,36/r_of,36/(l_132-l_org)/5,36/5
		vfd a36/s3  ,36/i_r,36/r_in,36/(l_132-l_org)/5,36/5
		vfd a36/    ,36/i_n,36/0,36/(qual1n-l_org)/5,36/0
l_132:		vfd a36/s   ,36/i_c,36/c_type8,36/(obj1of-l_org)/5,36/a_73
	qual1n:	vfd a36/    ,36/i_r,36/r_per,36/(rnm-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_thru,36/(l_133-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/064,36/(l_133-l_org)/5,36/0
l_133:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_134-l_org)/5,36/a_72
		vfd a36/    ,36/i_n,36/020,36/(r12dg-l_org)/5,36/0
l_134:	obj2of:	vfd a36/s3  ,36/i_r,36/r_of,36/(l_135-l_org)/5,36/5
		vfd a36/s3  ,36/i_r,36/r_in,36/(l_135-l_org)/5,36/5
		vfd a36/    ,36/i_n,36/0,36/(rnm-l_org)/5,36/0
l_135:		vfd a36/s   ,36/i_c,36/c_type8,36/(obj2of-l_org)/5,36/a_73
		vfd a36/    ,36/i_n,36/20,36/(r12dg-l_org)/5,36/0
	rnm:	vfd a36/    ,36/i_n,36/0,36/(l_136-l_org)/5,36/a_74
l_136:		vfd a36/s   ,36/i_r,36/r_per,36/(l_137-l_org)/5,36/a_76
		vfd a36/    ,36/i_n,36/003,36/(l_137-l_org)/5,36/a_76
l_137:		vfd a36/    ,36/i_c,36/c_lev66s,36/(l66_3-l_org)/5,36/a_8
		vfd a36/    ,36/i_c,36/c_62,36/(success-l_org)/5,36/a_1
		vfd a36/    ,36/i_c,36/c_lev01,36/(success-l_org)/5,36/a_1
		vfd a36/    ,36/i_c,36/c_57,36/(success-l_org)/5,36/a_1
		vfd a36/    ,36/i_n,36/163,36/(r13-l_org)/5,36/0
	redefines:	vfd a36/    ,36/i_c,36/c_47,36/(l_138-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/056,36/(r9dg-l_org)/5,36/0
l_138:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_139-l_org)/5,36/a_75
		vfd a36/    ,36/i_n,36/042,36/(r9dg-l_org)/5,36/0
l_139:		vfd a36/s3  ,36/i_r,36/r_of,36/(l_140-l_org)/5,36/5
		vfd a36/s3  ,36/i_r,36/r_in,36/(l_140-l_org)/5,36/5
		vfd a36/    ,36/i_n,36/0,36/(ddcls_1-l_org)/5,36/0
l_140:		vfd a36/    ,36/i_n,36/93,36/(l_141-l_org)/5,36/0
l_141:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_142-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r9dg-l_org)/5,36/0
l_142:	rof:	vfd a36/s3  ,36/i_r,36/r_of,36/(l_143-l_org)/5,36/5
		vfd a36/s3  ,36/i_r,36/r_in,36/(l_143-l_org)/5,36/5
		vfd a36/    ,36/i_n,36/0,36/(ddcls_1-l_org)/5,36/0
l_143:		vfd a36/s   ,36/i_c,36/c_type8,36/(rof-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r9dg-l_org)/5,36/0
	pd:	vfd a36/    ,36/i_n,36/0,36/(ddend-l_org)/5,36/a_59
	eop:	vfd a36/s   ,36/i_r,36/r_cobol,36/(l_144-l_org)/5,36/a_60
l_144:	ddend:	vfd a36/    ,36/i_n,36/0,36/(l_145-l_org)/5,36/a_62
l_145:		vfd a36/    ,36/i_n,36/0,36/(l_145-l_org)/5,36/a_61
	fs:	vfd a36/s   ,36/i_r,36/r_section,36/(l_146-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/002,36/(l_146-l_org)/5,36/0
l_146:		vfd a36/s   ,36/i_r,36/r_per,36/(l_147-l_org)/5,36/a_62
		vfd a36/    ,36/i_n,36/003,36/(l_147-l_org)/5,36/a_62
l_147:	fsps:	vfd a36/    ,36/i_c,36/c_2,36/(l_148-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/005,36/(l_148-l_org)/5,36/0
l_148:		vfd a36/    ,36/i_c,36/c_54,36/(l_149-l_org)/5,36/a_79
		vfd a36/    ,36/i_n,36/4,36/(l_149-l_org)/5,36/a_79
l_149:	fsindjump:	vfd a36/    ,36/i_n,36/0,36/(l_150-l_org)/5,36/a_62
l_150:		vfd a36/    ,36/i_c,36/c_55,36/(l_151-l_org)/5,36/a_4
		vfd a36/    ,36/i_c,36/c_62,36/(sj-l_org)/5,36/a_80
		vfd a36/    ,36/i_n,36/006,36/(r2dg-l_org)/5,36/0
l_151:	jumpbase1:	vfd a36/s   ,36/i_n,36/0,36/(fd-l_org)/5,36/a_81
		vfd a36/    ,36/i_n,36/0,36/(sd-l_org)/5,36/a_81
		vfd a36/s   ,36/i_n,36/0,36/(l_152-l_org)/5,36/a_81
l_152:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_153-l_org)/5,36/a_82
		vfd a36/    ,36/i_n,36/164,36/(r3dg-l_org)/5,36/0
l_153:		vfd a36/s   ,36/i_r,36/r_area,36/(l_154-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/026,36/(r3dg-l_org)/5,36/0
l_154:		vfd a36/s   ,36/i_r,36/r_contains,36/(l_155-l_org)/5,36/0
l_155:		vfd a36/s   ,36/i_c,36/c_int,36/(l_156-l_org)/5,36/a_83
		vfd a36/    ,36/i_n,36/025,36/(r3dg-l_org)/5,36/0
l_156:		vfd a36/s   ,36/i_r,36/r_characters,36/(l_157-l_org)/5,36/a_84
		vfd a36/s   ,36/i_r,36/r_record,36/(l_157-l_org)/5,36/a_85
		vfd a36/    ,36/i_n,36/0,36/(l_157-l_org)/5,36/a_84
l_157:		vfd a36/s   ,36/i_r,36/r_record,36/(l_158-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(endsa-l_org)/5,36/0
l_158:		vfd a36/s   ,36/i_r,36/r_contains,36/(l_159-l_org)/5,36/0
l_159:		vfd a36/s   ,36/i_c,36/c_int,36/(l_160-l_org)/5,36/a_86
		vfd a36/    ,36/i_n,36/025,36/(r3dg-l_org)/5,36/0
l_160:		vfd a36/s   ,36/i_r,36/r_to,36/(l_161-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_characters,36/(endsa-l_org)/5,36/a_87
		vfd a36/    ,36/i_n,36/0,36/(endsa-l_org)/5,36/a_87
l_161:		vfd a36/s   ,36/i_c,36/c_int,36/(l_162-l_org)/5,36/a_88
		vfd a36/    ,36/i_n,36/017,36/(r3dg-l_org)/5,36/0
l_162:		vfd a36/s   ,36/i_r,36/r_characters,36/(l_163-l_org)/5,36/0
l_163:	endsa:	vfd a36/s   ,36/i_r,36/r_per,36/(l_164-l_org)/5,36/a_70
		vfd a36/    ,36/i_n,36/003,36/(l_164-l_org)/5,36/a_70
l_164:	sa01:	vfd a36/s   ,36/i_c,36/c_lev01,36/(l_165-l_org)/5,36/a_8
l_165:		vfd a36/    ,36/i_n,36/0,36/(l_166-l_org)/5,36/a_90
l_166:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_167-l_org)/5,36/a_12
		vfd a36/s   ,36/i_r,36/r_filler,36/(l_167-l_org)/5,36/a_14
		vfd a36/    ,36/i_n,36/020,36/(l_167-l_org)/5,36/a_13
l_167:		vfd a36/    ,36/i_s,36/(record01-l_org)/5,36/(l_168-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_168-l_org)/5,36/0
l_168:		vfd a36/    ,36/i_c,36/c_lev01,36/(sa01-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/166,36/(r4dg-l_org)/5,36/0
l_169:		vfd a36/    ,36/i_c,36/c_55,36/(fsindjump-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(sj-l_org)/5,36/a_80
		vfd a36/    ,36/i_n,36/006,36/(r3dg-l_org)/5,36/0
	sd:	vfd a36/s3  ,36/i_n,36/210,36/(l_170-l_org)/5,36/5
l_170:	fd:	vfd a36/    ,36/i_c,36/c_type8,36/(l_171-l_org)/5,36/a_95
		vfd a36/    ,36/i_n,36/167,36/(r40dg-l_org)/5,36/0
l_171:		vfd a36/s   ,36/i_c,36/c_56,36/(l_172-l_org)/5,36/a_94
		vfd a36/    ,36/i_n,36/010,36/(r40dg-l_org)/5,36/0
l_172:	fdclauses:	vfd a36/    ,36/i_c,36/c_61,36/(jumpbase2-l_org)/5,36/a_4
		vfd a36/s   ,36/i_c,36/c_per_ck,36/(l_173-l_org)/5,36/a_99
		vfd a36/    ,36/i_n,36/003,36/(l_173-l_org)/5,36/a_168
l_173:		vfd a36/    ,36/i_c,36/c_lrc,36/(l_174-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/12,36/(l_174-l_org)/5,36/0
l_174:	fd01:	vfd a36/    ,36/i_c,36/c_lev01,36/(file01rcd-l_org)/5,36/a_20
		vfd a36/    ,36/i_c,36/c_58,36/(l_175-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/166,36/(l_175-l_org)/5,36/0
l_175:		vfd a36/    ,36/i_n,36/0,36/(fsindjump-l_org)/5,36/0
	file01rcd:	vfd a36/s   ,36/i_n,36/0,36/(l_176-l_org)/5,36/a_8
l_176:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_177-l_org)/5,36/a_12
		vfd a36/s   ,36/i_r,36/r_filler,36/(l_177-l_org)/5,36/a_14
		vfd a36/    ,36/i_n,36/020,36/(l_177-l_org)/5,36/a_13
l_177:		vfd a36/    ,36/i_n,36/0,36/(l_178-l_org)/5,36/a_100
l_178:		vfd a36/    ,36/i_s,36/(record01-l_org)/5,36/(fd01-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fd01-l_org)/5,36/0
	jumpbase2:	vfd a36/    ,36/i_n,36/0,36/(fdrm-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdbc-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdrc-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdlr-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdvo-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdri-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fddr-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdli-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdcs-l_org)/5,36/0
	fdrm:	vfd a36/s   ,36/i_n,36/18,36/(l_179-l_org)/5,36/0
l_179:		vfd a36/s   ,36/i_r,36/r_mode,36/(l_180-l_org)/5,36/0
l_180:		vfd a36/s   ,36/i_r,36/r_is,36/(l_181-l_org)/5,36/0
l_181:		vfd a36/    ,36/i_c,36/c_65,36/(l_182-l_org)/5,36/a_104
		vfd a36/    ,36/i_n,36/139,36/(r4dg-l_org)/5,36/0
l_182:		vfd a36/s   ,36/i_c,36/c_type8,36/(fdclauses-l_org)/5,36/a_105
		vfd a36/    ,36/i_n,36/014,36/(r4dg-l_org)/5,36/0
	fdbc:	vfd a36/s   ,36/i_n,36/0,36/(l_183-l_org)/5,36/0
l_183:		vfd a36/s   ,36/i_r,36/r_contains,36/(l_184-l_org)/5,36/0
l_184:		vfd a36/    ,36/i_c,36/c_66,36/(l_185-l_org)/5,36/a_106
		vfd a36/    ,36/i_n,36/140,36/(r4dg-l_org)/5,36/0
l_185:		vfd a36/s   ,36/i_c,36/c_int,36/(l_186-l_org)/5,36/a_114
		vfd a36/    ,36/i_n,36/025,36/(r4dg-l_org)/5,36/0
l_186:		vfd a36/    ,36/i_r,36/r_to,36/(maxbc-l_org)/5,36/0
	bcrd:	vfd a36/s   ,36/i_r,36/r_records,36/(fdclauses-l_org)/5,36/a_115
		vfd a36/s   ,36/i_r,36/r_characters,36/(fdclauses-l_org)/5,36/a_116
		vfd a36/    ,36/i_n,36/015,36/(fdclauses-l_org)/5,36/a_116
	maxbc:	vfd a36/    ,36/i_n,36/0,36/(l_187-l_org)/5,36/a_82
		vfd a36/    ,36/i_n,36/0,36/(r4dg-l_org)/5,36/0
l_187:		vfd a36/s3  ,36/i_n,36/137,36/(l_188-l_org)/5,36/16
		vfd a36/s3  ,36/i_n,36/137,36/(l_188-l_org)/5,36/18
		vfd a36/s4  ,36/i_n,36/137,36/(l_188-l_org)/5,36/20
		vfd a36/    ,36/i_n,36/208,36/(r4dg-l_org)/5,36/0
		vfd a36/s5  ,36/i_n,36/137,36/(l_188-l_org)/5,36/26
l_188:		vfd a36/s   ,36/i_c,36/c_int,36/(bcrd-l_org)/5,36/a_117
		vfd a36/    ,36/i_n,36/16,36/(r4dg-l_org)/5,36/0
	fdrc:	vfd a36/s   ,36/i_n,36/0,36/(l_189-l_org)/5,36/0
l_189:		vfd a36/s   ,36/i_r,36/r_contains,36/(l_190-l_org)/5,36/0
l_190:		vfd a36/    ,36/i_c,36/c_67,36/(l_191-l_org)/5,36/a_107
		vfd a36/    ,36/i_n,36/141,36/(r4dg-l_org)/5,36/0
l_191:		vfd a36/s   ,36/i_c,36/c_int,36/(l_192-l_org)/5,36/a_120
		vfd a36/    ,36/i_n,36/25,36/(r4dg-l_org)/5,36/0
l_192:		vfd a36/s   ,36/i_r,36/r_to,36/(rcint-l_org)/5,36/0
	rcch:	vfd a36/s   ,36/i_r,36/r_characters,36/(l_193-l_org)/5,36/0
l_193:		vfd a36/    ,36/i_r,36/r_depending,36/(l_194-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdclauses-l_org)/5,36/0
l_194:		vfd a36/s5  ,36/i_n,36/102,36/(l_195-l_org)/5,36/25
l_195:		vfd a36/s   ,36/i_r,36/r_on,36/(l_196-l_org)/5,36/0
l_196:		vfd a36/s   ,36/i_c,36/c_type8,36/(fdclauses-l_org)/5,36/a_96
		vfd a36/    ,36/i_n,36/020,36/(fdclauses-l_org)/5,36/0
	rcint:	vfd a36/s   ,36/i_c,36/c_int,36/(rcch-l_org)/5,36/a_122
		vfd a36/    ,36/i_n,36/17,36/(r4dg-l_org)/5,36/0
	fdlr:	vfd a36/s   ,36/i_n,36/0,36/(l_197-l_org)/5,36/0
l_197:		vfd a36/s   ,36/i_r,36/r_records,36/(fdlr1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_record,36/(l_198-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r4dg-l_org)/5,36/0
l_198:		vfd a36/s   ,36/i_r,36/r_is,36/(fdlr2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdlr2-l_org)/5,36/0
	fdlr1:	vfd a36/s   ,36/i_r,36/r_are,36/(l_199-l_org)/5,36/0
l_199:	fdlr2:	vfd a36/    ,36/i_c,36/c_68,36/(l_200-l_org)/5,36/a_108
		vfd a36/    ,36/i_n,36/142,36/(r4dg-l_org)/5,36/0
l_200:		vfd a36/s   ,36/i_r,36/r_standard,36/(fdclauses-l_org)/5,36/a_124
		vfd a36/s   ,36/i_r,36/r_omitted,36/(fdclauses-l_org)/5,36/a_123
		vfd a36/    ,36/i_n,36/148,36/(r4dg-l_org)/5,36/0
l_201:		vfd a36/s   ,36/i_n,36/0,36/(fdclauses-l_org)/5,36/0
	fdvo:	vfd a36/s   ,36/i_n,36/0,36/(l_202-l_org)/5,36/0
l_202:		vfd a36/s   ,36/i_r,36/r_of,36/(l_203-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_203-l_org)/5,36/0
l_203:		vfd a36/    ,36/i_c,36/c_69,36/(l_204-l_org)/5,36/a_109
		vfd a36/    ,36/i_n,36/143,36/(r4dg-l_org)/5,36/0
l_204:		vfd a36/s   ,36/i_c,36/c_labnam,36/(l_205-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_type8,36/(fdvo4-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/020,36/(r4dg-l_org)/5,36/0
l_205:	fdvo1:	vfd a36/s   ,36/i_r,36/r_is,36/(l_206-l_org)/5,36/0
l_206:		vfd a36/    ,36/i_c,36/c_type8,36/(fdvo3-l_org)/5,36/a_127
		vfd a36/s   ,36/i_c,36/c_all,36/(l_207-l_org)/5,36/0
l_207:		vfd a36/s   ,36/i_c,36/c_labval,36/(fdvo2-l_org)/5,36/a_126
		vfd a36/    ,36/i_n,36/223,36/(r4dg-l_org)/5,36/0
	fdvo3:	vfd a36/    ,36/i_n,36/0,36/(l_208-l_org)/5,36/a_82
		vfd a36/    ,36/i_n,36/208,36/(r4dg-l_org)/5,36/0
l_208:		vfd a36/s3  ,36/i_n,36/155,36/(l_209-l_org)/5,36/16
		vfd a36/s3  ,36/i_n,36/155,36/(l_209-l_org)/5,36/18
		vfd a36/s4  ,36/i_n,36/155,36/(l_209-l_org)/5,36/20
		vfd a36/    ,36/i_n,36/208,36/(l_209-l_org)/5,36/0
		vfd a36/s5  ,36/i_n,36/155,36/(l_209-l_org)/5,36/26
l_209:		vfd a36/    ,36/i_s,36/(qual-l_org)/5,36/(l_210-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r4dg-l_org)/5,36/0
l_210:	fdvo2:	vfd a36/s   ,36/i_c,36/c_labnam,36/(fdvo1-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_type8,36/(l_211-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(fdclauses-l_org)/5,36/0
l_211:	fdvo4:	vfd a36/    ,36/i_n,36/214,36/(l_212-l_org)/5,36/0
l_212:		vfd a36/    ,36/i_s,36/(skipqual-l_org)/5,36/(l_213-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r4dg-l_org)/5,36/0
l_213:		vfd a36/s   ,36/i_r,36/r_is,36/(l_214-l_org)/5,36/0
l_214:		vfd a36/s   ,36/i_c,36/c_type8,36/(fdvo5-l_org)/5,36/0
		vfd a36/s   ,36/i_c,36/c_all,36/(l_215-l_org)/5,36/0
l_215:		vfd a36/s   ,36/i_c,36/c_labval,36/(fdvo2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/223,36/(r4dg-l_org)/5,36/0
	fdvo5:	vfd a36/    ,36/i_s,36/(skipqual-l_org)/5,36/(fdvo2-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(r4dg-l_org)/5,36/0
	skipqual:	vfd a36/s3  ,36/i_r,36/r_of,36/(l_216-l_org)/5,36/5
		vfd a36/s3  ,36/i_r,36/r_in,36/(l_216-l_org)/5,36/5
		vfd a36/    ,36/i_n,36/0,36/(success-l_org)/5,36/a_1
l_216:		vfd a36/s   ,36/i_c,36/c_type8,36/(skipqual-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/020,36/(failure-l_org)/5,36/a_2
	qual:	vfd a36/s3  ,36/i_r,36/r_of,36/(l_217-l_org)/5,36/5
		vfd a36/s3  ,36/i_r,36/r_in,36/(l_217-l_org)/5,36/5
		vfd a36/    ,36/i_n,36/0,36/(success-l_org)/5,36/a_1
l_217:		vfd a36/s   ,36/i_c,36/c_type8,36/(qual-l_org)/5,36/a_128
		vfd a36/    ,36/i_n,36/020,36/(failure-l_org)/5,36/a_2
	fddr:	vfd a36/s   ,36/i_n,36/0,36/(l_218-l_org)/5,36/0
l_218:		vfd a36/s   ,36/i_r,36/r_record,36/(l_219-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_records,36/(l_219-l_org)/5,36/0
l_219:		vfd a36/s   ,36/i_r,36/r_is,36/(l_220-l_org)/5,36/0
l_220:		vfd a36/    ,36/i_c,36/c_70,36/(l_221-l_org)/5,36/a_110
		vfd a36/    ,36/i_n,36/144,36/(r4dg-l_org)/5,36/0
l_221:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_222-l_org)/5,36/a_129
		vfd a36/    ,36/i_n,36/020,36/(r4dg-l_org)/5,36/0
l_222:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_222-l_org)/5,36/a_129
		vfd a36/    ,36/i_n,36/0,36/(fdclauses-l_org)/5,36/0
	fdri:	vfd a36/s   ,36/i_n,36/0,36/(l_223-l_org)/5,36/0
l_223:		vfd a36/s   ,36/i_r,36/r_is,36/(l_224-l_org)/5,36/0
l_224:		vfd a36/    ,36/i_c,36/c_71,36/(l_225-l_org)/5,36/a_111
		vfd a36/    ,36/i_n,36/145,36/(r4dg-l_org)/5,36/0
l_225:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_226-l_org)/5,36/a_130
		vfd a36/    ,36/i_n,36/020,36/(r4dg-l_org)/5,36/0
l_226:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_226-l_org)/5,36/a_130
		vfd a36/    ,36/i_n,36/0,36/(fdclauses-l_org)/5,36/0
	fdli:	vfd a36/    ,36/i_n,36/0,36/(l_227-l_org)/5,36/a_82
		vfd a36/    ,36/i_n,36/208,36/(r4dg-l_org)/5,36/0
l_227:		vfd a36/s   ,36/i_n,36/0,36/(l_228-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/224,36/(r4dg-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/224,36/(r4dg-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/208,36/(r4dg-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/224,36/(r4dg-l_org)/5,36/0
l_228:		vfd a36/s   ,36/i_r,36/r_is,36/(l_229-l_org)/5,36/0
l_229:		vfd a36/    ,36/i_c,36/c_72,36/(l_230-l_org)/5,36/a_112
		vfd a36/    ,36/i_n,36/146,36/(r4dg-l_org)/5,36/0
l_230:		vfd a36/s   ,36/i_c,36/c_int,36/(l_231-l_org)/5,36/a_132
		vfd a36/s   ,36/i_c,36/c_type8,36/(l_231-l_org)/5,36/a_131
		vfd a36/    ,36/i_n,36/023,36/(r4dg-l_org)/5,36/0
l_231:		vfd a36/s   ,36/i_r,36/r_lines,36/(l_232-l_org)/5,36/0
l_232:	li_phrase:	vfd a36/s   ,36/i_r,36/r_lines,36/(li_lines-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_with,36/(li_foot-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_footing,36/(li_foot-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_at,36/(li_linesx-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_top,36/(li_top-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_bottom,36/(li_botm-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_233-l_org)/5,36/a_101
l_233:		vfd a36/    ,36/i_c,36/c_16,36/(fdclauses-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/179,36/(fdclauses-l_org)/5,36/0
	li_lines:	vfd a36/s   ,36/i_r,36/r_at,36/(l_234-l_org)/5,36/0
l_234:	li_linesx:	vfd a36/s   ,36/i_r,36/r_top,36/(li_top-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_bottom,36/(li_botm-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/174,36/(r4dg-l_org)/5,36/0
	li_top:	vfd a36/    ,36/i_c,36/c_49,36/(l_235-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/022,36/(l_235-l_org)/5,36/0
l_235:		vfd a36/s   ,36/i_c,36/c_int,36/(li_phrase-l_org)/5,36/a_133
		vfd a36/s   ,36/i_c,36/c_type8,36/(li_phrase-l_org)/5,36/a_121
		vfd a36/s   ,36/i_r,36/r_zero,36/(li_phrase-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/021,36/(r4dg-l_org)/5,36/0
	li_botm:	vfd a36/    ,36/i_c,36/c_41,36/(l_236-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/175,36/(l_236-l_org)/5,36/0
l_236:		vfd a36/s   ,36/i_c,36/c_int,36/(li_phrase-l_org)/5,36/a_119
		vfd a36/s   ,36/i_c,36/c_type8,36/(li_phrase-l_org)/5,36/a_118
		vfd a36/s   ,36/i_r,36/r_zero,36/(li_phrase-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/021,36/(r4dg-l_org)/5,36/0
	li_foot:	vfd a36/s   ,36/i_r,36/r_footing,36/(l_237-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/178,36/(r4dg-l_org)/5,36/0
l_237:		vfd a36/s   ,36/i_r,36/r_at,36/(l_238-l_org)/5,36/0
l_238:		vfd a36/    ,36/i_c,36/c_40,36/(l_239-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/176,36/(l_239-l_org)/5,36/0
l_239:		vfd a36/s   ,36/i_c,36/c_int,36/(li_phrase-l_org)/5,36/a_103
		vfd a36/s   ,36/i_c,36/c_type8,36/(li_phrase-l_org)/5,36/a_102
		vfd a36/    ,36/i_n,36/021,36/(r4dg-l_org)/5,36/0
	fdcs:	vfd a36/    ,36/i_n,36/0,36/(l_240-l_org)/5,36/a_82
		vfd a36/    ,36/i_n,36/208,36/(r4dg-l_org)/5,36/0
l_240:		vfd a36/s   ,36/i_n,36/0,36/(l_241-l_org)/5,36/0
		vfd a36/s5  ,36/i_n,36/168,36/(l_241-l_org)/5,36/25
		vfd a36/s5  ,36/i_n,36/168,36/(l_241-l_org)/5,36/25
		vfd a36/s   ,36/i_n,36/224,36/(r4dg-l_org)/5,36/0
		vfd a36/s5  ,36/i_n,36/168,36/(l_241-l_org)/5,36/25
l_241:		vfd a36/s   ,36/i_r,36/r_is,36/(l_242-l_org)/5,36/0
l_242:		vfd a36/s   ,36/i_c,36/c_codeset,36/(fdclauses-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/186,36/(r4dg-l_org)/5,36/0
	r1dg:	vfd a36/    ,36/i_n,36/152,36/(l_243-l_org)/5,36/0
l_243:	r1:	vfd a36/    ,36/i_c,36/c_55,36/(l_244-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev77,36/(r1x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(r1x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r1x3-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r1-l_org)/5,36/0
l_244:		vfd a36/    ,36/i_n,36/150,36/(fsps-l_org)/5,36/0
	r1x2:	vfd a36/    ,36/i_n,36/151,36/(wssstrt-l_org)/5,36/0
	r1x3:	vfd a36/s   ,36/i_n,36/154,36/(jumpbase0-l_org)/5,36/a_4
	r2dg:	vfd a36/    ,36/i_n,36/152,36/(l_245-l_org)/5,36/0
l_245:	r2:	vfd a36/    ,36/i_c,36/c_55,36/(r2x1-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(l_246-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r2x2-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r2-l_org)/5,36/0
l_246:		vfd a36/    ,36/i_n,36/154,36/(fd01-l_org)/5,36/0
	r2x1:	vfd a36/    ,36/i_n,36/154,36/(fsindjump-l_org)/5,36/0
	r2x2:	vfd a36/    ,36/i_n,36/154,36/(sj-l_org)/5,36/a_80
	r3dg:	vfd a36/    ,36/i_n,36/152,36/(l_247-l_org)/5,36/0
l_247:	r3:	vfd a36/    ,36/i_n,36/0,36/(l_248-l_org)/5,36/0
l_248:		vfd a36/s   ,36/i_r,36/r_per,36/(l_249-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(l_249-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_55,36/(r3x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r3x3-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(l_248-l_org)/5,36/0
l_249:		vfd a36/    ,36/i_n,36/154,36/(sa01-l_org)/5,36/0
	r3x2:	vfd a36/    ,36/i_n,36/154,36/(jumpbase1-l_org)/5,36/a_4
	r3x3:	vfd a36/    ,36/i_n,36/154,36/(jumpbase0-l_org)/5,36/a_4
	r4dg:	vfd a36/    ,36/i_n,36/152,36/(l_250-l_org)/5,36/0
l_250:	r4:	vfd a36/    ,36/i_c,36/c_61,36/(l_251-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_per,36/(l_251-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(r4x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_55,36/(r4x3-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r4x4-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r4-l_org)/5,36/0
l_251:		vfd a36/    ,36/i_n,36/154,36/(fdclauses-l_org)/5,36/0
	r4x2:	vfd a36/    ,36/i_n,36/154,36/(fd01-l_org)/5,36/0
	r4x3:	vfd a36/    ,36/i_n,36/154,36/(fsindjump-l_org)/5,36/0
	r4x4:	vfd a36/    ,36/i_n,36/154,36/(sj-l_org)/5,36/a_80
	r40dg:	vfd a36/    ,36/i_n,36/152,36/(l_252-l_org)/5,36/0
l_252:	r40:	vfd a36/    ,36/i_c,36/c_55,36/(r4x3-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r4x4-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r40-l_org)/5,36/0
	r5dg:	vfd a36/    ,36/i_n,36/152,36/(l_253-l_org)/5,36/0
l_253:	r5:	vfd a36/    ,36/i_r,36/r_per,36/(r5x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_12,36/(l_254-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r5x2-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r5-l_org)/5,36/0
l_254:		vfd a36/    ,36/i_n,36/154,36/(ddcls_1-l_org)/5,36/0
	r5x2:	vfd a36/    ,36/i_n,36/154,36/(failure-l_org)/5,36/a_2
	r7dg:	vfd a36/    ,36/i_n,36/152,36/(l_255-l_org)/5,36/0
l_255:	r7:	vfd a36/    ,36/i_c,36/c_lev77,36/(l_256-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(l_256-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r7x2-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r7-l_org)/5,36/0
l_256:		vfd a36/    ,36/i_n,36/154,36/(test77-l_org)/5,36/0
	r7x2:	vfd a36/    ,36/i_n,36/154,36/(failure-l_org)/5,36/a_2
	r8dg:	vfd a36/    ,36/i_n,36/152,36/(l_257-l_org)/5,36/0
l_257:	r8:	vfd a36/    ,36/i_c,36/c_lev0249,36/(l_258-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(l_258-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_55,36/(l_258-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_cd,36/(l_258-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(l_258-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r8-l_org)/5,36/0
l_258:		vfd a36/    ,36/i_n,36/154,36/(testnext-l_org)/5,36/0
	r9dg:	vfd a36/    ,36/i_n,36/152,36/(l_259-l_org)/5,36/0
l_259:	r9:	vfd a36/    ,36/i_c,36/c_12,36/(r9x1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_per,36/(r9x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_int,36/(l_260-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r9x2-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r9-l_org)/5,36/0
l_260:		vfd a36/    ,36/i_c,36/c_lev0249,36/(r9x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev77,36/(r9x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(r9x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev88,36/(r9x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev66,36/(r9x2-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r9-l_org)/5,36/0
	r9x1:	vfd a36/    ,36/i_n,36/154,36/(ddcls_1-l_org)/5,36/0
	r9x2:	vfd a36/    ,36/i_n,36/154,36/(failure-l_org)/5,36/a_2
	r10dg:	vfd a36/    ,36/i_n,36/152,36/(l_261-l_org)/5,36/0
l_261:	r10:	vfd a36/    ,36/i_c,36/c_lev77,36/(l_262-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(r10x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r10x3-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r10-l_org)/5,36/0
l_262:		vfd a36/    ,36/i_n,36/154,36/(test77-l_org)/5,36/0
	r10x2:	vfd a36/    ,36/i_n,36/154,36/(test01-l_org)/5,36/0
	r10x3:	vfd a36/    ,36/i_n,36/154,36/(databody-l_org)/5,36/0
	r11dg:	vfd a36/    ,36/i_n,36/152,36/(l_263-l_org)/5,36/0
l_263:	r11:	vfd a36/    ,36/i_r,36/r_per,36/(r11x1-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_int,36/(l_264-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r11x2-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r11-l_org)/5,36/0
l_264:		vfd a36/    ,36/i_c,36/c_lev88,36/(r11x3-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev0249,36/(r11x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(r11x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev77,36/(r11x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev66,36/(r11x2-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r11-l_org)/5,36/0
	r11x1:	vfd a36/    ,36/i_n,36/154,36/(end88-l_org)/5,36/0
	r11x2:	vfd a36/    ,36/i_n,36/154,36/(failure-l_org)/5,36/a_2
	r11x3:	vfd a36/s   ,36/i_n,36/154,36/(entry88-l_org)/5,36/a_19
	r12dg:	vfd a36/    ,36/i_n,36/152,36/(l_265-l_org)/5,36/0
l_265:	r12:	vfd a36/    ,36/i_r,36/r_per,36/(r12x1-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_int,36/(l_266-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r12x2-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r12-l_org)/5,36/0
l_266:		vfd a36/    ,36/i_c,36/c_lev66,36/(r12x4-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(r12x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev0249,36/(r12x3-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev77,36/(r12x3-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev88,36/(r12x3-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r12-l_org)/5,36/0
	r12x1:	vfd a36/    ,36/i_n,36/154,36/(rnm-l_org)/5,36/0
	r12x2:	vfd a36/    ,36/i_n,36/154,36/(failure-l_org)/5,36/a_2
	r12x3:	vfd a36/    ,36/i_n,36/163,36/(r12x2-l_org)/5,36/0
	r12x4:	vfd a36/s   ,36/i_n,36/154,36/(entry66-l_org)/5,36/a_8
	r13:	vfd a36/    ,36/i_c,36/c_62,36/(l_267-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(l_267-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_55,36/(l_267-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r13-l_org)/5,36/0
l_267:		vfd a36/    ,36/i_n,36/154,36/(success-l_org)/5,36/a_1
	r16dg:	vfd a36/    ,36/i_n,36/152,36/(l_268-l_org)/5,36/0
l_268:	r16:	vfd a36/    ,36/i_r,36/r_depending,36/(r16x2-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_ascending,36/(r16x3-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_descending,36/(r16x3-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_indexed,36/(r16x3-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_12,36/(r16x4-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_per,36/(r16x1-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_int,36/(l_269-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r16x1-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r16-l_org)/5,36/0
l_269:		vfd a36/    ,36/i_c,36/c_lev0249,36/(l_270-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(l_270-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev77,36/(l_270-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev88,36/(l_270-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev66,36/(l_270-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r16-l_org)/5,36/0
l_270:	r16x1:	vfd a36/    ,36/i_n,36/154,36/(failure-l_org)/5,36/a_2
	r16x2:	vfd a36/    ,36/i_n,36/154,36/(odpdon-l_org)/5,36/0
	r16x3:	vfd a36/    ,36/i_n,36/154,36/(occ_adi-l_org)/5,36/0
	r16x4:	vfd a36/    ,36/i_n,36/154,36/(ddcls_1-l_org)/5,36/0
	r17dg:	vfd a36/    ,36/i_n,36/152,36/(l_271-l_org)/5,36/0
l_271:	r17:	vfd a36/    ,36/i_r,36/r_cd,36/(l_272-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_lev01,36/(l_272-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r17x2-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r17-l_org)/5,36/0
l_272:		vfd a36/    ,36/i_n,36/154,36/(nncd-l_org)/5,36/0
	r17x2:	vfd a36/    ,36/i_n,36/154,36/(sj-l_org)/5,36/0
	r18dg:	vfd a36/    ,36/i_n,36/152,36/(l_273-l_org)/5,36/0
l_273:	r18:	vfd a36/    ,36/i_c,36/c_83,36/(l_274-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_per,36/(l_274-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_cd,36/(r18x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r18x3-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r18-l_org)/5,36/0
l_274:		vfd a36/    ,36/i_n,36/154,36/(cdclaus-l_org)/5,36/0
	r18x2:	vfd a36/    ,36/i_n,36/154,36/(nncd-l_org)/5,36/0
	r18x3:	vfd a36/    ,36/i_n,36/154,36/(sj-l_org)/5,36/0
	r19dg:	vfd a36/    ,36/i_n,36/152,36/(l_275-l_org)/5,36/0
l_275:	r19:	vfd a36/    ,36/i_c,36/c_96,36/(l_276-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_per,36/(l_276-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_cd,36/(r19x2-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_62,36/(r19x3-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(r19-l_org)/5,36/0
l_276:		vfd a36/    ,36/i_n,36/154,36/(cdopclaus-l_org)/5,36/0
	r19x2:	vfd a36/    ,36/i_n,36/154,36/(nncd-l_org)/5,36/0
	r19x3:	vfd a36/    ,36/i_n,36/154,36/(sj-l_org)/5,36/0
	cms:	vfd a36/s3  ,36/i_n,36/148,36/(l_277-l_org)/5,36/23
l_277:	cmsc:	vfd a36/s   ,36/i_r,36/r_section,36/(l_278-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/2,36/(l_278-l_org)/5,36/0
l_278:		vfd a36/s   ,36/i_r,36/r_per,36/(l_279-l_org)/5,36/a_62
		vfd a36/    ,36/i_n,36/3,36/(l_279-l_org)/5,36/a_62
l_279:		vfd a36/    ,36/i_c,36/c_81,36/(l_280-l_org)/5,36/a_140
		vfd a36/    ,36/i_n,36/96,36/(l_280-l_org)/5,36/0
l_280:		vfd a36/    ,36/i_c,36/c_80,36/(l_281-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/94,36/(l_281-l_org)/5,36/0
l_281:		vfd a36/    ,36/i_r,36/r_cd,36/(l_282-l_org)/5,36/a_141
		vfd a36/    ,36/i_n,36/0,36/(sj-l_org)/5,36/0
l_282:	ncd_1:	vfd a36/s3  ,36/i_n,36/149,36/(l_283-l_org)/5,36/23
l_283:	ncd:	vfd a36/s   ,36/i_c,36/c_type8,36/(l_284-l_org)/5,36/a_142
		vfd a36/    ,36/i_n,36/98,36/(r18dg-l_org)/5,36/0
l_284:		vfd a36/s   ,36/i_r,36/r_for,36/(l_285-l_org)/5,36/0
l_285:		vfd a36/s   ,36/i_r,36/r_output,36/(cdoutput-l_org)/5,36/a_143
		vfd a36/    ,36/i_r,36/r_initial,36/(l_286-l_org)/5,36/a_78
		vfd a36/    ,36/i_n,36/0,36/(ckin-l_org)/5,36/0
l_286:		vfd a36/s3  ,36/i_n,36/150,36/(l_287-l_org)/5,36/24
l_287:	ncd1:	vfd a36/    ,36/i_c,36/c_82,36/(l_288-l_org)/5,36/a_145
		vfd a36/    ,36/i_n,36/100,36/(l_288-l_org)/5,36/0
l_288:	ckin:	vfd a36/s   ,36/i_r,36/r_input,36/(cdinput-l_org)/5,36/a_144
		vfd a36/    ,36/i_n,36/99,36/(r18dg-l_org)/5,36/0
	cd01:	vfd a36/s   ,36/i_c,36/c_lev01,36/(cd01rd-l_org)/5,36/a_8
		vfd a36/    ,36/i_n,36/0,36/(r17dg-l_org)/5,36/0
	cdinput:	vfd a36/s   ,36/i_r,36/r_per,36/(cd01-l_org)/5,36/0
		vfd a36/    ,36/i_c,36/c_type8,36/(cdidn-l_org)/5,36/a_146
		vfd a36/    ,36/i_r,36/r_filler,36/(cdidn-l_org)/5,36/a_146
	cdclaus:	vfd a36/    ,36/i_c,36/c_83,36/(l_289-l_org)/5,36/a_4
		vfd a36/s   ,36/i_r,36/r_per,36/(nncd-l_org)/5,36/a_149
		vfd a36/    ,36/i_n,36/170,36/(r17dg-l_org)/5,36/a_149
l_289:		vfd a36/    ,36/i_n,36/0,36/(symbolic-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(message-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(text-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(end-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(status-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(count-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(symbolic-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(symbolic-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(symbolic-l_org)/5,36/0
	cdidn:	vfd a36/s   ,36/i_c,36/c_type8,36/(cdidn-l_org)/5,36/a_147
		vfd a36/s   ,36/i_r,36/r_filler,36/(cdidn-l_org)/5,36/a_148
		vfd a36/s   ,36/i_r,36/r_per,36/(l_290-l_org)/5,36/a_149
		vfd a36/    ,36/i_n,36/3,36/(l_290-l_org)/5,36/0
l_290:	nncd:	vfd a36/    ,36/i_r,36/r_cd,36/(ncd_1-l_org)/5,36/a_141
		vfd a36/s   ,36/i_c,36/c_lev01,36/(l_291-l_org)/5,36/a_8
		vfd a36/    ,36/i_c,36/c_62,36/(sj-l_org)/5,36/a_90
		vfd a36/    ,36/i_n,36/103,36/(r17dg-l_org)/5,36/0
l_291:	cd01rd:	vfd a36/s   ,36/i_c,36/c_type8,36/(l_292-l_org)/5,36/a_12
		vfd a36/s   ,36/i_r,36/r_filler,36/(l_292-l_org)/5,36/a_14
		vfd a36/    ,36/i_n,36/20,36/(l_292-l_org)/5,36/a_13
l_292:		vfd a36/    ,36/i_n,36/0,36/(l_293-l_org)/5,36/a_91
l_293:		vfd a36/    ,36/i_s,36/(record01-l_org)/5,36/(l_294-l_org)/5,36/a_62
		vfd a36/    ,36/i_n,36/0,36/(l_294-l_org)/5,36/0
l_294:		vfd a36/    ,36/i_c,36/c_84,36/(l_295-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/203,36/(l_295-l_org)/5,36/0
l_295:		vfd a36/s   ,36/i_c,36/c_lev01,36/(cd01rd-l_org)/5,36/a_8
		vfd a36/    ,36/i_r,36/r_cd,36/(ncd_1-l_org)/5,36/a_141
		vfd a36/    ,36/i_c,36/c_62,36/(sj-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/103,36/(r17dg-l_org)/5,36/0
	symbolic:	vfd a36/s   ,36/i_r,36/r_symbolic,36/(l_296-l_org)/5,36/0
l_296:		vfd a36/s   ,36/i_r,36/r_queue,36/(l_297-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_sub_queue_1,36/(sq1-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_sub_queue_2,36/(sq2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_sub_queue_3,36/(sq3-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_source,36/(src-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/170,36/(r18dg-l_org)/5,36/0
l_297:		vfd a36/s   ,36/i_r,36/r_is,36/(l_298-l_org)/5,36/0
l_298:		vfd a36/    ,36/i_c,36/c_type8,36/(l_299-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_299-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/170,36/(r18dg-l_org)/5,36/0
l_299:		vfd a36/s   ,36/i_c,36/c_85,36/(cdclaus-l_org)/5,36/a_150
		vfd a36/s   ,36/i_n,36/108,36/(cdclaus-l_org)/5,36/0
	sq1:	vfd a36/s   ,36/i_r,36/r_is,36/(l_300-l_org)/5,36/0
l_300:		vfd a36/    ,36/i_c,36/c_type8,36/(l_301-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_301-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/120,36/(r18dg-l_org)/5,36/0
l_301:		vfd a36/s   ,36/i_c,36/c_87,36/(cdclaus-l_org)/5,36/a_151
		vfd a36/s   ,36/i_n,36/105,36/(cdclaus-l_org)/5,36/0
	sq2:	vfd a36/s   ,36/i_r,36/r_is,36/(l_302-l_org)/5,36/0
l_302:		vfd a36/    ,36/i_c,36/c_type8,36/(l_303-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_303-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r18dg-l_org)/5,36/0
l_303:		vfd a36/s   ,36/i_c,36/c_88,36/(cdclaus-l_org)/5,36/a_152
		vfd a36/s   ,36/i_n,36/106,36/(cdclaus-l_org)/5,36/0
	sq3:	vfd a36/s   ,36/i_r,36/r_is,36/(l_304-l_org)/5,36/0
l_304:		vfd a36/    ,36/i_c,36/c_type8,36/(l_305-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_305-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r18dg-l_org)/5,36/0
l_305:		vfd a36/s   ,36/i_c,36/c_89,36/(cdclaus-l_org)/5,36/a_153
		vfd a36/s   ,36/i_n,36/107,36/(cdclaus-l_org)/5,36/0
	src:	vfd a36/s   ,36/i_r,36/r_is,36/(l_306-l_org)/5,36/0
l_306:		vfd a36/    ,36/i_c,36/c_type8,36/(l_307-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_307-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r18dg-l_org)/5,36/0
l_307:		vfd a36/s   ,36/i_c,36/c_90,36/(cdclaus-l_org)/5,36/a_156
		vfd a36/s   ,36/i_n,36/115,36/(cdclaus-l_org)/5,36/0
	message:	vfd a36/s   ,36/i_r,36/r_date,36/(l_308-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_time,36/(ms2-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_count,36/(count-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/170,36/(r18dg-l_org)/5,36/0
l_308:		vfd a36/s   ,36/i_r,36/r_is,36/(l_309-l_org)/5,36/0
l_309:		vfd a36/    ,36/i_c,36/c_type8,36/(l_310-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_310-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r18dg-l_org)/5,36/0
l_310:		vfd a36/s   ,36/i_c,36/c_91,36/(cdclaus-l_org)/5,36/a_154
		vfd a36/s   ,36/i_n,36/109,36/(cdclaus-l_org)/5,36/0
	ms2:	vfd a36/s   ,36/i_r,36/r_is,36/(l_311-l_org)/5,36/0
l_311:		vfd a36/    ,36/i_c,36/c_type8,36/(l_312-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_312-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r18dg-l_org)/5,36/0
l_312:		vfd a36/s   ,36/i_c,36/c_92,36/(cdclaus-l_org)/5,36/a_155
		vfd a36/s   ,36/i_n,36/110,36/(cdclaus-l_org)/5,36/0
	count:	vfd a36/s   ,36/i_r,36/r_is,36/(l_313-l_org)/5,36/0
l_313:		vfd a36/    ,36/i_c,36/c_type8,36/(l_314-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_314-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r18dg-l_org)/5,36/0
l_314:		vfd a36/s   ,36/i_c,36/c_86,36/(cdclaus-l_org)/5,36/a_160
		vfd a36/s   ,36/i_n,36/170,36/(cdclaus-l_org)/5,36/0
	text:	vfd a36/s   ,36/i_r,36/r_length,36/(l_315-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/170,36/(r18dg-l_org)/5,36/0
l_315:		vfd a36/s   ,36/i_r,36/r_is,36/(l_316-l_org)/5,36/0
l_316:		vfd a36/    ,36/i_c,36/c_type8,36/(l_317-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_317-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r18dg-l_org)/5,36/0
l_317:		vfd a36/s   ,36/i_c,36/c_93,36/(cdclaus-l_org)/5,36/a_157
		vfd a36/s   ,36/i_n,36/111,36/(cdclaus-l_org)/5,36/0
	end:	vfd a36/s   ,36/i_r,36/r_key,36/(l_318-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/170,36/(r18dg-l_org)/5,36/0
l_318:		vfd a36/s   ,36/i_r,36/r_is,36/(l_319-l_org)/5,36/0
l_319:		vfd a36/    ,36/i_c,36/c_type8,36/(l_320-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_320-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r18dg-l_org)/5,36/0
l_320:		vfd a36/s   ,36/i_c,36/c_94,36/(cdclaus-l_org)/5,36/a_158
		vfd a36/s   ,36/i_n,36/112,36/(cdclaus-l_org)/5,36/0
	status:	vfd a36/s   ,36/i_r,36/r_key,36/(l_321-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/170,36/(r18dg-l_org)/5,36/0
l_321:		vfd a36/s   ,36/i_r,36/r_is,36/(l_322-l_org)/5,36/0
l_322:		vfd a36/    ,36/i_c,36/c_type8,36/(l_323-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_323-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r18dg-l_org)/5,36/0
l_323:		vfd a36/s   ,36/i_c,36/c_95,36/(cdclaus-l_org)/5,36/a_159
		vfd a36/s   ,36/i_n,36/113,36/(cdclaus-l_org)/5,36/0
	cdoutput:	vfd a36/s   ,36/i_r,36/r_per,36/(cd01-l_org)/5,36/0
	cdopclaus:	vfd a36/    ,36/i_c,36/c_96,36/(l_324-l_org)/5,36/a_4
		vfd a36/s   ,36/i_r,36/r_per,36/(nncd-l_org)/5,36/a_161
		vfd a36/    ,36/i_n,36/170,36/(r17dg-l_org)/5,36/a_161
l_324:		vfd a36/s   ,36/i_n,36/0,36/(symbolico-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(error-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(texto-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(destin-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/0,36/(statuso-l_org)/5,36/0
	destin:	vfd a36/s   ,36/i_r,36/r_count,36/(cdodc-l_org)/5,36/0
		vfd a36/s   ,36/i_r,36/r_table,36/(cdodt-l_org)/5,36/0
	diso:	vfd a36/s   ,36/i_r,36/r_is,36/(l_325-l_org)/5,36/0
l_325:		vfd a36/    ,36/i_c,36/c_type8,36/(l_326-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_326-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/170,36/(r19dg-l_org)/5,36/0
l_326:		vfd a36/s   ,36/i_c,36/c_91,36/(cdopclaus-l_org)/5,36/a_154
		vfd a36/s   ,36/i_n,36/124,36/(cdopclaus-l_org)/5,36/0
	cdodc:	vfd a36/s   ,36/i_r,36/r_is,36/(l_327-l_org)/5,36/0
l_327:		vfd a36/    ,36/i_c,36/c_type8,36/(l_328-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_328-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r19dg-l_org)/5,36/0
l_328:		vfd a36/s   ,36/i_c,36/c_85,36/(cdopclaus-l_org)/5,36/a_150
		vfd a36/s   ,36/i_n,36/119,36/(cdopclaus-l_org)/5,36/0
	symbolico:	vfd a36/s   ,36/i_r,36/r_destination,36/(diso-l_org)/5,36/0
		vfd a36/s   ,36/i_n,36/170,36/(r19dg-l_org)/5,36/0
	cdodt:	vfd a36/s   ,36/i_r,36/r_occurs,36/(l_329-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/170,36/(r19dg-l_org)/5,36/0
l_329:		vfd a36/s   ,36/i_c,36/c_int,36/(l_330-l_org)/5,36/a_162
		vfd a36/    ,36/i_n,36/84,36/(r19dg-l_org)/5,36/0
l_330:		vfd a36/s   ,36/i_r,36/r_times,36/(l_331-l_org)/5,36/0
l_331:		vfd a36/s   ,36/i_r,36/r_indexed,36/(l_332-l_org)/5,36/a_163
		vfd a36/    ,36/i_n,36/0,36/(cdopclaus-l_org)/5,36/0
l_332:		vfd a36/s   ,36/i_r,36/r_by,36/(l_333-l_org)/5,36/0
l_333:		vfd a36/s   ,36/i_c,36/c_type8,36/(l_333-l_org)/5,36/a_164
		vfd a36/    ,36/i_n,36/0,36/(cdopclaus-l_org)/5,36/0
	error:	vfd a36/s   ,36/i_r,36/r_key,36/(l_334-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/172,36/(r19dg-l_org)/5,36/0
l_334:		vfd a36/s   ,36/i_r,36/r_is,36/(l_335-l_org)/5,36/0
l_335:		vfd a36/    ,36/i_c,36/c_type8,36/(l_336-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_336-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r19dg-l_org)/5,36/0
l_336:		vfd a36/s   ,36/i_c,36/c_89,36/(cdopclaus-l_org)/5,36/a_153
		vfd a36/s   ,36/i_n,36/123,36/(cdopclaus-l_org)/5,36/0
	statuso:	vfd a36/s   ,36/i_r,36/r_key,36/(l_337-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/172,36/(r19dg-l_org)/5,36/0
l_337:		vfd a36/s   ,36/i_r,36/r_is,36/(l_338-l_org)/5,36/0
l_338:		vfd a36/    ,36/i_c,36/c_type8,36/(l_339-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_339-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r19dg-l_org)/5,36/0
l_339:		vfd a36/s   ,36/i_c,36/c_88,36/(cdopclaus-l_org)/5,36/a_152
		vfd a36/s   ,36/i_n,36/121,36/(cdopclaus-l_org)/5,36/0
	texto:	vfd a36/s   ,36/i_r,36/r_length,36/(l_340-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/173,36/(r19dg-l_org)/5,36/0
l_340:		vfd a36/s   ,36/i_r,36/r_is,36/(l_341-l_org)/5,36/0
l_341:		vfd a36/    ,36/i_c,36/c_type8,36/(l_342-l_org)/5,36/0
		vfd a36/    ,36/i_r,36/r_filler,36/(l_342-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/20,36/(r19dg-l_org)/5,36/0
l_342:		vfd a36/s   ,36/i_c,36/c_87,36/(cdopclaus-l_org)/5,36/a_151
		vfd a36/s   ,36/i_n,36/0,36/(cdopclaus-l_org)/5,36/a_120
	success:	vfd a36/    ,36/i_n,36/0,36/(success-l_org)/5,36/0
	failure:	vfd a36/    ,36/i_n,36/0,36/(failure-l_org)/5,36/0
		vfd a36/    ,36/i_n,36/0,36/(l_343-l_org)/5,36/0
l_343:		vfd a36/    ,36/i_r,36/r_block,36/(l_343-l_org)/5,36/0
l_344:		vfd a36/    ,36/i_r,36/r_catalog_name,36/(l_344-l_org)/5,36/0
l_345:		vfd a36/    ,36/i_r,36/r_label,36/(l_345-l_org)/5,36/0
l_346:		vfd a36/    ,36/i_r,36/r_computational,36/(l_346-l_org)/5,36/0
l_347:		vfd a36/    ,36/i_r,36/r_computational_1,36/(l_347-l_org)/5,36/0
l_348:		vfd a36/    ,36/i_r,36/r_computational_2,36/(l_348-l_org)/5,36/0
l_349:		vfd a36/    ,36/i_r,36/r_computational_3,36/(l_349-l_org)/5,36/0
l_350:		vfd a36/    ,36/i_r,36/r_computational_4,36/(l_350-l_org)/5,36/0
l_351:		vfd a36/    ,36/i_r,36/r_computational_5,36/(l_351-l_org)/5,36/0
l_352:		vfd a36/    ,36/i_r,36/r_computational_6,36/(l_352-l_org)/5,36/0
l_353:		vfd a36/    ,36/i_r,36/r_computational_7,36/(l_353-l_org)/5,36/0
l_354:		vfd a36/    ,36/i_r,36/r_computational_8,36/(l_354-l_org)/5,36/0
l_355:		vfd a36/    ,36/i_r,36/r_limits,36/(l_355-l_org)/5,36/0
l_356:		vfd a36/    ,36/i_r,36/r_line,36/(l_356-l_org)/5,36/0
l_357:		vfd a36/    ,36/i_r,36/r_procedure,36/(l_357-l_org)/5,36/0
l_358:		vfd a36/    ,36/i_r,36/r_constant,36/(l_358-l_org)/5,36/0
l_359:		vfd a36/    ,36/i_r,36/r_file,36/(l_359-l_org)/5,36/0
l_360:		vfd a36/    ,36/i_r,36/r_working_storage,36/(l_360-l_org)/5,36/0
l_361:		vfd a36/    ,36/i_r,36/r_linkage,36/(l_361-l_org)/5,36/0
l_362:		vfd a36/    ,36/i_r,36/r_report,36/(l_362-l_org)/5,36/0
l_363:		vfd a36/    ,36/i_r,36/r_fd,36/(l_363-l_org)/5,36/0
l_364:		vfd a36/    ,36/i_r,36/r_sd,36/(l_364-l_org)/5,36/0
l_365:		vfd a36/    ,36/i_r,36/r_rd,36/(l_365-l_org)/5,36/0
l_366:		vfd a36/    ,36/i_r,36/r_pic,36/(l_366-l_org)/5,36/0
l_367:		vfd a36/    ,36/i_r,36/r_picture,36/(l_367-l_org)/5,36/0
l_368:		vfd a36/    ,36/i_r,36/r_communication,36/(l_368-l_org)/5,36/0
l_369:		vfd a36/    ,36/i_r,36/r_code_set,36/(l_369-l_org)/5,36/0
l_370:		vfd a36/    ,36/i_r,36/r_copy,36/(l_370-l_org)/5,36/0
l_371:		vfd a36/    ,36/i_r,36/r_replacing,36/(l_371-l_org)/5,36/0
l_372:		vfd a36/    ,36/i_r,36/r_high_value,36/(l_372-l_org)/5,36/0
l_373:		vfd a36/    ,36/i_r,36/r_high_values,36/(l_373-l_org)/5,36/0
l_374:		vfd a36/    ,36/i_r,36/r_low_value,36/(l_374-l_org)/5,36/0
l_375:		vfd a36/    ,36/i_r,36/r_low_values,36/(l_375-l_org)/5,36/0
l_376:		vfd a36/    ,36/i_r,36/r_zero,36/(l_376-l_org)/5,36/0
l_377:		vfd a36/    ,36/i_r,36/r_zeros,36/(l_377-l_org)/5,36/0
l_378:		vfd a36/    ,36/i_r,36/r_zeroes,36/(l_378-l_org)/5,36/0
l_379:		vfd a36/    ,36/i_r,36/r_quote,36/(l_379-l_org)/5,36/0
l_380:		vfd a36/    ,36/i_r,36/r_quotes,36/(l_380-l_org)/5,36/0
l_381:		vfd a36/    ,36/i_r,36/r_space,36/(l_381-l_org)/5,36/0
l_382:		vfd a36/    ,36/i_r,36/r_spaces,36/(l_382-l_org)/5,36/0
l_383:		vfd a36/    ,36/i_r,36/r_just,36/(l_383-l_org)/5,36/0
l_384:		vfd a36/    ,36/i_r,36/r_justified,36/(l_384-l_org)/5,36/0
l_385:		vfd a36/    ,36/i_r,36/r_linage,36/(l_385-l_org)/5,36/0
l_386:		vfd a36/    ,36/i_r,36/r_linage_counter,36/(l_386-l_org)/5,36/0
l_387:		vfd a36/    ,36/i_r,36/r_sa,36/(l_387-l_org)/5,36/0
l_388:		vfd a36/    ,36/i_r,36/r_values,36/(l_388-l_org)/5,36/0
l_389:		vfd a36/    ,36/i_r,36/r_blank,36/(l_389-l_org)/5,36/0
l_390:		vfd a36/    ,36/i_r,36/r_sync,36/(l_390-l_org)/5,36/0
l_391:		vfd a36/    ,36/i_r,36/r_synchronized,36/(l_391-l_org)/5,36/0
l_392:		vfd a36/    ,36/i_r,36/r_areas,36/(l_392-l_org)/5,36/0
l_393:		vfd a36/    ,36/i_r,36/r_limit,36/(l_393-l_org)/5,36/0
l_394:		vfd a36/    ,36/i_r,36/r_through,36/(l_394-l_org)/5,36/0
l_395:		vfd a36/    ,36/i_r,36/r_data,36/(l_395-l_org)/5,36/0
l_396:		vfd a36/    ,36/i_r,36/r_division,36/(l_396-l_org)/5,36/0
l_397:		vfd a36/    ,36/i_r,36/r_end,36/(l_397-l_org)/5,36/0
l_398:		vfd a36/    ,36/i_r,36/r_catalog_names,36/(l_398-l_org)/5,36/0
l_399:		vfd a36/    ,36/i_r,36/r_error,36/(l_399-l_org)/5,36/0
l_400:		vfd a36/    ,36/i_r,36/r_message,36/(l_400-l_org)/5,36/0
l_401:		vfd a36/    ,36/i_r,36/r_recording,36/(l_401-l_org)/5,36/0
l_402:		vfd a36/    ,36/i_r,36/r_replace,36/(l_402-l_org)/5,36/0
l_403:		vfd a36/    ,36/i_r,36/r_reports,36/(l_403-l_org)/5,36/0
l_404:		vfd a36/    ,36/i_r,36/r_status,36/(l_404-l_org)/5,36/0
l_405:		vfd a36/    ,36/i_r,36/r_text,36/(l_405-l_org)/5,36/0
l_406:		vfd a36/    ,36/i_r,36/r_pls,36/(l_406-l_org)/5,36/0
l_407:		vfd a36/    ,36/i_r,36/r_sub,36/(l_407-l_org)/5,36/0
l_408:		vfd a36/    ,36/i_r,36/r_tim,36/(l_408-l_org)/5,36/0
l_409:		vfd a36/    ,36/i_r,36/r_div,36/(l_409-l_org)/5,36/0
l_410:		vfd a36/    ,36/i_r,36/r_exp,36/(l_410-l_org)/5,36/0
l_411:		vfd a36/    ,36/i_r,36/r_ls,36/(l_411-l_org)/5,36/0
l_412:		vfd a36/    ,36/i_r,36/r_gt,36/(l_412-l_org)/5,36/0
l_413:		vfd a36/    ,36/i_r,36/r_eq,36/(l_413-l_org)/5,36/0
l_414:		vfd a36/    ,36/i_r,36/r_lt,36/(l_414-l_org)/5,36/0
l_415:		vfd a36/    ,36/i_r,36/r_rt,36/(l_415-l_org)/5,36/0
	equ c_1,1
	equ c_100,100
	equ c_12,12
	equ c_16,16
	equ c_18,18
	equ c_19,19
	equ c_2,2
	equ c_20,20
	equ c_21,21
	equ c_22,22
	equ c_26,26
	equ c_27,27
	equ c_28,28
	equ c_29,29
	equ c_3,3
	equ c_30,30
	equ c_31,31
	equ c_32,32
	equ c_33,33
	equ c_34,34
	equ c_35,35
	equ c_37,37
	equ c_38,38
	equ c_39,39
	equ c_4,4
	equ c_40,40
	equ c_41,41
	equ c_42,42
	equ c_43,43
	equ c_44,44
	equ c_45,45
	equ c_46,46
	equ c_47,47
	equ c_49,49
	equ c_5,5
	equ c_54,54
	equ c_55,55
	equ c_56,56
	equ c_57,57
	equ c_58,58
	equ c_59,59
	equ c_6,6
	equ c_60,60
	equ c_61,61
	equ c_62,62
	equ c_65,65
	equ c_66,66
	equ c_67,67
	equ c_68,68
	equ c_69,69
	equ c_7,7
	equ c_70,70
	equ c_71,71
	equ c_72,72
	equ c_74,74
	equ c_75,75
	equ c_76,76
	equ c_77,77
	equ c_80,80
	equ c_81,81
	equ c_82,82
	equ c_83,83
	equ c_84,84
	equ c_85,85
	equ c_86,86
	equ c_87,87
	equ c_88,88
	equ c_89,89
	equ c_90,90
	equ c_91,91
	equ c_92,92
	equ c_93,93
	equ c_94,94
	equ c_95,95
	equ c_96,96
	equ c_97,97
	equ c_98,98
	equ c_99,99
	equ c_all,50
	equ c_codeset,13
	equ c_dup_type8,53
	equ c_figcon,25
	equ c_int,8
	equ c_labnam,36
	equ c_labval,48
	equ c_lev01,10
	equ c_lev0177,51
	equ c_lev0249,17
	equ c_lev66,15
	equ c_lev66s,63
	equ c_lev77,9
	equ c_lev88,14
	equ c_lev88s,64
	equ c_lrc,52
	equ c_per_ck,73
	equ c_renames,78
	equ c_test_like,79
	equ c_type2,23
	equ c_type3,24
	equ c_type8,11
	equ a_0,1
	equ a_1,2
	equ a_10,54
	equ a_100,187
	equ a_101,188
	equ a_102,189
	equ a_103,190
	equ a_104,191
	equ a_105,192
	equ a_106,193
	equ a_107,194
	equ a_108,195
	equ a_109,196
	equ a_11,55
	equ a_110,197
	equ a_111,198
	equ a_112,199
	equ a_113,0
	equ a_114,201
	equ a_115,202
	equ a_116,203
	equ a_117,204
	equ a_118,205
	equ a_119,206
	equ a_12,7
	equ a_120,207
	equ a_121,208
	equ a_122,209
	equ a_123,210
	equ a_124,211
	equ a_125,212
	equ a_126,213
	equ a_127,214
	equ a_128,215
	equ a_129,216
	equ a_13,56
	equ a_130,217
	equ a_131,218
	equ a_132,219
	equ a_133,220
	equ a_134,221
	equ a_135,222
	equ a_136,15
	equ a_137,223
	equ a_138,224
	equ a_139,225
	equ a_14,8
	equ a_140,226
	equ a_141,227
	equ a_142,228
	equ a_143,229
	equ a_144,230
	equ a_145,231
	equ a_146,232
	equ a_147,233
	equ a_148,234
	equ a_149,235
	equ a_15,57
	equ a_150,236
	equ a_151,237
	equ a_152,238
	equ a_153,239
	equ a_154,240
	equ a_155,241
	equ a_156,242
	equ a_157,243
	equ a_158,244
	equ a_159,245
	equ a_16,58
	equ a_160,246
	equ a_161,247
	equ a_162,248
	equ a_163,249
	equ a_164,250
	equ a_165,251
	equ a_166,252
	equ a_167,100
	equ a_168,18
	equ a_169,19
	equ a_17,9
	equ a_170,20
	equ a_18,10
	equ a_19,59
	equ a_2,3
	equ a_20,11
	equ a_21,12
	equ a_22,13
	equ a_23,14
	equ a_24,60
	equ a_25,61
	equ a_26,62
	equ a_27,63
	equ a_28,64
	equ a_29,65
	equ a_3,99
	equ a_30,66
	equ a_31,67
	equ a_32,68
	equ a_33,69
	equ a_34,70
	equ a_35,71
	equ a_36,72
	equ a_37,73
	equ a_38,74
	equ a_39,75
	equ a_4,4
	equ a_40,76
	equ a_41,77
	equ a_42,78
	equ a_43,79
	equ a_44,80
	equ a_45,81
	equ a_46,82
	equ a_47,83
	equ a_48,84
	equ a_49,85
	equ a_5,50
	equ a_50,86
	equ a_51,87
	equ a_52,88
	equ a_53,89
	equ a_54,90
	equ a_55,91
	equ a_56,92
	equ a_57,93
	equ a_58,94
	equ a_59,95
	equ a_6,51
	equ a_60,96
	equ a_61,97
	equ a_62,98
	equ a_63,150
	equ a_64,151
	equ a_65,152
	equ a_66,153
	equ a_67,154
	equ a_68,155
	equ a_69,156
	equ a_7,52
	equ a_70,157
	equ a_71,158
	equ a_72,159
	equ a_73,160
	equ a_74,161
	equ a_75,162
	equ a_76,163
	equ a_77,5
	equ a_78,253
	equ a_79,166
	equ a_8,6
	equ a_80,167
	equ a_81,168
	equ a_82,16
	equ a_83,17
	equ a_84,21
	equ a_85,0
	equ a_86,173
	equ a_87,174
	equ a_88,175
	equ a_89,0
	equ a_9,53
	equ a_90,177
	equ a_91,178
	equ a_92,0
	equ a_93,0
	equ a_94,181
	equ a_95,182
	equ a_96,183
	equ a_97,0
	equ a_98,0
	equ a_99,186
	equ r_eq,102
	equ r_lt,187
	equ r_rt,188
	equ r_tim,184
	equ r_exp,186
	equ r_pls,182
	equ r_sub,183
	equ r_per,189
	equ r_div,185
	equ r_ls,123
	equ r_gt,113
	equ r_all,73
	equ r_are,118
	equ r_area,202
	equ r_areas,202
	equ r_ascending,78
	equ r_at,79
	equ r_blank,204
	equ r_block,205
	equ r_bottom,236
	equ r_by,82
	equ r_catalog_name,331
	equ r_catalog_names,331
	equ r_cd,206
	equ r_character,83
	equ r_characters,83
	equ r_cobol,191
	equ r_code_set,306
	equ r_communication,207
	equ r_comp,106
	equ r_comp_1,212
	equ r_comp_2,213
	equ r_comp_3,211
	equ r_comp_4,209
	equ r_comp_5,210
	equ r_comp_6,292
	equ r_comp_7,290
	equ r_comp_8,610
	equ r_computational,106
	equ r_computational_1,212
	equ r_computational_2,213
	equ r_computational_3,211
	equ r_computational_4,209
	equ r_computational_5,210
	equ r_computational_6,292
	equ r_computational_7,290
	equ r_computational_8,610
	equ r_constant,214
	equ r_contains,215
	equ r_copy,522
	equ r_count,84
	equ r_data,196
	equ r_date,86
	equ r_depending,92
	equ r_descending,93
	equ r_destination,218
	equ r_display,42
	equ r_division,94
	equ r_end,98
	equ r_error,3
	equ r_fd,219
	equ r_file,108
	equ r_filler,220
	equ r_footing,547
	equ r_for,110
	equ r_high_value,221
	equ r_high_values,221
	equ r_in,101
	equ r_index,222
	equ r_indexed,223
	equ r_initial,114
	equ r_input,115
	equ r_is,118
	equ r_just,224
	equ r_justified,224
	equ r_key,120
	equ r_label,121
	equ r_leading,122
	equ r_left,225
	equ r_length,226
	equ r_limit,561
	equ r_limits,562
	equ r_linage,563
	equ r_linage_counter,564
	equ r_line,124
	equ r_lines,124
	equ r_linkage,228
	equ r_low_value,229
	equ r_low_values,229
	equ r_message,126
	equ r_mode,230
	equ r_occurs,231
	equ r_of,133
	equ r_omitted,203
	equ r_on,134
	equ r_output,137
	equ r_pic,232
	equ r_picture,232
	equ r_procedure,142
	equ r_queue,234
	equ r_quote,235
	equ r_quotes,235
	equ r_rd,584
	equ r_record,148
	equ r_recording,237
	equ r_records,195
	equ r_redefines,238
	equ r_renames,239
	equ r_replace,425
	equ r_replacing,152
	equ r_report,240
	equ r_reports,240
	equ r_right,241
	equ r_sa,242
	equ r_sd,243
	equ r_section,158
	equ r_separate,244
	equ r_sign,245
	equ r_source,246
	equ r_space,192
	equ r_spaces,192
	equ r_standard,162
	equ r_status,247
	equ r_sub_queue_1,248
	equ r_sub_queue_2,249
	equ r_sub_queue_3,250
	equ r_symbolic,251
	equ r_sync,252
	equ r_synchronized,252
	equ r_table,253
	equ r_text,607
	equ r_through,166
	equ r_thru,166
	equ r_time,168
	equ r_times,168
	equ r_to,170
	equ r_top,190
	equ r_trailing,255
	equ r_usage,257
	equ r_value,258
	equ r_values,258
	equ r_when,178
	equ r_with,179
	equ r_working_storage,259
	equ r_zero,180
	equ r_zeroes,180
	equ r_zeros,180
	end
~~~




		    cobol_ddsyntax.pl1              05/24/89  1044.4rew 05/24/89  0832.7      837648



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_ddsyntax.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* Modified on 10/17/83 by FCH, [5.2-2], check for type 10 token, phx16140(BUG562) */
/* Modified on 07/07/83 by FCH, [5.2-1], lev 88 item causes abort if RW used, BUG552(phx15491) */
/* Modified on 10/29/82 by FCH, [5.1-3], diag 3-35 put on prev token, BUG542(phx13372) */
/* Modified on 10/29/82 by FCH, [5.1-2], places_left set for group items, BUG531(phx12991) */
/* Modified on 11/24/81 by FCH, [5.1-1], RECORD CONTAINS clause may not contain ZERO, BUG5.1(phx11821) */
/* Modified on 09/10/81 by FCH, [5.0-1], occ dep item followed by lev 66 item blows compiler, BUG502(phx11383) */
/* Modified on 07/10/81 by FCH, [4.4-3], debug cards not processed unless use for debugging used (phx10378, BUG493) */
/* Modified on 04/13/81 by FCH, [4.4-2], fix bugs in leveling for validation-81, BUG477 */
/* Modified on 12/03/80 by FCH, [4.4-1], report writer added */
/* Modified on 09/03/80 by FCH, [4.3-2], single digit level numbers detected */
/* Modified on 04/15/80 by FCH, [4.2-5], emit diag cursor on proper line */
/* Modified on 03/05/80 by FCH, [4.2-4], Fix BUG426 (TR3226) pic bbx(nn) failed when nn >= 31 */
/* Modified on 01/03/80 by MHD, [4.2-3], issue leveling diag when filler defines condition name */
/* Modified on 12/28/79 by MHD, [4.2-2], don't diag debug tokens (column=9999) when checking margin A */
/* Modified on 11/20/79 by MHD, [4.2-1], check(74): also check for end of file for minpral */
/* Modified on 10/08/79 by MHD, [4.0-5], check(74): check for COLUMN = 9999 (eat all DEBUG inserted statements) */
/* Modified on 08/28/79 by FCH, [4.0-4], LEV_DIAG defined */
/* Modified on 08/11/79 by FCH, [4.0-3], debug statement added */
/* Modified on 03/27/79 by FCH, [4.0-2], leveling diags on fd clause */
/* Modified on 03/22/79 by FCH, [4.0-1], check for duplicate data names */
/* Modified since version 4.0 */






/* format: style3 */
cobol_ddsyntax:
     proc;

	call cobol_initstatic;			/*sets sv_ptr*/
	sv_ptr_auto = cobol_sv_ptr;			/*optimization of hpl code*/
	stack_index = 0;

	file_ptr = addr (file_key_area (1));

/*[4.4-1]*/
	first_rec = "1"b;				/*[4.4-1]*/
	first_key, like_key = "00000";


	qual_ptr = file_ptr;
	qual_rec.size = 0;
	key_qual_size = size (qual_rec) * 4;

	fkey_ptr = file_ptr;
	file_key.name_size = 0;
	file_key_size = size (file_key) * 4;


	prev_qual_key = "00000";

/*[4.0-3]*/
	FILE_REC_TAB.file_ind = "1"b;
	FILE_REC_TAB.file_count = 0;

/*[4.0-2]*/
	lev_message_ptr = addr (lev_message);

/*[4.0-2]*/
	lev_message.size = 28;			/*[4.0-2]*/
	lev_message.type = 5;			/*[4.0-2]*/
	lev_message.run = 9;

	mod_num = 0;

	tf = 0;
	all_ind = 0;

	se = 0;
	cslno = 0;
	pre_end_sw = "0"b;
	comp_end_sw = "0"b;

	alf_key_ptr = addr (alf_key);

	filstring_init = "ffffffffffffffffffffffffffffff";

	character_tbl (1) = "0";
	character_tbl (2) = " ";
	unspec (character_tbl (3)) = "000000000"b;
	unspec (character_tbl (4)) = "111111111"b;
	unspec (character_tbl (5)) = "000000000"b;
	unspec (character_tbl (6)) = "111111111"b;
	character_tbl (7) = """";

	ptr_to_char_tbl = addr (character_tbl);
	call cobol_ddst (syntab_ptr);			/*don't care about second argument to cobol_ddst*/
prelude:
	dn_ptr = addr (cobol_wkbuf1_tbl.wkbuf1);
	w2_ptr = addr (cobol_wkbuf2_tbl.wkbuf2);
	cdtoken_ptr = w2_ptr;

	begin;
dcl	(comma, period, dollar, store)
			char (1);			/* picproc insert */
	     if fixed_common.dec_comma
	     then do;
		     comma = ",";
		     period = ".";
		     bit9 = unspec (comma);
		     i = fixed (bit9, 35);
		     bit9 = unspec (period);
		     j = fixed (bit9, 35);
		     store = transltble (i);
		     transltble (i) = transltble (j);
		     transltble (j) = store;
		end;
	end;

	fixed_common.phase_name = "ddsynt";

start:
	current_line = 1;
	trace_ptr = addr (interp);

	tbit = fixed_common.syntax_trace;

	if tbit
	then call cobol_syntax_trace_$initialize_phase (trace_ptr, 2);



	call scan;

	go to loop;

fail:
	if tbit
	then do;
		interp.rec_ptr = min_ptr;
		call cobol_syntax_trace_$trace (trace_ptr, tm2);
	     end;

	current_line = current_line + 1;

loop:
	interp.rec_ptr = min_ptr;
new_inst:
	syntax_line_ptr = addr (syntax_table (current_line));
	TF = 0;

	go to test (syntax_line.t_type);

test (0):
	if record.type ^= 1
	then go to fail;
	if rw.key ^= syntax_line.t_field
	then go to fail;

success:
	if tbit
	then call cobol_syntax_trace_$trace (trace_ptr, tm1);

ucon:
	if syntax_line.o_bit ^= " "
	then do;
		if syntax_line.o_bit > fixed_common.comp_level
		then call lev_diag (syntax_line.a_num);
		go to actretrn;
	     end;

	act_num = syntax_line.a_num;

success_1:
	if act_num < 50
	then go to actlbl (act_num);

	if act_num < 150
	then call cobol_ddact1 (act_num);
	else call cobol_ddact2 (act_num);

actretrn:
actlbl (0):
actlbl (1):
	current_line = syntax_line.s_exit;

action_0:						/* action(0): */
						/*[4.2-5]*/
	if TF ^= 0
	then call diag (TF, record.line, record.column);
	if pre_end_sw
	then go to pre_end;

	if comp_end_sw
	then go to comp_end;

	if syntax_line.s_bit = "s"
	then call scan;

	go to loop;

test (1):
	go to check (syntax_line.t_field);

test (2):						/* unconditional branch */
	TF = syntax_line.t_field;
	act_num = syntax_line.a_num;

	if syntax_line.o_bit ^= " "
	then do;
		if syntax_line.o_bit > fixed_common.comp_level
		then do;
			mod_num = syntax_line.a_num;
			call lev_diag (TF);
		     end;

		TF = 0;
		act_num = 0;
	     end;

	if tbit
	then call cobol_syntax_trace_$trace (trace_ptr, tm1);

	go to success_1;

test (3):						/* syntax routine test */
	stack_index = stack_index + 1;

	if stack_index > 30
	then go to comp_end;

	if tbit
	then do;
		interp.rec_ptr = min_ptr;
		call cobol_syntax_trace_$trace (trace_ptr, tm3);
	     end;

	stack (stack_index) = current_line;
	current_line = syntax_line.t_field;

	go to loop;

actlbl (2):					/* exit true */
						/* action(1): */
	current_line = stack (stack_index);

	if tbit
	then do;
		interp.rec_ptr = min_ptr;
		call cobol_syntax_trace_$trace (trace_ptr, tm4);
	     end;

	if syntax_line.s_bit = "s"
	then call scan;

	syntax_line_ptr = addr (syntax_table (current_line));
	stack_index = stack_index - 1;

	go to ucon;

actlbl (3):					/* exit false */
						/* action(2); */
	current_line = stack (stack_index);

	if tbit
	then do;
		interp.rec_ptr = min_ptr;
		call cobol_syntax_trace_$trace (trace_ptr, tm5);
	     end;

	stack_index = stack_index - 1;
	go to fail;

actlbl (4):					/* jump index */
						/* action(4): */
	if min_eof
	then go to pre_end;

	current_line = rw.jump_index + syntax_line.s_exit;

	go to action_0;


declare	cobol_syntax_trace_$trace
			entry (ptr, fixed bin);
declare	cobol_syntax_trace_$initialize_phase
			entry (ptr, fixed bin);

declare	(syntax_line_ptr, trace_ptr)
			ptr;
declare	tbit		bit (1);
declare	act		fixed bin;

declare	tm1		fixed bin init (1),
	tm2		fixed bin init (2),
	tm3		fixed bin init (3),
	tm4		fixed bin init (4),
	tm5		fixed bin init (5);

declare	1 interp,
	  2 current_line	fixed bin,
	  2 phase		fixed bin,
	  2 rec_ptr	ptr,
	  2 syntab_ptr	ptr,
	  2 directory_ptr	ptr,
	  2 source_ptr	ptr;

declare	1 syntax_line	based (syntax_line_ptr),
	  2 s_bit		char (1),
	  2 o_bit		char (1),
	  2 t_type	fixed bin,
	  2 t_field	fixed bin,
	  2 s_exit	fixed bin,
	  2 a_num		fixed bin;

declare	1 syntax_table	(0:10000) based (syntab_ptr),
	  2 b1		fixed bin,
	  2 b2		fixed bin,
	  2 b3		fixed bin,
	  2 b4		fixed bin,
	  2 b5		fixed bin;


actlbl (5):					/*action(77)*/
						/* first entry in ref table */
						/*[4.4-1]*/
	ref_table_size = 1;

/*[4.4-1]*/
	ref.length (1) = user_word.word_size;		/*[4.4-1]*/
	ref.name (1) = substr (user_word.word, 1, user_word.word_size);
						/*[4.4-1]*/
	ref.size (1) = user_word.word_size;

	go to actretrn;

/*level number*/
actlbl (6):					/*action(8):*/
						/*[5.1-1]*/
	if record.type = 2
	then save_level = fixed (numeric_lit.literal);
	else save_level = 1;
	substr (vector_part, 7) = "0"b;

	goto actretrn;

/* store_data_name */
actlbl (7):					/*action(12):*/
	dnl = ul;
	save_dname = "                              ";
	substr (save_dname, 1, dnl) = substr (user_word.word, 1, dnl);
lbl12:
	save_line = record.line;
	save_column = record.column;
	goto actretrn;

/*filler*/
actlbl (8):					/*action(14):*/
						/*[4.2-3]*/
	saved_line = record.line;			/*[4.2-3]*/
	saved_column = record.column;			/*[4.2-3]*/
	filler_flag = "1"b;

	dnl = 6;
	save_dname = "FILLER                        ";
	vector_map.filler_item = "1"b;
	goto lbl12;


/* semantic_consistency_analysis */

actlbl (9):					/*action(17):*/
	if vector_map.elementary
	then do;
		if (substr (vector_part, 9, 32) & non_display_bits_mask) = "0"b
		then vector_map.display = "1"b;
		else if (substr (vector_part, 9, 32) & numeric_usage_bits_mask) ^= "0"b
		then vector_map.numeric = "1"b;
	     end;

/*test for unsigned packed decimal on Level 64*/

	if vector_map.bwz = "1"b & vector_map.numeric = "1"b
	then do;

		vector_map.numeric_edited = "1"b;
		vector_map.numeric = "0"b;

	     end;

	if vector_map.pic_has_s & vector_map.numeric & vector_map.display & vector_map.sign_type = "000"b
	then do;
		vector_map.sign_type = fixed_common.default_sign_type;

		if vector_map.sign_type = "100"b | vector_map.sign_type = "011"b
		then vector_map.sign_separate = "1"b;
	     end;

	if vector_map.fig_zero = "1"b
	then if vector_map.numeric = "1"b
	     then vector_map.value_numeric = "1"b;
	     else vector_map.value_non_numeric = "1"b;

	if vector_map.code_set
	then do;

		if ^vector_map.display & vector_map.elementary
		then do;
			if vector_map.code_set_class1
			then tf = 199;		/*fatal*/
			else tf = 200;		/*nonfatal*/

			call diag (tf, record.line, record.column);
			goto l17;
		     end;

		if vector_map.numeric
		then do;

			if vector_map.pic_has_s & ^vector_map.sign_separate
						/* implies not display */
			then do;
				if vector_map.code_set_class1
				then tf = 188;	/*fatal*/
				else tf = 198;	/*nonfatal*/
						/*[4.2-5]*/
				call diag (tf, record.line, record.column);
			     end;
		     end;

	     end;
l17:
	if vector_map.inherit_value | vector_map.non_elementary
	then vector_map.elem_no_value = "0"b;
	else vector_map.elem_no_value = "1"b;

/* Move Vector_map bits into data_name.description bits. */

	addr (data_name.file_section) -> bit72 = vectord.descr;

	if data_name.non_elementary
	then do;
		cobol_htbl.minivector (h) = vectord.minivector;
	     end;

	do i = 1 to 83;

	     if vectora (i)
	     then do;

		     vectemp = vector_part & (m1 (i) || m2 (i));

		     if vectemp
		     then do;

/* store diag info for cobol_c_list */

			     message_ptr = addr (message_area);
			     message.length = 16;
			     message.size = msg_constant + 16;

			     message.line = s_lin;
			     message.column = s_col;

			     message.type = 5;
			     message.run3 = 3;
			     message.info.para = "1"b;
			     message.info.rep = "0"b;
			     message.info.fillerx = "000000"b;
			     message.number = 9;
			     ptr4 = addr (message.image);

			     mi_overlay_bit9 = substr (unspec (i), 28, 9);

			     mi_overlay_part = vectemp;

			     call cobol_c_list (message_ptr);

			end;
		end;
	end;

/* This bit may not be set until after the contradiction analysis has been completed, to avoid spurious diags: */

	if data_name.non_elementary
	then data_name.alphanum = "1"b;

	if vector_map.elementary
	then if data_name.initial_ptr ^= 0
	     then do;
		     ptr1 = addr (dn_ptr -> any_item (data_name.initial_ptr));
		     tf = cobol_pic_val_comp (dn_ptr, ptr1);

/*[4.2-5]*/
		     if tf > 0
		     then call diag (tf, dn_ptr -> record.line, dn_ptr -> record.column);

		     tf = 0;			/**in case set to -1 by cobol_pic_val_comp*/

		end;

	if save_switch_88
	then do;

		save_switch_88 = "0"b;

		if no_of_88s = 0
		then goto l17aaa;

/* If data_name is non-elementary we still want to update description bits in
		   the type 9 token. Consistency checking of condition-name values will be
		   performed in action(21), hierarchy analysis, after this non-elementary
		   item has been completed. */

		if data_name.non_elementary
		then go to l17aaa;

		rnt_key = save_wkey;		/* set in action 70 */

		if save_wkey = null_key
		then go to l17aaa;

		call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);
l17a:
		if no_of_88s = 0
		then goto l17aaa;

		no_of_88s = no_of_88s - 1;

		call cobol_vdwf_sget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

		if substr (fstatus, 17, 16) ^= "0000000000000000"b
		then go to l17aaa;

		temp_bin1 = cn_constant + rnt_ptr -> conditioname.name_size;

		temp_bin1 = temp_bin1 + mod (-temp_bin1, 4);

		temp_bin2 = rnt_ptr -> conditioname.numlits;

		if temp_bin2 < 1
		then goto l17a;

/*will be 0 if value was not syntactically valid*/
l17aa:
		ptr1 = addr (rnt_ptr -> any_item (temp_bin1 + 1));
		tf = cobol_pic_val_comp (dn_ptr, ptr1);

/*[4.2-5]*/
		if tf > 0
		then call diag (tf, dn_ptr -> record.line, dn_ptr -> record.column);

		if tf < 0
		then do;
			call cobol_vdwf_dput (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);
			tf = 0;
		     end;

		if ptr1 -> numinit.initype.numeric
		then temp_bin1 = temp_bin1 + niv_constant + ptr1 -> numinit.length;

		else do;
			if ptr1 -> alphainit.initype.fig_con
			then do;
				if ptr1 -> alphainit.info.fig_con_index = "0000001"b
				then temp_bin1 = temp_bin1 + niv_constant + 1;
				else temp_bin1 = temp_bin1 + aiv_constant;
			     end;
			else temp_bin1 = temp_bin1 + aiv_constant + ptr1 -> alphainit.length;
		     end;

		temp_bin1 = temp_bin1 + mod (-temp_bin1, 4);

		if temp_bin2 = 1
		then goto l17a;

		temp_bin2 = temp_bin2 - 1;
		goto l17aa;

l17aaa:
		call cobol_vdwf_dput (cobol_ntfp, fstatus, dn_ptr, data_name.size, save_wkey);

/*update description bits in type9 token*/
		no_of_88s = 0;
		save_wkey = null_key;

	     end;

/*[4.4-1]*/
	s_lin = record.line;
	s_col = record.column;
	goto actretrn;


/*write item not followed by subject of redefines*/
actlbl (10):					/*action(18):*/
						/*write completed(previous)dataname token*/
	if bnw ^= 0
	then do;
		rnt_ptr = dn_ptr;
		nt_size = data_name.size;

		call cobol_vdwf_sput (cobol_ntfp, fstatus, rnt_ptr, nt_size, w_key);

/*[4.0-3]*/
		if FILE_REC_TAB.file_ind		/*[4.0-3]*/
		then do;
			FILE_REC_TAB.file_key (FILE_REC_TAB.file_count) = w_key;
						/*[4.0-3]*/
			FILE_REC_TAB.file_ind = "0"b; /*[4.0-3]*/
		     end;

		if data_name.level = 1
		then do;


			if data_name.exp_redefining
			then rdf_01_sav = w_key;

			else do;
				save_01 = w_key;
				rdf_01_sav = null_key;
			     end;

		     end;

		if data_name.non_elementary
		then cobol_htbl.nt_rec (h) = w_key;

/*[4.4-1]*/
		if first_rec			/*[4.4-1]*/
		then do;
			first_rec = "0"b;		/*[4.4-1]*/
			first_key = w_key;		/*[4.4-1]*/
		     end;

	     end;

	ptr4 = addr (cobol_wkbuf1_tbl);

	ptr4 -> cntbuf = 0;


	data_name.type = 9;
	data_name.line = save_line;
	data_name.def_line = save_line;
	data_name.column = save_column;
	data_name.level = save_level;
	data_name.do_rec = null_key;

	if file_number ^= 0
	then data_name.file_num = file_number;
	else data_name.file_num = cdno;

	data_name.name_size = dnl;
	substr (data_name.name, 1, dnl) = substr (save_dname, 1, dnl);
	data_name.size = dn_constant + dnl;



/*[4.0-3]*/
	if fixed_common.debug			/*[4.0-3]*/
	then data_name.size = data_name.size + 32 - data_name.name_size;

	data_name.size = data_name.size + mod (-data_name.size, 4);

	ptr1 = addr (dn_ptr -> any_item (data_name.size + 1));

	if data_name.level = 1
	then do;

		ptr4 = addr (cobol_htbl);

		ptr4 -> chtbl = 0;

	     end;



	bnw = 1;					/*buf needs write*/

	goto actretrn;


/*level 01*/
actlbl (11):					/*action(20):*/
	vector_map.level_01 = "1"b;

/*[4.4-1]*/
	like_clause = "0"b;

	ixix = 0;
	ll01 = "1"b;

	if vector_map.file_section
	then if file_number ^= 0
	     then do;
		     cm_key = fixed_common.filedescr_offsets (file_number);

		     call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

		     ft_ptr = cm_ptr;
		     vector_map.code_set = file_table.code_set_clause;

		     if file_table.code_set = 3	/*jis*/
		     then vector_map.code_set_class1 = "1"b;
		end;

	offset_ct = 0;
	h = 0;
	odim = 0;
	save_line_for66 = 0;

	goto actretrn;


/* hierarchy analysis */
actlbl (12):					/*action(21):*/
	data_name.offset = offset_ct;

	if ^vector_map.exp_redefining
	then save_offsets (data_name.level) = offset_ct;

	if data_name.occurs_ptr ^= 0
	then if ^data_name.key_a & ^data_name.key_d
	     then occurs.keyed = 0;

	if data_name.level < next_level
	then goto groupa21;

/*current item elementary,some undetermined number of group items may be finished*/

	vector_map.elementary = "1"b;

	if vector_map.occurs_do & next_level ^= 1
	then call DIAG (31);

	if h ^= 0 & ^vector_map.assoc_with_signed_num_display
	then do;
		vector_map.sign_type = "0"b;
		vector_map.sign_separate = "0"b;
	     end;

	if ^vector_map.picture_clause & (substr (vector_part, 9, 32) & pic_suff_bits_mask) = "0"b
	then vector_map.no_picture = "1"b;

	call data_length;

	if ^vector_map.occurs_clause
	then temp_bin1 = data_name.item_length;
	else temp_bin1 = data_name.item_length * save_occno;

	offset_ct = offset_ct + temp_bin1;		/*add current item length to ancestors in cobol_htbl*/

	if vector_map.exp_redefining | h = 0
	then goto no_add;

	fh = h;
elem1:
	cobol_htbl.item_length (fh) = cobol_htbl.item_length (fh) + temp_bin1;

	if cobol_htbl.occurs_clause (fh)
	then temp_bin1 = temp_bin1 * cobol_htbl.occno (fh);

	if cobol_htbl.exp_redefining (fh) | fh = 1
	then goto no_add;

	fh = fh - 1;
	goto elem1;

no_add:
	if data_name.occurs_ptr ^= 0 & vector_map.occurs_clause
	then do;

		ptr1 = addr (dn_ptr -> any_item (data_name.occurs_ptr));
		odim = occurs.dimensions;
		occurs.level.struclength (odim) = data_name.item_length;

		if ^vector_map.key_a & ^vector_map.key_d
		then occurs.keyed = 0;

		if vector_map.indexed_by
		then do;

			if ixix ^= 0
			then do;

				j = occurs.level.indexedno (odim);
				k = data_name.offset;

				if ix_ino (ixix) = j
				then do;
elema21ix2:
					rnt_key = ix_key (ixix);
					save_w2 = w2_ptr;

					call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

					w2_ptr = rnt_ptr;
					indexname.struc_length = data_name.item_length;
					indexname.offset = data_name.offset;

					call cobol_vdwf_dput (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

					w2_ptr = save_w2;
					ixix = ixix - 1;

					if ixix = 0
					then goto elema21end;

					if ix_ino (ixix) = j
					then goto elema21ix2;
					else go to elema21end;

				     end;
			     end;

		     end;


	     end;

elema21end:
	if data_name.level = next_level
	then goto actretrn;

lbl21a:
	if cobol_htbl.level (h) < next_level
	then goto actretrn;

	save_ptr = dn_ptr;
	rnt_key = cobol_htbl.nt_rec (h);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	dn_ptr = rnt_ptr;				/*[5.1-2]*/
	data_name.item_length, data_name.places_left = cobol_htbl.item_length (h);

	if cobol_htbl.do_rec_valid (h) & ^data_name.occurs_do
	then do;

		data_name.variable_length = "1"b;
		data_name.do_rec = cobol_htbl.do_rec (h);

	     end;

	if data_name.occurs_do
	then if next_level ^= 1
	     then call DIAG (31);

	if data_name.initial_ptr ^= 0
	then do;

		ptr1 = addr (dn_ptr -> any_item (data_name.initial_ptr));
		tf = cobol_pic_val_comp (dn_ptr, ptr1);

/*[4.2-5]*/
		if tf > 0
		then call diag (tf, dn_ptr -> record.line, dn_ptr -> record.column);

		tf = 0;				/*in case set to -1*/

	     end;

	if data_name.sign_clause_occurred & ^substr (cobol_htbl.minivector (h), 12, 1)
	then call DIAG (190);

	if ^data_name.exp_occurs | data_name.occurs_ptr = 0
	then do;
		call cobol_vdwf_dput (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);
		goto end21;

	     end;

	ptr1 = addr (dn_ptr -> any_item (data_name.occurs_ptr));
	odim = occurs.dimensions;
	occurs.level.struclength (odim) = cobol_htbl.item_length (h);
	offset_ct = save_offsets (data_name.level) + data_name.item_length * cobol_htbl.occno (h);

	if ^data_name.key_a & ^data_name.key_d
	then occurs.keyed = 0;

	call cobol_vdwf_dput (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	if ^data_name.indexed_by | ixix = 0
	then go to end21;

/*pop indexname stack*/

	j = occurs.level.indexedno (odim);
	k = data_name.offset;			/*will otherwise be lost when io operation done*/

	if ix_ino (ixix) = j
	then do;
ix2:
		rnt_key = ix_key (ixix);
		save_w2 = w2_ptr;

		call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

		w2_ptr = rnt_ptr;
		indexname.struc_length = cobol_htbl.item_length (h);
		indexname.offset = k;

		call cobol_vdwf_dput (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

		w2_ptr = save_w2;
		ixix = ixix - 1;

		if ixix = 0
		then goto end21;

		if ix_ino (ixix) = j
		then goto ix2;
		else go to end21;
	     end;

end21:
	if cobol_htbl.switch_88 (h)
	then do;

		rnt_key = cobol_htbl.nt_rec (h);

		if rnt_key = null_key
		then goto l21aaa;

		call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);
l21a:
		call cobol_vdwf_sget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

		if substr (fstatus, 17, 16) ^= "0"b | rnt_ptr -> record.type ^= 11
		then go to l21aaa;

		temp_bin1 = cn_constant + rnt_ptr -> conditioname.name_size;

		temp_bin1 = temp_bin1 + mod (-temp_bin1, 4);

		temp_bin2 = rnt_ptr -> conditioname.numlits;

		if temp_bin2 < 1
		then goto l21a;
l21aa:
		ptr1 = addr (rnt_ptr -> any_item (temp_bin1 + 1));
		tf = cobol_pic_val_comp (dn_ptr, ptr1);

/*[4.2-5]*/
		if tf > 0
		then call diag (tf, dn_ptr -> record.line, dn_ptr -> record.column);

		if tf < 0
		then do;
			tf = 0;
			call cobol_vdwf_dput (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);
		     end;

		if ptr1 -> numinit.initype.numeric
		then temp_bin1 = temp_bin1 + niv_constant + ptr1 -> numinit.length;

		else do;
			if ptr1 -> alphainit.initype.fig_con
			then do;
				if ptr1 -> alphainit.info.fig_con_index = "0000001"b
				then temp_bin1 = temp_bin1 + niv_constant + 1;
				else temp_bin1 = temp_bin1 + aiv_constant;
			     end;
			else temp_bin1 = temp_bin1 + aiv_constant + ptr1 -> alphainit.length;
		     end;

		temp_bin1 = temp_bin1 + mod (-temp_bin1, 4);

		if temp_bin2 = 1
		then goto l21a;

		temp_bin2 = temp_bin2 - 1;
		goto l21aa;

	     end;

l21aaa:
	dn_ptr = save_ptr;				/*pop hierarchy stack*/
	h = h - 1;

	if h = 0
	then goto actretrn;

	goto lbl21a;

groupa21:						/*level number of finished item less than new level number*/
	vector_map.non_elementary = "1"b;

/*push hierarchy stack*/
	h = h + 1;
	ptr4 = addr (cobol_htbl (h));

	ptr4 -> chtbl_item = 0;

	cobol_htbl.level (h) = data_name.level;		/*	cobol_htbl.offset(h)=data_name.offset;*/
	cobol_htbl.occno (h) = save_occno;
	cobol_htbl.do_rec (h) = data_name.do_rec;

	if bnw ^= 0
	then cobol_htbl.nt_rec (h) = null_key;
	else cobol_htbl.nt_rec (h) = save_wkey;

	cobol_htbl.occurs_clause (h) = vector_map.occurs_clause;
	cobol_htbl.odo_switch (h) = vector_map.occurs_do;

	if data_name.occurs_ptr ^= 0
	then cobol_htbl.occurs_ext (h) = "1"b;

	cobol_htbl.switch_88 (h) = save_switch_88;	/* save_switch_88 will be reset in action 17 */
	cobol_htbl.exp_redefining (h) = vector_map.exp_redefining;
	cobol_htbl.minivector (h) = vectord.minivector;
	goto actretrn;



data_length:
     proc;

	bit32_1 = substr (vector_part, 9, 32) & non_display_bits_mask;

	if vector_map.item_signed & vector_map.numeric
	then do;

		if vector_map.sign_separate
		     | ((vector_map.ascii_packed_dec_b | vector_map.ascii_packed_dec_h) & vector_map.pic_has_s)
		then goto incr_lnth;
		else if bit32_1 = "0"b		/* display data */
		then if vector_map.sign_type = "000"b
		     then if fixed_common.default_sign_type = "011"b | fixed_common.default_sign_type = "100"b
			then go to incr_lnth;

		goto no_incr;

incr_lnth:
		data_name.item_length = data_name.item_length + 1;

	     end;
no_incr:
	if bit32_1 = thirty_two_zeros
	then return;				/* display data */

	if vector_map.bin_16
	then do;
		data_name.item_length = 2;
		data_name.places_right = 0;
		data_name.places_left = 5;
		goto dl_end;
	     end;

	if vector_map.bin_18
	then do;
		data_name.item_length = 2;
		data_name.places_right = 0;
		data_name.places_left = 6;
		go to dl_end;
	     end;

	if vector_map.bin_32
	then do;
		data_name.item_length = 4;
		data_name.places_right = 0;
		data_name.places_left = 10;
		go to dl_end;
	     end;

	if vector_map.bin_36
	then do;
		data_name.item_length = 4;
		data_name.places_right = 0;
		data_name.places_left = 11;
		go to dl_end;
	     end;

/*test packed decimal*/

	if vector_map.ebcdic_packed_dec | vector_map.ascii_packed_dec_h | vector_map.ascii_packed_dec_b
	then do;
		data_name.item_length = divide (data_name.item_length + 1, 2, 15, 0);
		goto dl_end;
	     end;

	if vector_map.usage_index = "1"b
	then data_name.item_length = 6;
dl_end:
	vector_map.pic_integer = "1"b;

     end;



actlbl (13):					/*action(22):*/
	vector_map.picture_clause = "1"b;
	goto actretrn;


/* picture_analysis */

actlbl (14):					/*action(23):*/
						/* The following variables may be as well declared within the host procedure */
dcl	pic_image		char (128),		/*translated picture string*/
	spec_char		char (1),
	t		fixed bin,		/*indexes current PICTURE character in image string*/
						/* i indexes last character picked up in image,
					may be PICTURE character or right parenthesis
					of repetition factor*/
	p		fixed bin,		/*work*/
	r		fixed bin,
	n		fixed bin,		/*work*/
	m		fixed bin,		/*work*/
	arrpntr		fixed bin,		/*binary value from character position in image--
				used as index into tables and label array piclabel*/
	piccounter1	fixed bin,		/*number of consecutive identical characters, including those
				indicated by a parenthesized integer*/
	piccounter2	fixed bin,		/*number of consecutive receiving characters between two fixed insertions*/
	inscnter		fixed bin,		/*number of fixed inserts in entire picture string*/
	fltswitch1	bit (1),			/*set when pic contains floating insert(s)*/
	fltswitch2	bit (1),			/*set when t indexes to the left of the right boundary of the
				string to be suppressed for floating insertion and for
				zero suppression*/
	fltswitch3	bit (1),
	auxvector1	bit (32),			/*work*/
	auxvector2	bit (32),			/*constant zeroes*/
	propvector	bit (32),			/*properties of current item according to picture string*/
	fltchar		char (1),			/*current floating insertion character*/
	editlim		fixed bin,		/*maximum edit string size*/
	auxbit		bit (1),
	mask4x		bit (32),
	picptr		pointer,			/*addresses edit extension*/
	filstring		char (30);		/*contains receiving characters for moving into edit string*/

declare	pic_ch		char (1),
	nsi		bit (1);
declare	ch		char (1),
	pic_string_ptr	ptr;

declare	pic_array		(128) char (1) based (pic_string_ptr);

/* inftble is property matrix */
/* prectble is precedence array */

	filstring = filstring_init;
	editlim = 256;
	propvector = thirty_two_zeros;
	auxvector2 = thirty_two_zeros;
	piccounter2 = 0;
	inscnter = 0;
	fltswitch1 = "0"b;
	fltswitch2 = "0"b;
	fltswitch3 = "0"b;
	pic_string_ptr = addr (picture.string);
	picptr = ptr1;
	j = 1;

	if picture.length > 30
	then go to aerr;

	pic_image = picture.string;

/* after the length was checked the picture string is translated below */

	i = 0;
	nsi = "0"b;


	do while (i < picture.length);

	     i = i + 1;
	     pic_ch = substr (pic_image, i, 1);

	     if pic_ch ^= fixed_common.currency & index (ch_str, pic_ch) ^= 0
	     then nsi = "1"b;

	     bit9 = unspec (substr (pic_image, i, 1));
	     m = fixed (bit9, 35);
	     substr (pic_image, i, 1) = transltble (m);

	end;

	if nsi
	then do;
		call DIAG (215);

/*[4.0-4]*/
		if fixed_common.comp_level < "5"
		then call LEV_DIAG (28);

	     end;

	substr (pic_image, i + 1, 1) = stopper;

	i = 0;

mainloop:
	i = i + 1;

	bit9 = unspec (substr (pic_image, i, 1));
	arrpntr = fixed (bit9, 15);

	if arrpntr > 32
	then go to err2;

	piccounter1 = 1;
	t = i;

/*check property matrix for repeatable character*/
	if substr (inftble (arrpntr), 1, 1) ^= "1"b
	then go to pic4;
pic1:
	i = i + 1;

	if substr (pic_image, i, 1) = "("
	then go to anext;

	if i <= picture.length
	then do;
		if substr (picture.string, i, 1) = substr (picture.string, i - 1, 1)
		then do;
			piccounter1 = piccounter1 + 1;
			go to pic1;
		     end;
	     end;

	i = i - 1;
	go to pic3;

anext:						/*pick up repetition factor*/
	i = i + 1;

	if substr (unspec (substr (pic_image, i, 1)), 6, 4) ^= "1111"b
	then go to err3;

	k = i;
next1:
	i = i + 1;

	if substr (unspec (substr (pic_image, i, 1)), 6, 4) = "1111"b
	then go to next1;

	if substr (pic_image, i, 1) ^= ")"
	then go to err3;

	piccounter1 = piccounter1 - 1 + fixed (substr (picture.string, k, i - k));

pic3:						/*set for +,-,$,*.P,Z */
	if substr (inftble (arrpntr), 2, 1) ^= "1"b
	then go to pic4;

/*analysis for legal insertion and to determine whether fixed or floating*/

	if substr (inftble (arrpntr), 3, 1) = "1"b
	then go to pic3a;

	if arrpntr ^= 12
	then do;
		if fltswitch3 = "0"b
		then do;
			fltswitch3 = "1"b;
			fltswitch2 = "1"b;
			editor.start_supress = data_name.item_length + 1;
		     end;
		go to pic6;
	     end;

	vector_map.pic_has_p = "1"b;

	if data_name.item_length ^= inscnter
	then do;
		data_name.places_left = data_name.places_left + piccounter1;
		data_name.places_right = data_name.places_right - piccounter1;
		go to pic4;
	     end;

	data_name.places_right = data_name.places_right + piccounter1;
	data_name.places_left = data_name.places_left - piccounter1;
	substr (propvector, 2, 1) = "1"b;
pic5:
	arrpntr = arrpntr + 1;
	go to pic4;

pic3a:
	if fltswitch1
	then if substr (picture.string, t, 1) = fltchar
	     then go to pic8;
	     else go to pic5;

	if piccounter1 > 1
	then go to pic7;

	if data_name.item_length ^= inscnter
	then go to pic5;

	k = i;
pic3b:
	k = k + 1;

	if k > picture.length
	then go to pic6;

	bit9 = unspec (substr (pic_image, k, 1));
	n = fixed (bit9, 15);

	if arrpntr = n
	then go to pic7;

	if n > 31
	then do;
pic3b1:
		k = k + 1;
		if k > picture.length
		then go to pic6;
		if substr (picture.string, k, 1) = ")"
		then go to pic3b;
		else go to pic3b1;
	     end;

	if substr (inftble (n), 4, 1)
	then go to pic3b;
pic6:
	if substr (propvector, 4, 1) | substr (propvector, 2, 1)
	then go to pic5;
	go to pic4;

pic7:
	fltswitch1 = "1"b;
	fltswitch2 = "1"b;
	fltchar = substr (picture.string, t, 1);
	editor.start_supress = data_name.item_length + 1;
pic8:
	arrpntr = arrpntr + 2;
	go to pic6;

pic4:						/* test precedence */
	auxvector1 = propvector & prectble (arrpntr);

/* if auxvector is zeroes, string is valid so far */
	if auxvector1 ^= auxvector2
	then go to err1;

/* set property vector bit for current PICTURE character */
	substr (propvector, arrpntr, 1) = "1"b;

/* test for PICTURE character contributing to total length of data item */
	if substr (inftble (arrpntr), 5, 1) = "0"b
	then go to pic9;

	data_name.item_length = data_name.item_length + piccounter1;

/* test for PICTURE character contributing to receiving field size in item */
	if substr (inftble (arrpntr), 6, 1) = "0"b
	then go to pic4a;

/* increment consecutive receiving characters field size counter */

	piccounter2 = piccounter2 + piccounter1;

/* test for V or . has already occurred in string */

	if substr (propvector, 4, 1) | substr (propvector, 2, 1)
	then do;
		data_name.places_right = data_name.places_right + piccounter1;
		go to pic9;
	     end;

	data_name.places_left = data_name.places_left + piccounter1;
	go to pic9;

pic4a:						/* characters not contributing to receiving field size but contributing to total item length */
	inscnter = inscnter + piccounter1;

	if data_name.item_length > editlim
	then go to err4;

/* test the number of receiving characters accumulated since last insertion and plop into ecm */

	if piccounter2 = 0
	then go to pic4b;

/*[4.2-4]*/
	call fill_edit;

	j = j + piccounter2;
	piccounter2 = 0;

pic4b:						/* 1 or more consecutive insertion characters get put into ecm */
	do p = 1 to piccounter1;

	     if arrpntr = 4				/*period(functionally)*/
	     then do;
		     if fixed_common.obj_dec_comma
		     then substr (editor.ecm, j + p - 1, 1) = ",";
		     else substr (editor.ecm, j + p - 1, 1) = ".";
		end;

	     else if arrpntr = 3			/*comma (functionally)*/
	     then do;
		     if fixed_common.obj_dec_comma
		     then substr (editor.ecm, j + p - 1, 1) = ".";
		     else substr (editor.ecm, j + p - 1, 1) = ",";
		end;

	     else do;
		     ch = pic_array (t);

		     if ch = "B"
		     then ch = " ";
		     else if ch = "h"
		     then ch = "-";

		     substr (editor.ecm, j + p - 1, 1) = ch;

		end;
	end;

	j = j + piccounter1;
pic9:
	go to piclabel (arrpntr);

piclabel (1):					/* B */
piclabel (3):					/* , */
piclabel (15):					/* 0 */
	if fltswitch2
	then editor.max_supress = editor.max_supress + piccounter1;
	go to mainloop;

piclabel (2):					/* V */
piclabel (4):					/* . */
piclabel (31):					/* 9 */
	fltswitch2 = "0"b;
	go to mainloop;

piclabel (5):					/* C */
	if substr (picture.string, i + 1, 1) = "R"
	then do;
		i = i + 1;
		data_name.item_length = data_name.item_length + 1;
		substr (editor.ecm, j, 1) = "R";
		inscnter = inscnter + 1;
		editor.fixed_insert = 5;		/* blank when >=0 */
		vector_map.item_signed = "1"b;
		go to mainloop;
	     end;

	go to err3;

piclabel (6):					/* D */
	if substr (picture.string, i + 1, 1) = "B"
	then do;
		i = i + 1;
		data_name.item_length = data_name.item_length + 1;
		substr (editor.ecm, j, 1) = "B";
		inscnter = inscnter + 1;
		editor.fixed_insert = 5;		/* blank when >=0 */
		vector_map.item_signed = "1"b;
		go to mainloop;
	     end;

	go to err3;

piclabel (7):					/* E */
						/*		call ioa_("E not implemented yet");*/
	go to mainloop;

piclabel (8):					/* Z to left of decimal point */
	editor.max_supress = editor.max_supress + piccounter1;
	go to mainloop;

piclabel (10):					/*asterisk to left of decimal point */
	editor.max_supress = editor.max_supress + piccounter1;
	vector_map.pic_has_ast = "1"b;
	go to mainloop;

piclabel (18):					/* floating left + */
	editor.max_supress = editor.max_supress + piccounter1;
	editor.float_insert = 2;
	vector_map.item_signed = "1"b;
	go to mainloop;

piclabel (22):					/* floating left - */
	editor.max_supress = editor.max_supress + piccounter1;
	editor.float_insert = 3;
	vector_map.item_signed = "1"b;
	go to mainloop;

piclabel (26):					/* floating left $ */
	editor.max_supress = editor.max_supress + piccounter1;
	editor.float_insert = 1;
	go to mainloop;

piclabel (9):					/* Z to right of decimal point */
	vector_map.pic_has_ast = "0"b;
	vector_map.bwz = "1"b;
	goto extra_label;

piclabel (27):					/* floating right $ */
	vector_map.pic_has_ast = "0"b;
	vector_map.bwz = "1"b;
	go to mainloop;

piclabel (19):					/* floating right + */
piclabel (23):					/* floating right - */
	vector_map.pic_has_ast = "0"b;
	vector_map.bwz = "1"b;
	vector_map.item_signed = "1"b;
	go to mainloop;

piclabel (11):					/* asterisk to right of decimal point */
	vector_map.ast_when_zero = "1"b;

extra_label:
	if substr (propvector, 13, 1)
	then editor.start_supress = 0;
	go to mainloop;

piclabel (14):					/* L */
	vector_map.pic_has_l = "1"b;
	vector_map.variable_length = "1"b;
	go to mainloop;

piclabel (16):					/* fixed left + */
	substr (editor.ecm, j - 1, 1) = "-";
	editor.fixed_insert = 4;
	vector_map.item_signed = "1"b;
	go to mainloop;

piclabel (17):					/* fixed right + */
	substr (editor.ecm, j - 1, 1) = "-";
	editor.fixed_insert = 2;
	vector_map.item_signed = "1"b;
	go to mainloop;

piclabel (20):					/* fixed left - */
	editor.fixed_insert = 3;
	vector_map.item_signed = "1"b;
	go to mainloop;

piclabel (21):					/* fixed right - */
	editor.fixed_insert = 1;
	vector_map.item_signed = "1"b;
	go to mainloop;

piclabel (28):					/* S */
	vector_map.pic_has_s = "1"b;
	vector_map.item_signed = "1"b;
	go to mainloop;

piclabel (24):					/* fixed left $ */
	substr (editor.ecm, j - 1, 1) = fixed_common.object_sign;
	goto mainloop;

piclabel (12):					/* P to left of decimal point */
piclabel (13):					/* P to right of decimal point */
piclabel (25):					/* fixed right $ */
piclabel (29):					/* X */
piclabel (30):					/* A */
	go to mainloop;

piclabel (32):					/* stopper character generated at end of PICTURE string by cobol_ddsyntax */
	if inscnter = 0
	then do;
		auxbit = fltswitch1 | fltswitch3;

		if ^auxbit
		then do;
			mask4x = propvector & mask1x;

			if mask4x = mask2x
			then do;

				if substr (propvector, 2, 1) = "0"b
				then vector_map.pic_integer = "1"b;

				vector_map.numeric = "1"b;

				if ^vector_map.item_signed
				then vector_map.pic_unsigned = "1"b;
				go to speclabel;
			     end;

			if mask4x = mask3x
			then vector_map.alphabetic = "1"b;
			else vector_map.alphanum = "1"b;

			go to speclabel;

		     end;
	     end;

	if piccounter2 = 0
	then go to int1;

/*[4.2-4]*/
	call fill_edit;

int1:
	editor.length = data_name.item_length;
	data_name.edit_ptr = data_name.size + 1;
	data_name.size = data_name.size + data_name.item_length + ed_constant;

	data_name.size = data_name.size + mod (-data_name.size, 4);

	r = data_name.size + 1;
	picptr = addr (dn_ptr -> any_item (r));

	if data_name.item_length = inscnter
	then go to err5;

	if substr (propvector, 29, 2) = "00"b
	then do;
		vector_map.numeric_edited = "1"b;

		if fltswitch1
		then do;
			if ^substr (propvector, 13, 1)
			then do;
				data_name.places_left = data_name.places_left - 1;
				substr (editor.ecm, editor.start_supress, 1) = fltchar;
			     end;

			n = editor.max_supress + editor.start_supress;

			if n - 1 = data_name.item_length
			then vector_map.bwz = "1"b;

			if substr (propvector, 13, 1)
			then do;

				data_name.places_right = data_name.places_right - 1;

				if fltchar = "+"
				then do;
					fltchar = "-";
					editor.fixed_insert = 2;
				     end;

				else if fltchar = "-"
				then editor.fixed_insert = 3;
				else fltchar = fixed_common.object_sign;

				substr (editor.ecm, editor.start_supress, 1) = fltchar;
				editor.start_supress = 0;
				editor.max_supress = 0;

			     end;

			if n = data_name.item_length
			then if substr (propvector, 4, 1)
			     then vector_map.bwz = "1"b;
						/*[3.0-1]*/
		     end;

		go to speclabel;

	     end;

	auxbit = substr (propvector, 30, 1) & substr (propvector, 15, 1);

	if substr (propvector, 29, 1) | auxbit
	then vector_map.alphanum_edited = "1"b;
	else vector_map.alphabetic_edited = "1"b;

speclabel:
	ptr1 = picptr;

	goto actretrn;

aerr:
	tf = 130;

err:						/*[4.2-5]*/
	call diag (tf, record.line, record.column);

	goto actretrn;

err2:
	if (arrpntr = 127 | arrpntr = 40 | arrpntr = 41)
	then go to err1;

	tf = 132;
	go to err;

err1:
	tf = 134;
	go to err;

err3:
	if arrpntr < 32
	then go to err1;
	go to err2;

err4:
	tf = 136;
	go to err;

err5:
	tf = 137;
	go to err;

/*[4.2-4]*/
fill_edit:
     proc;					/**/
	save_j = j;				/**/
	if piccounter2 <= 30			/**/
	then substr (editor.ecm, j, piccounter2) = substr (filstring, 1, piccounter2);
						/**/
						/**/
	else do;					/**/
		fixbin15 = 30;			/**/
		temp_bin1 = piccounter2;		/**/
						/**/
		do while ("1"b);			/**/
						/**/
		     substr (editor.ecm, j, fixbin15) = substr (filstring, 1, fixbin15);
						/**/
		     temp_bin1 = temp_bin1 - fixbin15;	/**/
		     j = j + fixbin15;		/**/
						/**/
		     if temp_bin1 = 0
		     then do;
			     j = save_j;
			     return;
			end;			/**/
						/**/
		     if temp_bin1 < 30
		     then fixbin15 = temp_bin1;
		     else fixbin15 = 30;		/**/
		end;
	     end;
     end;						/*[4.2-4]*/


actlbl (15):					/*action(136):*/
						/* inherit parent properties */
	if vector_map.value_clause = "0"b
	then vector_map.elem_no_value = "1"b;

	odim = 0;

	if h = 0
	then goto actretrn;

	fh = h;
	temp_bin1 = data_name.size + 1;

	if cobol_htbl.occurs_ext (fh) & ^vector_map.occurs_clause
	then do;

/*inherit parent's occurs extension ... if vector_map.occurs_clause was set,then
	item inherited parent's extension at time that its own occurs clause was
	parsed ... if parent had one*/

		rnt_key = cobol_htbl.nt_rec (fh);

		call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

		if rnt_ptr -> data_name.occurs_ptr = 0
		then go to postveca136;

		save_ptr = dn_ptr;
		dn_ptr = rnt_ptr;
		pdn_occ_ptr = addr (dn_ptr -> any_item (data_name.occurs_ptr));
		odim = pdn_occ_ptr -> occurs.dimensions;
		ptr1 = addr (save_ptr -> any_item (temp_bin1));
		fixbin7_1 = occ_constant + occ_dim_constant * odim;
		substr (ptr1 -> anystring, 1, fixbin7_1) = substr (pdn_occ_ptr -> anystring, 1, fixbin7_1);
		ptr1 -> occurs.keyed = 0;
lbl136:
		dn_ptr = save_ptr;
	     end;

	if odim ^= 0
	then do;

		data_name.occurs_ptr = data_name.size + 1;
		data_name.size = data_name.size + fixbin7_1;
		data_name.size = data_name.size + mod (-data_name.size, 4);

	     end;

	rnt_key = cobol_htbl.nt_rec (fh);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

postveca136:
	vector_map.assoc_with_signed_num_display =
	     (substr (vector_part, 9, 32) & non_display_bits_mask) = "0"b & vector_map.numeric & vector_map.pic_has_s;

	ptr6 = addr (vectemp);

	vectempd.descr = addr (rnt_ptr -> data_name.file_section) -> bit72 & mask_descr;
	vectempd.minivector = cobol_htbl.minivector (fh) & mask_minivector;
	vectempd.filler = "0"b;

	vector_part = vectemp | vector_part;

	cobol_htbl.minivector (fh) = cobol_htbl.minivector (fh) | (vectord.minivector & mask_minivector_reverse);

	do fh = fh - 1 to 1 by -1;
	     cobol_htbl.minivector (fh) =
		(cobol_htbl.minivector (fh + 1) & mask_minivector_reverse) | cobol_htbl.minivector (fh);
	end;

	goto actretrn;

actlbl (16):					/* action(82) */
	current_line = current_line + org + 1;

	go to new_inst;

actlbl (17):					/* action(83) */
	if int_val = 0
	then if fixed_common.comp_level < "5"		/*[4.0-4]*/
	     then call LEV_DIAG (129);

	go to actretrn;

actlbl (18):					/*action(168)*/
						/*[3.0-2]*/
						/*[4.0-4]*/
	if fixed_common.comp_level < "5"
	then call LEV_DIAG (169);

	go to actretrn;

actlbl (19):					/*action(169)*/
						/* add entry in ref table */
						/*[4.4-1]*/
	ref_table_size = ref_table_size + 1;

/*[4.4-1]*/
	ref.length (ref_table_size) = user_word.word_size;/*[4.4-1]*/
	ref.name (ref_table_size) = substr (user_word.word, 1, user_word.word_size);
						/*[4.4-1]*/
	ref.size (ref_table_size) = 24 + user_word.word_size;

	go to actretrn;

actlbl (20):					/*action(170)*/
						/* process like attribute */
						/*[4.4-1]*/
	if like_key = null_key			/*[4.4-1]*/
	then do;
		hash_table_ptr = addr (hash_table (1)); /* first use, initialize */
						/*[4.4-1]*/
		ref_table_ptr = addr (ref_table (1));	/*[4.4-1]*/
		diag_ptr = addr (diag_token);

/*[4.4-1]*/
		diag_token.size = 28;		/*[4.4-1]*/
		diag_token.run = 6;

/*[4.4-1]*/
		do i = 1 by 1 to 512;

/*[4.4-1]*/
		     hash_table (i) = null ();

/*[4.4-1]*/
		end;

/*[4.4-1]*/
		do i = 1 by 1 to 50;

/*[4.4-1]*/
		     ref_table (i) = addr (ref (i));

/*[4.4-1]*/
		end;

/*[4.4-1]*/
		prev_rec_ptr = null ();		/*[4.4-1]*/
		rec_key = first_key;		/* get first record in name table */
						/*[4.4-1]*/
		call cobol_vdwf_dget (cobol_ext_$cobol_name_fileno_ptr,
						/*[4.4-1]*/
		     status,			/*[4.4-1]*/
		     rec_ptr,			/*[4.4-1]*/
		     rec_size,			/*[4.4-1]*/
		     first_key /*[4.4-1]*/);

/*[4.4-1]*/
		call form_chains;

/*[4.4-1]*/
	     end;

/*[4.4-1]*/
	else do;
		call cobol_vdwf_dget (cobol_ext_$cobol_name_fileno_ptr,
						/*[4.4-1]*/
		     status,			/*[4.4-1]*/
		     rec_ptr,			/*[4.4-1]*/
		     rec_size,			/*[4.4-1]*/
		     like_key /*[4.4-1]*/);

/*[4.4-1]*/
		prev_rec_ptr = rec_ptr;

/*[4.4-1]*/
	     end;

/* process entries added since	*/
/* the last like attribute		*/

/*[4.4-1]*/
	status = "0"b;

/*[4.4-1]*/
	do while (status = "0"b);

/*[4.4-1]*/
	     call cobol_vdwf_sget (cobol_ext_$cobol_name_fileno_ptr,
						/*[4.4-1]*/
		status,				/*[4.4-1]*/
		rec_ptr,				/*[4.4-1]*/
		rec_size,				/*[4.4-1]*/
		rec_key /*[4.4-1]*/);

/*[5.2-1]*/
	     if status = "0"b			/*[4.4-1]*/
	     then do;
		     call form_chains;

/*[4.4-1]*/
		     prev_rec_ptr = rec_ptr;

/*[4.4-1]*/
		end;

/*[4.4-1]*/
	     else last_rec_ptr = addrel (rec_ptr, divide (rec_size + 11, 8, 17, 0) * 2);

/*[4.4-1]*/
	end;

/*[4.4-1]*/
	like_key = rec_key;

/*[4.4-1]*/
	diag_no = 0;


/*[4.4-1]*/
	call cobol_usrwd (ref_table_ptr,		/*[4.4-1]*/
	     ref_table_size,			/*[4.4-1]*/
	     hash_table_ptr,			/*[4.4-1]*/
	     0,					/*[4.4-1]*/
	     last_rec_ptr,				/*[4.4-1]*/
	     "0"b,				/*[4.4-1]*/
	     was_found,				/*[4.4-1]*/
	     not_found,				/*[4.4-1]*/
	     diag_no,				/*[4.4-1]*/
	     rename_object_ptr);


/*[4.4-1]*/
	if was_found
	then do;
		call get_rename_desc;
		go to actretrn;
	     end;


/*[4.4-1]*/
	if not_found				/*[4.4-1]*/
	then do;
		if diag_no = 0
		then diag_token.num = 2;
		else diag_token.num = diag_no;

/*[4.4-1]*/
		call cobol_c_list (diag_ptr);


/*[4.4-1]*/
	     end;


	go to actretrn;


get_rename_desc:
     proc;

/*[4.4-1]*/
	data_name.item_length = rename_object_ptr -> data_name.item_length;
						/*[4.4-1]*/
	data_name.places_left = rename_object_ptr -> data_name.places_left;
						/*[4.4-1]*/
	data_name.places_right = rename_object_ptr -> data_name.places_right;

/*[4.4-1]*/
	vector_map.elementary, vector_map.picture_clause, vector_map.alphanum = "1"b;

     end;

form_chains:
     proc;

/*[4.4-1]*/
declare	(string_size, hashno)
			fixed bin;		/*[4.4-1]*/
declare	string_ptr	ptr;

/*[4.4-1]*/
declare	string		char (30) based (string_ptr);

/*[5.2-1]*/
	if rec_ptr -> data_name.type = 9		/*[5.2-1]*/
	then do;
		string_size = rec_ptr -> data_name.name_size;
						/*[5.2-1]*/
		string_ptr = addr (rec_ptr -> data_name.name);
						/*[5.2-1]*/
	     end;					/*[5.2-1]*/
	else if rec_ptr -> procname.type = 7		/*[5.2-1]*/
	then do;
		string_size = rec_ptr -> procname.length;
						/*[5.2-1]*/
		string_ptr = addr (rec_ptr -> procname.name);
						/*[5.2-1]*/
	     end;					/*[5.2-1]*/
	else if rec_ptr -> conditioname.type = 11	/*[5.2-1]*/
	then do;
		string_size = rec_ptr -> conditioname.name_size;
						/*[5.2-1]*/
		string_ptr = addr (rec_ptr -> conditioname.name);
						/*[5.2-1]*/
	     end;					/*[5.2-1]*/
	else if rec_ptr -> fd.type = 12 | rec_ptr -> fd.type = 16
						/*[5.2-1]*/
	then do;
		string_size = rec_ptr -> fd.name_size;	/*[5.2-1]*/
		string_ptr = addr (rec_ptr -> fd.name); /*[5.2-1]*/
	     end;					/*[5.2-2]*/
	else if rec_ptr -> indexname.type = 10		/*[5.2-2]*/
	then do;
		string_size = rec_ptr -> indexname.name_size;
						/*[5.2-2]*/
		string_ptr = addr (rec_ptr -> indexname.name);
						/*[5.2-2]*/
	     end;					/*[5.2-2]*/
	else return;

/*[4.4-1]*/
	hashno = 0;

/*[4.4-1]*/
	do i = 1 by 1 to string_size;

/*[4.4-1]*/
	     hashno = hashno + fixed (unspec (substr (string, i, 1)));

/*[4.4-1]*/
	end;

/*[4.4-1]*/
	hashno = mod (hashno, 512) + 1;

/*[4.4-1]*/
	procname.string_ptr = hash_table (hashno);	/*[4.4-1]*/
	hash_table (hashno) = rec_ptr;

/*[4.4-1]*/
	procname.string_ptr = prev_rec_ptr;		/*[4.4-1]*/
	prev_rec_ptr = rec_ptr;

     end;

actlbl (21):					/* action(84) */
						/* issue diag attached to prev token */
						/*[5.1-3]*/
	call diag (TF, save_last_line, save_last_column); /*[5.1-3]*/
	TF = 0;

	go to actretrn;


/***** check routines *****/

/* section_header */

check (1):
	if min_eof
	then do;
		next_level = 1;
		go to success;
	     end;

	else if (record.type = 1 & rw.class.section_header = "1"b)
	then do;
		call a_test;
		next_level = 1;
		go to success;
	     end;

	go to fail;

/* fs_precedence */

check (2):
	if substr (section_ind, 2, 7) = "0"b
	then goto success;
	go to fail;

/* wss_indicator */

check (3):
	if substr (section_ind, 2, 1) = "0"b
	then goto success;
	go to fail;

/* cns_precedence */

check (4):
	if substr (section_ind, 4, 5) = "0"b
	then goto success;
	go to fail;

/* cns_indicator */

check (5):
	if substr (section_ind, 3, 1) = "0"b
	then goto success;
	else goto fail;

/* lks_precedence */

check (6):
	if substr (section_ind, 5, 4) = "0"b
	then goto success;
	go to fail;

/* lks_indicator */

check (7):
	if substr (section_ind, 4, 1) = "0"b
	then goto success;
	go to fail;

/* integer */

int:
check (8):					/*[5.1-1]*/
	if record.type = 1				/*[5.1-1]*/
	then if rw.key = 180			/*[5.1-1]*/
	     then do;
		     int_val, temp_bin1 = 0;		/*[5.1-1]*/
		     go to success;			/*[5.1-1]*/
		end;				/*[5.1-1]*/
	     else go to fail;			/*[5.1-1]*/
	else if record.type ^= 2 | numeric_lit.rtdp ^= 0
	then go to fail;

	if numeric_lit.length > 18
	then call DIAG (218);

	int_val, temp_bin1 = fixed (numeric_lit.literal);

	go to success;

/* integer_77 */

lev77:
check (9):
	call level_number (77);

	next_level = 1;

	goto success;

/* integer_01 */

lev01:
check (10):
	call level_number (1);

/*[4.3-2]*/
	if numeric_lit.length = 1
	then if fixed_common.comp_level < "3"
	     then call LEV_DIAG (218);

	s_lin = record.line;
	s_col = record.column;

	next_level = 1;

	goto success;

/* user_word */

type8:
check (11):
	if record.type = 8
	then do;					/* if fixed_common.comp_level < "5"
			then	if record.column < 12
				then	call LEV_DIAG(142);	*/
						/*[4.4-2]*/

/*[4.2-3]*/
		filler_flag = "0"b;

		go to success;
	     end;
	go to fail;

/* dd_clause_header */

check (12):
	if record.type ^= 1
	then go to fail;

	if rw.class.dd_clause = "1"b
	then goto success;
	go to fail;


/* code set clause */

check (13):
codeset:
	if user_word.type ^= 8
	then go to fail;

	if fixed_common.alphabet_offset ^= 0
	then do;
		alf_offset = fixed_common.alphabet_offset;

		do while (alf_offset ^= 0);

		     call cobol_vdwf_dget (cobol_ntfp, alf_status, alf_ptr, alf_size, alf_key);

		     if user_word.word = alf_ptr -> alphabet_name.name
		     then do;
			     file_table.code_set_clause = "1"b;
			     file_table.code_set = alf_ptr -> alphabet_name.iw_key;

			     go to success;

			end;

		     alf_offset = addr (alf_ptr -> alphabet_name.prev_rec) -> fb;

		end;

	     end;

	alf_offset = cobol_imp_word$alphabet_name (min_ptr);

	if alf_offset = 0
	then go to fail;

	call DIAG (204);

	file_table.code_set_clause = "1"b;
	file_table.code_set = alf_offset + 10;

	go to success;


/* integer_88 */

lev88:
check (14):
	call level_number (88);

	go to success;

/* integer_66 */

lev66:
check (15):
	call level_number (66);

	next_level = 1;

	goto success;

/* linage footing body integer */

check (16):
	if linage_rec.footing = 5 & linage_rec.body = 5 & linage_rec.footing_int > linage_rec.body_int
	then go to fail;

	go to success;


/* integer_02_49 */

lev0249:
check (17):
	call level_number (0);

	if int_val >= 2 & int_val <= 49
	then do;
		if res
		then call DIAG (216);
		next_level = temp_bin1;

		if fixed_common.comp_level < "3" & int_val > 10
						/*[4.0-4]*/
		then call LEV_DIAG (141);

/*[4.3-2]*/
		if numeric_lit.length = 1
		then if fixed_common.comp_level < "3"
		     then call LEV_DIAG (218);

		go to success;
	     end;

	go to fail;

level_number:
     proc (level);

declare	level		fixed bin;

	if record.type ^= 2
	then go to fail;

/*[5.1-1]*/
	if record.type = 2
	then int_val, temp_bin1 = fixed (numeric_lit.literal);
	else int_val, temp_bin1 = 0;

	if numeric_lit.sign ^= " " | numeric_lit.rtdp ^= 0 | numeric_lit.ltdp + numeric_lit.rtdp > 2
	then res = "1"b;
	else res = "0"b;

	if level = 0 | level = 66 | level = 88
	then return;

	if int_val ^= level
	then go to fail;

/*[4.2-2]*/
	if record.column = 9999
	then return;

	if res
	then call DIAG (216);

	call a_test;

     end;

a_test:
     proc;

	if record.column < 8 | record.column > 11
	then do;
		call DIAG (219);

/*[4.2-2]*/
		if fixed_common.comp_level < "5"
		then call lev_diag (133);

	     end;

     end;

/* picture_clause */

check (18):
	if vector_map.picture_clause = "0"b
	then goto success;
	go to fail;

/* picture_char_string */

check (19):
	if record.type = 4
	then goto success;
	go to fail;

/* usage_clause */

check (20):
	if vector_map.usage_clause = "0"b
	then goto success;
	go to fail;

/* father_son usage */

check (21):
	if h = 0
	then goto success;

	rnt_key = cobol_htbl.nt_rec (h);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);



/*mask out all bits but USAGE ones*/

	bit32_1 = substr (addr (rnt_ptr -> data_name.file_section) -> bit72, 9, 32) & usage_bits_mask;

	if bit32_1 = "0"b
	then goto success;

	bit32_2 = substr (vector_part, 9, 32) & usage_bits_mask;

	if bit32_2 = bit32_1
	then goto success;

	goto fail;

/* value_indicator */

check (22):
	if vector_map.value_clause = "0"b
	then goto success;
	go to fail;

/*numeric_literal */

check (23):
	if record.type = 2
	then goto success;
	go to fail;

/* alphanumeric_literal */

check (24):
	if record.type = 3
	then goto success;
	go to fail;

/* rw_figurative_constant */

figcon:
check (25):
	if fixed_common.comp_level < "3"
	then do;
		if record.type = 1 & rw.class.fig_con
		then do;
			if rw.class.end_dec		/*[4.0-4]*/
			then call LEV_DIAG (154);
			go to success;
		     end;
	     end;
	else do;
		if record.type = 1 & rw.class.fig_con
		then go to success;
	     end;
	go to fail;

/* father_no_value */

check (26):
	if h = 0
	then goto success;

	rnt_key = cobol_htbl.nt_rec (h);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	if substr (addr (rnt_ptr -> data_name.file_section) -> bit72, 47, 2) = "0"b
	then go to success;

	goto fail;

/* sign_clause */

check (27):
	if sign_clause = "0"b
	then goto success;
	go to fail;

/* father_sign_clause */

check (28):
	if h = 0
	then goto success;

	rnt_key = cobol_htbl.nt_rec (h);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	if rnt_ptr -> data_name.sign_type
	then go to fail;
	go to success;

/* father_son_sign_type */


check (29):
	if h = 0
	then goto success;

	sign_type_temp = data_name.sign_type;
	rnt_key = cobol_htbl.nt_rec (h);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	if rnt_ptr -> data_name.sign_type
	then go to fail;
	else if rnt_ptr -> data_name.sign_type = sign_type_temp
	then go to success;
	goto fail;

/*sync*/

check (30):
	if vector_map.sync_right = "0"b
	then goto success;
	go to fail;

/* father_88 */

check (31):
	if h = 0
	then goto success;

	do fh = h to 1 by -1;
	     if cobol_htbl.switch_88 (fh)
	     then goto fail;
	end;
	goto success;

/* just_indicator */


check (32):
	if vector_map.just_right = "0"b & vector_map.just_left = "0"b
	then goto success;
	go to fail;

/* bwz_clause */

check (33):
	if vector_map.bwz = "0"b
	then goto success;
	go to fail;

/* occurs_clause */

check (34):
	if h = 0 | vector_map.occurs_clause
	then go to fail;
	goto success;

/* occurs_dimension */

check (35):
	if occurs.dimensions < 3
	then goto success;
	go to fail;

check (36):
labnam:						/* value of clause */
	label_field_num = cobol_imp_word$label_name (min_ptr);

	if label_field_num ^= 0
	then go to success;

	go to fail;

/* occurence_number */

check (37):
	if occurs.level.max (odim) ^= 0
	then goto success;
	go to fail;

/* occurs_minimax */

check (38):
	if occurs.level.max (odim) > occurs.level.min (odim)
	then goto success;
	go to fail;

/* father_subscripted */

check (39):
	if h = 0
	then goto success;

	rnt_key = cobol_htbl.nt_rec (h);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	if ^rnt_ptr -> data_name.subscripted
	then goto success;

	goto fail;

/* linage footing redundancy */

check (40):
	if fd_ind.linage_type.footing = "1"b
	then goto fail;
	go to success;

/* linage bottom redundancy */

check (41):
	if fd_ind.linage_type.bottom = "0"b
	then goto success;
	go to fail;

/* indexed_by */

check (42):
	if vector_map.indexed_by = "0"b
	then goto success;
	go to fail;

/* father_indexed_by */

check (43):
	if h = 0
	then goto success;

	rnt_key = cobol_htbl.nt_rec (h);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	if ^rnt_ptr -> data_name.subscripted | rnt_ptr -> data_name.indexed_by
	then goto success;

	goto fail;

/*test for Level 64 COBOL running*/

check (44):
	goto success;

/* thru_value */

check (45):
	goto success;

/* father_usage_index */

check (46):
	if h = 0
	then goto success;

	rnt_key = cobol_htbl.nt_rec (h);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	if ^rnt_ptr -> data_name.usage_index
	then goto success;

	goto fail;

/* fs_cms_rdf_01 */

check (47):
	if data_name.level ^= 1
	then go to success;
	if vector_map.file_section = "1"b | vector_map.communication_section = "1"b
	then goto fail;
	goto success;



check (48):
labval:						/* examine label field literal */
	if label_field_num ^= 0
	then go to LV (label_field_num);

	if numeric_lit.type = 2 | alphanum_lit.type = 3 | (rw.type = 1 & rw.class.fig_con)
	then go to success;

	go to fail;

LV (1):						/* file-id */
	if numeric_lit.type = 2			/* numeric lit */
	then go to fail;

	else if alphanum_lit.type = 3			/* alphanumeric lit */
	then do;
		if alphanum_lit.length > 17
		then tf = 194;
		go to success;
	     end;

	else if rw.type = 1 & rw.class.fig_con		/* figurative const */
	then go to success;

	go to fail;

LV (2):						/* retention */
	if numeric_lit.type = 2			/* numeric lit */
	then do;
		if ^(numeric_lit.integer & numeric_lit.sign = " " & numeric_lit.length <= 3)
		then tf = 212;

		go to success;

	     end;

	else if alphanum_lit.type = 3			/* alphanumeric literal */
	then go to fail;

	else if rw.type = 1 & rw.class.fig_con		/* figurative const */
	then do;
		if ^(rw.key = 180)			/* is_word("ZERO") */
		then tf = 213;
		go to success;

	     end;

	go to fail;

LV (3):						/* catalogue-name */
	if alphanum_lit.type = 3
	then do;
		if alphanum_lit.length > 168
		then do;
			tf = 222;
			alphanum_lit.length = 168;
		     end;

		go to success;

	     end;

	go to fail;

/* linage top redundancy */

check (49):
	if fd_ind.linage_type.top = "0"b
	then goto success;
	go to fail;

check (50):
all:						/* test for all fig const */
	if rw.type = 1 & rw.key = 73			/* is_word("ALL") */
	then do;
		all_ind = 1;

/*[4.0-4]*/
		if fixed_common.comp_level < "3"
		then call LEV_DIAG (144);

		go to success;
	     end;

	all_ind = 0;

	go to fail;

/* level = 01 or 77, but dont push level stack */

check (51):
lev0177:
	if record.type ^= 2
	then go to fail;

/*[5.1-1]*/
	if record.type = 2
	then int_val, temp_bin1 = fixed (numeric_lit.literal);
	else int_val, temp_bin1 = 0;

	if int_val = 1 | int_val = 77
	then do;
		next_level = 1;
		go to success;
	     end;

	go to fail;

lrc:
check (52):
	if FD_indic = "0"b
	then go to success;
	else if file_table.label_format ^= 0
	then go to success;

	go to fail;

/*[4.0-1]*/
dup_type8:
check (53):					/*[4.0-1]*/
	if record.type = 8				/*[4.0-1]*/
	then do;
		if fixed_common.comp_level < "3"	/*[4.0-1]*/
		then if index (tok_string, "~" || user_word.word || "~") > 0
						/*[4.0-4]*/
		     then call LEV_DIAG (182);

/*[4.0-1]*/
		go to success;			/*[4.0-1]*/
	     end;

/*[4.0-1]*/
	go to fail;

/* fs_indicator */

check (54):
	if substr (section_ind, 1, 1) = "0"b
	then goto success;
	go to fail;

/* fs_level_indicator */

check (55):
fsind:
	if record.type = 1 & rw.class.fs_ind = "1"b
	then do;
		call a_test;
		next_level = 1;

		if rw.key = 219			/* fd */
		then FD_indic = "1"b;
		else FD_indic = "0"b;
		go to success;
	     end;

	go to fail;

/* file_name_match */

check (56):
	i = 0;

next_file:
	i = i + 1;

	if i > fixed_common.file_count
	then goto fundefined;

/* get file record number in common file */

	cm_key = fixed_common.filedescr_offsets (i);

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

	ft_ptr = cm_ptr;

	if file_table.name_size = fd_token.name_size
	then if substr (file_table.name, 1, file_table.name_size) = substr (fd_token.name, 1, fd_token.name_size)
	     then do;
		     org = file_table.organization;

/*[4.0-2]*/
		     call init_src;

		     go to success;
		end;

	if i = 20
	then goto next_file_chain;

	goto next_file;

next_file_chain:
	if file_table.next = null_key
	then goto fundefined;

	cm_key = file_table.next;

	call cobol_vdwf_dget (cobol_cmfp, fstatus, cm_ptr, cm_size, cm_key);

	ft_ptr = cm_ptr;

	if file_table.name_size = fd_token.name_size
	then if substr (file_table.name, 1, file_table.name_size) = substr (fd_token.name, 1, fd_token.name_size)
	     then do;
		     org = file_table.organization;

/*[4.0-2]*/
		     call init_src;

		     go to success;
		end;

	goto next_file_chain;

fundefined:
	fd_token.file_no = 0;
	org = 0;
	goto fail;

check (57):
	if record.type = 1 & rw.class.fs_ind
	then do;
		next_level = 1;
		go to success;
	     end;

	go to fail;

/* file_01 */

check (58):
	if ll01 = "1"b | fd_ind.report_is = "1"b
	then goto success;
	go to fail;

/* fd_record_contain */

check (59):
	if fd_ind.record_contain = "0"b
	then goto success;
	go to fail;

/* fd_data_record */

check (60):
	if fd_ind.data_record = "0"b
	then goto success;
	go to fail;

/* fd_clause_header */

check (61):					/*[4.0-2]*/
	if record.type ^= 1
	then go to fail;				/*[4.0-2]*/
	if ^rw.class.fd_clause
	then go to fail;

/*[4.0-2]*/
	if rw.key = 219
	then ii = 1;				/* fd */
						/*[4.0-2]*/
	else if rw.key = 237
	then ii = 2;				/* recording */
						/*[4.0-2]*/
	else if rw.key = 205
	then ii = 3;				/* block */
						/*[4.0-2]*/
	else if rw.key = 148
	then ii = 4;				/* record */
						/*[4.0-2]*/
	else if rw.key = 121
	then ii = 5;				/* label */
						/*[4.0-2]*/
	else if rw.key = 258
	then ii = 6;				/* value */
						/*[4.0-2]*/
	else if rw.key = 196
	then ii = 7;				/*data */
						/*[4.0-2]*/
	else if rw.key = 240
	then ii = 8;				/* reports */
						/*[4.0-2]*/
	else if rw.key = 563
	then ii = 9;				/* linage */
						/*[4.0-2]*/
	else if rw.key = 306
	then ii = 10;				/* code-set */
						/*[4.0-2]*/
	else go to fail;

/*[4.0-2]*/
	source_pos.line (ii) = rw.line;		/*[4.0-2]*/
	source_pos.column (ii) = rw.column;

	go to success;

/*[4.0-2]*/
init_src:
     proc;

/*[4.0-2]*/
	do ii = 1 by 1 to 10;

/*[4.0-2]*/
	     source_pos.line (ii) = 0;

/*[4.0-2]*/
	end;

/*[4.0-2]*/
	source_pos.line (1) = rw.line;		/*[4.0-2]*/
	source_pos.column (1) = rw.column;

     end;

check (62):
sechdr:
	if min_eof | (record.type = 1 & rw.class.section_header = "1"b)
	then do;
		next_level = 1;
		go to success;
	     end;

	go to fail;

check (63):
lev66s:						/*[5.0-1]*/
	call test_level_number (66);
	next_level = 1;
	go to success;

check (64):
lev88s:
	call test_level_number (88);

/*[4.2-3]*/
	if filler_flag = "1"b
	then if fixed_common.comp_level < "3"
	     then call LEV_DIAG_SAVED (176);
	go to success;

test_level_number:
     proc (num);

declare	num		fixed bin;

	call level_number (num);

	if int_val ^= num
	then go to fail;

     end;

/* fd_recording_mode */

check (65):
	if fd_ind.recording_mode = "0"b
	then goto success;
	go to fail;

/* fd_block_contain */

check (66):
	if fd_ind.block_contain = "0"b & fd_token.type = 12
	then goto success;
	go to fail;

/* fd_record_contain */

check (67):
	if fd_ind.record_contain = "0"b
	then goto success;
	go to fail;

/* fd_label_record */


check (68):
	if fd_ind.label_record = "0"b & fd_token.type = 12
	then goto success;
	go to fail;

/* fd_value_of */

check (69):
	if fd_ind.value_of = "0"b & fd_token.type = 12
	then goto success;
	go to fail;

/* fd_data_record */

check (70):
	if fd_ind.data_record = "0"b
	then goto success;
	go to fail;

/* fd_report_is */

check (71):
	if fd_ind.report_is = "0"b & fd_token.type = 12	/*[4.4-1]*/
	then do;
		file_table.organization, file_table.device = 1;
		go to success;
	     end;
	go to fail;				/* fd_linage_is */

check (72):
	if fd_ind.linage_is = "0"b & fd_token.type = 12
	then goto success;
	go to fail;

/*[4.0-2]*/
per_ck:
check (73):					/*[4.0-2]*/
	if rw.type ^= 1
	then go to fail;				/*[4.0-2]*/
	if rw.key ^= 189
	then go to fail;				/* "." */

/*[4.0-2]*/
	do ii = 1 by 1 to 10;

/*[4.0-2]*/
	     if source_pos.line (ii) ^= 0		/*[4.0-2]*/
	     then do;
		     lev_message.line = source_pos.line (ii);
						/*[4.0-2]*/
		     lev_message.column = source_pos.column (ii);

/*[4.0-2]*/
		     go to FT (ii);

FT (1):
		     num = 36;
		     call LEV1;
		     go to FT1;			/* fd */
FT (2):
		     num = 192;
		     mod_num = 25;
		     LEV = "5";
		     go to FT1;			/* recording mode */
FT (3):
		     num = 37;
		     call LEV1;
		     go to FT1;			/* block contains */
FT (4):
		     num = 193;
		     call LEV1;
		     go to FT1;			/* record contains */
FT (5):
		     num = 38;
		     call LEV1;
		     go to FT1;			/* label records */
FT (6):
		     num = 189;
		     call LEV1;
		     go to FT1;			/* value of */
FT (7):
		     num = 190;
		     call LEV1;
		     go to FT1;			/* data records */
FT (8):
		     num = 122;
		     mod_num = 25;
		     LEV = "5";
		     go to FT1;			/* reports are */
FT (9):
		     num = 191;
		     call LEV2;
		     go to FT1;			/* linage */
FT (10):
		     num = 168;
		     go to FT1;			/* code-set */

/*[4.0-2]*/
FT1:						/*[4.0-2]*/
		     if LEV > fixed_common.comp_level	/*[4.0-2]*/
		     then do;
			     lev_message.module = mod_num;
						/*[4.0-2]*/
			     lev_message.number = num;

/*[4.0-2]*/
			     call cobol_c_list (lev_message_ptr);

/*[4.0-2]*/
			     mod_num = 0;		/*[4.0-2]*/
			end;

/*[4.0-2]*/
		end;

/*[4.0-2]*/
	end;

	go to success;

LEV1:
     proc;

/*[4.0-2]*/
	mod_num = lev1_mod (org);			/*[4.0-2]*/
	LEV = lev1_org (org);

     end;

LEV2:
     proc;

/*[4.0-2]*/
	mod_num = lev2_mod (org);			/*[4.0-2]*/
	LEV = lev2_org (org);

     end;

check (74):					/* skip debug item decls if not needed */
						/*[4.4-3]*/
	if fixed_common.use_debug | fixed_common.debug
	then go to success;



/*[4.2-1]*/
/*[4.0-5] */
	do while (record.column = 9999 & ^min_eof);

/*[4.0-3]*/
	     call scan;				/*[4.0-3]*/
	end;

/*[4.0-3]*/
	go to success;



/* father_son_value_usage */

check (75):
	if h = 0
	then goto success;

	rnt_key = cobol_htbl.nt_rec (h);

	call cobol_vdwf_dget (cobol_ntfp, fstatus, rnt_ptr, rnt_size, rnt_key);

	if substr (addr (rnt_ptr -> data_name.file_section) -> bit72, 47, 2) = "0"b
	then go to success;

	if vector_map.display
	then goto success;

	goto fail;

/* usage_display */

check (76):
	if vector_map.display = "1"b
	then goto success;
	go to fail;

check (77):					/* skip terminator for debug item decl */
						/*[4.0-3]*/
	if record.type = 3 /*[4.0-3]*/ & /*[4.0-3]*/ alphanum_lit.length = 6 /*[4.0-3]*/
	     & /*[4.0-3]*/ substr (alphanum_lit.string, 1, alphanum_lit.length) = "~~~~~~"
						/*[4.0-3]*/
	then go to success;				/*[4.0-3]*/
	else go to fail;

check (78):
renames:
	go to fail;
















check (79):
test_like:
	if like_clause
	then go to fail;
	else go to success;

/****** communication section check routines *****/

check (80):
	if substr (section_ind, 6, 3) = "000"b
	then goto success;
	go to fail;

/* uniqueness of cms */

check (81):
	if substr (section_ind, 5, 1) = "1"b
	then goto fail;
	go to success;

/* uniqueness of INTIAL for cd */

check (82):
	if cd_initial = "0"b
	then goto success;
	go to fail;

/* cd input clause header */

check (83):
	if rw.type = 1 & rw.class.cd_input = "1"b
	then goto success;
	go to fail;

/* cd input record length=87 output record length=23 */

check (84):
	if save_cdo = 0
	then cd_out_size = 23;
	else cd_out_size = 10 + 13 * save_cdo;

	if data_name.level ^= 1 & data_name.level ^= 77
	then if (substr (cd_clauses, 12, 1) & cobol_htbl.item_length (1) <= 87)
		| (^substr (cd_clauses, 12, 1) & cobol_htbl.item_length (1) <= cd_out_size)
	     then goto success;
	     else go to fail;

	else if (substr (cd_clauses, 12, 1) & data_name.item_length <= 87)
	     | (^substr (cd_clauses, 12, 1) & data_name.item_length <= cd_out_size)
	then goto success;
	else go to fail;

/* uniqueness of symbolic que clause */

check (85):
	if substr (cd_clauses, 1, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of message count */

check (86):
	if substr (cd_clauses, 11, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of sub-queue-1 */

check (87):
	if substr (cd_clauses, 2, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of sub-queue-2 */

check (88):
	if substr (cd_clauses, 3, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of sub-queue-3 */
check (89):
	if substr (cd_clauses, 4, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of symbolic source clause */

check (90):
	if substr (cd_clauses, 7, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of message date or symbolic destination clause */

check (91):
	if substr (cd_clauses, 5, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of message times */

check (92):
	if substr (cd_clauses, 6, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of text length */

check (93):
	if substr (cd_clauses, 8, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of end key clause */

check (94):
	if substr (cd_clauses, 9, 1) = "0"b
	then goto success;
	go to fail;

/* uniqueness of status key clause */

check (95):
	if substr (cd_clauses, 10, 1) = "0"b
	then goto success;
	go to fail;

/* cd output clause header */

check (96):
	if rw.type = 1 & rw.class.cd_output = "1"b
	then goto success;
	go to fail;

check (97):
	;
check (98):
	;
check (99):
	;

check (100):					/*       call ioa_("compiler error run3: routine ^d is unused ",tf);*/
	goto fail;


/*[5.1-3]*/
dcl	(RL, RC)		fixed bin;
scan:
     proc;

scan_next:					/*[5.1-3]*/
	save_last_line = RL;			/*[5.1-3]*/
	save_last_column = RC;

	call cobol_swf_get (cobol_m1fp, fstatus, min_ptr, min_size_r);

	if substr (fstatus, 17, 16) ^= "0"b
	then do;

		if substr (fstatus, 17, 16) = "0000000000100111"b
		then do;
			min_eof = "1"b;
			goto outscan;
		     end;

		pre_end_sw = "1"b;

		goto outscan;

	     end;

/*[5.1-3]*/
	RL = record.line;				/*[5.1-3]*/
	RC = record.column;

	if record.type = 5
	then call cobol_c_list (min_ptr);

	if record.type = 7 | record.type = 24 | (record.type = 5 & record.info.rep = "0"b)
	then goto scan_next;

	if record.type = 2
	then nl = numeric_lit.length;
	if record.type = 3
	then al = alphanum_lit.length;
	if record.type = 8
	then ul = user_word.word_size;

	if min_ptr = null ()
	then do;

outscan:
		min_ptr = addr (name_string);		/*for fake token*/

/*[5.1-3]*/
		rw.line = RL;			/*[5.1-3]*/
		rw.column = RC;
		rw.type = 1;
		rw.key = 142;			/*PROCEDURE*/
		rw.class.filler4 = "00"b;
		rw.class.fig_con = "0"b;
		rw.class.filler5 = "0"b;
		rw.class.section_header = "1"b;
		rw.class.fs_ind = "0"b;
		rw.class.fd_clause = "0"b;
		rw.class.dd_clause = "0"b;
		rw.class.cd_input = "0"b;
		rw.class.cd_output = "0"b;
		rw.class.cset_name = "0"b;
		rw.class.filler6 = "00000000000"b;
		rw.jump_index = 30;			/* 5*6 */

	     end;

     end scan;


DIAG:
     proc (num);

declare	(num, tf_save)	fixed bin;

	tf_save = tf;
	tf = num;

/*[4.2-5]*/
	call diag (tf, record.line, record.column);

	tf = tf_save;

     end;

diag:
     proc (diag_num, line, column);

/*[4.2-5]*/
declare	(diag_num, line, column)
			fixed bin;

	message_ptr = addr (message_area);

	ptr4 = addr (message_area);
	ptr4 -> cma = 0;

	message.size = msg_constant;			/*[4.2-5]*/
	message.line = line;			/*[4.2-5]*/
	message.column = column;
	message.type = 5;
	message.run3 = 3;
	message.info.para = "0"b;
	message.info.rep = "0"b;
	message.info.fillerx = "000000"b;
	message.length = 0;
	message.number = diag_num;

	call cobol_c_list (message_ptr);

	diag_num = 0;
     end diag;

lev_diag:
     proc (diag_num);

declare	diag_num		fixed bin;

	lev_message.line = record.line;
	lev_message.column = record.column;
	lev_message.number = diag_num;
	lev_message.module = mod_num;

/*[4.0-2]*/
	call cobol_c_list (lev_message_ptr);

	mod_num = 0;

     end;

LEV_DIAG:
     proc (diag_num);

/*[4.0-4]*/
declare	diag_num		fixed bin;

/*[4.0-4]*/
	mod_num = 0;

/*[4.0-4]*/
	call lev_diag (diag_num);

     end;

/*[4.2-3]*/
LEV_DIAG_SAVED:
     proc (diag_num);

/* Prints diagnostic at the line and column saved in saved_line
   ans saved_column					*/

dcl	diag_num		fixed bin;

	lev_message.line = saved_line;
	lev_message.column = saved_column;
	lev_message.number = diag_num;
	lev_message.module = 0;

	call cobol_c_list (lev_message_ptr);

     end LEV_DIAG_SAVED;

pre_end:
comp_end:
	call cobol_ddact1 (98);			/*action(62)*/
	return;

/*[4.0-1]*/
init_tok_string:
     entry;

/*[4.0-1]*/
	tok_string = "~";				/*[4.0-1]*/
	return;

/*[4.0-1]*/
enter_tok_string:
     entry (ch36);

/*[4.0-1]*/
	if index (tok_string, "~" || ch36) <= 0		/*[4.0-1]*/
	then tok_string = tok_string || ch36;

/*[4.0-1]*/
	return;

/*[4.0-1]*/
dcl	ch36		char (36) varying;		/*[4.0-1]*/
dcl	tok_string	char (1024) varying static internal;

/*[4.0-2]*/
dcl	1 lev_message	static internal,		/*[4.0-2]*/
	  2 size		fixed bin,		/*[4.0-2]*/
	  2 line		fixed bin,		/*[4.0-2]*/
	  2 column	fixed bin,		/*[4.0-2]*/
	  2 type		fixed bin,		/*[4.0-2]*/
	  2 run		fixed bin,		/*[4.0-2]*/
	  2 number	fixed bin,		/*[4.0-2]*/
	  2 module	fixed bin;

/*[4.0-2]*/
dcl	lev_message_ptr	ptr static internal;

/*[4.0-2]*/
dcl	1 source_pos	(10),			/*[4.0-2]*/
	  2 line		fixed bin,		/*[4.0-2]*/
	  2 column	fixed bin;

/*[4.0-2]*/
dcl	(ii, num)		fixed bin,
	LEV		char (1);

/*[4.0-2]*/
dcl	lev1_org		(5) char (1) init ("0", "2", "4", "0", "0");
						/*[4.0-2]*/
dcl	lev2_org		(5) char (1) init ("3", "3", "4", "0", "5");

/*[4.0-2]*/
dcl	lev1_mod		(5) fixed bin init (15, 17, 19, 0, 25);
						/*[4.0-2]*/
dcl	lev2_mod		(5) fixed bin init (16, 18, 20, 0, 26);

get_file_key:
     entry (fnumber) returns (char (5));

/*[4.0-3]*/
declare	fnumber		fixed bin;

/*[4.0-3]*/
	return (FILE_REC_TAB.file_key (fnumber));

init_file_tab:
     entry;

/*[4.0-3]*/
	FILE_REC_TAB.file_ind = "1"b;			/*[4.0-3]*/
	FILE_REC_TAB.file_count = FILE_REC_TAB.file_count + 1;
						/*[4.0-3]*/
	FILE_REC_TAB.file_key (FILE_REC_TAB.file_count) = "";

/*[4.0-3]*/
	return;

/*[4.0-3]*/
declare	1 FILE_REC_TAB	static int,		/*[4.0-3]*/
	  2 file_count	fixed bin,		/*[4.0-3]*/
	  2 file_ind	bit (1),			/*[4,0-3]*/
	  2 file_key	(128) char (5);

/*[4.2-3]*/
declare	saved_line	fixed bin,
	saved_column	fixed bin,
	filler_flag	bit (1);

declare	cobol_imp_word$alphabet_name
			entry (ptr) returns (fixed bin);
declare	cobol_imp_word$label_name
			entry (ptr) returns (fixed bin);
declare	alf_ptr		ptr;
declare	key		fixed bin,
	int_val		fixed bin (71);
declare	(mod_num, act_num, org, TF, save_j)
			fixed bin;

declare	1 alf,
	  2 alf_size	fixed bin,
	  2 alf_key	char (5),
	  2 alf_key_ptr	ptr,
	  2 alf_status	bit (32);

declare	alf_offset	fixed bin based (alf_key_ptr);
declare	fb		fixed bin based;

declare	test_v		fixed bin;		/*store test field*/
declare	se		fixed bin;
declare	cslno		fixed bin;
declare	stack		(30) fixed bin;
declare	stack_index	fixed bin;
declare	slptr		ptr;
declare	fstatus		bit (32);			/*io return code*/
declare	bit9		bit (9);
declare	syntab_ptr	ptr;
declare	cd_out_size	fixed bin;

declare	1 indicators,
	  2 FD_indic	bit (1),
	  2 res		bit (1);

declare	1 dd_static	static internal,
	  2 save_last_line	fixed bin,
	  2 save_last_column
			fixed bin,
	  2 s_lin		fixed bin,
	  2 s_col		fixed bin;



declare	null_key		char (5) internal static init ("00000");
declare	thirty_two_zeros	bit (32) internal static init ("00000000000000000000000000000000"b);
declare	filstring_init	char (30) internal static;
declare	cobol_initstatic	entry ext;		/*initialize variables*/
declare	cobol_ddst	entry (ptr) ext;		/*initialize syntax table*/
declare	cobol_ddact1	entry (fixed bin);
declare	cobol_ddact2	entry (fixed bin);

declare	1 qual_rec	based (qual_ptr),
	  2 next		char (5),
	  2 size		fixed bin,
	  2 name		char (0 refer (qual_rec.size));

%include cobol_file_key;
declare	1 alphabet_name	based (min_ptr),
%include cobol_TYPE40;
%include cobol_ext_;

%include cobol_ext_ddsyn;
%include cobol_special_dcls;
%include cobol_spec_constants;
dcl	sv_ptr_auto	ptr;
dcl	1 shared_var	based (sv_ptr_auto),
%include cobol_shared_var;

/*[4.4-1]*/
declare	data_name_bits	bit (5000) based;

/*[4.4-1]*/
declare	hash_table	(512) ptr;

/*[4.4-1]*/
declare	ref_table		(50) ptr;

/*[4.4-1]*/
declare	1 ref		(50),			/*[4.4-1]*/
	  2 size		fixed bin,		/*[4.4-1]*/
	  2 line		fixed bin,		/*[4.4-1]*/
	  2 column	fixed bin,		/*[4.4-1]*/
	  2 type		fixed bin,		/*[4.4-1]*/
	  2 info_bit	bit (8),			/*[4.4-1]*/
	  2 length	fixed bin,		/*[4.4-1]*/
	  2 name		char (30);

/*[4.4-1]*/
declare	1 diag_token,				/*[4.4-1]*/
	  2 size		fixed bin,		/*[4.4-1]*/
	  2 line		fixed bin,		/*[4.4-1]*/
	  2 column	fixed bin,		/*[4.4-1]*/
	  2 type		fixed bin,		/*[4.4-1]*/
	  2 run		fixed bin,		/*[4.4-1]*/
	  2 num		fixed bin,		/*[4.4-1]*/
	  2 info		bit (36);

/*[4.4-1]*/
declare	(hash_table_ptr, ref_table_ptr, diag_ptr)
			ptr;			/*[4.4-1]*/
declare	(like_key, rec_key, first_key)
			char (5);

/*[4.4-1]*/
declare	(prev_rec_ptr, rec_ptr, last_rec_ptr)
			ptr;			/*[4.4-1]*/
declare	rec_size		fixed bin;		/*[4.4-1]*/
declare	(was_found, not_found, like_clause, first_rec)
			bit (1);			/*[4.4-1]*/
declare	rename_object_ptr	ptr;			/*[4.4-1]*/
declare	rename_object_size	fixed bin;		/*[4.4-1]*/
declare	(diag_no, ref_table_size)
			fixed bin (15);

/*[4.4-1]*/
declare	cobol_usrwd	entry (ptr, fixed bin (15), ptr, fixed bin (15), ptr, bit (1), bit (1), bit (1),
			fixed bin (15), ptr);

/*[4.4-1]*/
declare	status		bit (32);

dcl	bit32_1		bit (32);			/*work field for USAGE analysis*/
dcl	bit32_2		bit (32);			/*ditto*/
dcl	usage_bits_mask	bit (32) init ("00000110000000000001111111100000"b) internal static;
						/*masks out non-USAGE bits from a P7-byte-aligned substring of description bits vector*/
dcl	non_display_bits_mask
			bit (32) init ("00000110000000000000111111100000"b) internal static;
						/*usage anything but display*/
dcl	pic_suff_bits_mask	bit (32) init ("00000110000000000000000011100000"b) internal static;
						/*masks out all but picture-sufficient usage bits*/
dcl	numeric_usage_bits_mask
			bit (32) internal static init ("00000110000000000000011111000000"b);
						/*masks out all but numeric usage bits*/
dcl	based_char_string	char (11) based;		/*overlays vectemp bit structure*/
dcl	alph		char (1);			/*work field for consistency analysis*/
dcl	log_mask		(8) bit (8) internal static
			init ("10000000"b, "01000000"b, "00100000"b, "00010000"b, "00001000"b, "00000100"b,
			"00000010"b, "00000001"b);
dcl	1 matrix1		internal static,
	  2 m1		(88) bit (64)
			init ("0111111000000000000000000000000000000000000000000000000000000000"b,
			"0011110000000000000000000000000000000000000000000000000000000000"b,
			"0001110000010000000000000000000000100000000000000000000000000000"b,
			"0000110000000000000000000000000000000000000000000000000000000000"b,
			"0000010000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000110100000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000001000000000000000000000000011111000000100000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000100000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000010000000000011111111111001000000010000000000000000"b,
			"0000000000000000000000000011111111111001000000010000000000000000"b,
			"0000000000000000001010101000011011111001000000000000000000000000"b,
			"0000000000000000001010101000011011111001000000000000000000000000"b,
			"0000000000000000001111100000000000000000000000010000000000000000"b,
			"0000000000000000000111100000111111000000000000100000000000000000"b,
			"0000000000000000000011111000111111000001000000100000000000000000"b,
			"0000000000000000000001100000111111000001000000100000000000000000"b,
			"0000000000000000000000111000111111000001000000100000000000000000"b,
			"0000000000000000000000011000111111011001000000100000000000000000"b,
			"0000000000000000000000000000000000011000000000000000000000000000"b,
			"0000000000000000000000000000000000011001000000100000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000011000000000000000000000000000000"b,
			"0000000000000000000000000000111111100000000000000000000000000000"b,
			"0000000000000000000000000000011111100000000000000000000000000000"b,
			"0000000000000000000000000000001111111001000000010000000000000000"b,
			"0000000000000000000000000000000111111001000000010000000000000000"b,
			"0000000000000000000000000000000011111001000000010000000000000000"b,
			"0000000000000000000000000000000001111001000000010000000000000000"b,
			"0000000000000000000000000000000000111001000000010000000000000000"b,
			"0000000000000000000000000000000000011111000000000000000000000000"b,
			"0000000000000000000000000000000000001001000000100000000000000000"b,
			"0000000000000000000000000000000000000001100000100000000000000000"b,
			"0000000000000000000000000000000000000010000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000100000100000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000010000000000000000"b,
			"0000000000000000000000000000000000000000000000001000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b);
dcl	1 matrix2		internal static,
	  2 m2		(88) bit (64)
			init ("0000000000001000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000001000000000000000000000000000000000000000000000000"b,
			"0000000000001000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0100000000000010000000000000000000000000000000000000000000000000"b,
			"0100000000000000000000000000000000000000000000000000000000000000"b,
			"0000000001000000000000000000000000000000000000000000000000000000"b,
			"0000000000000010000000000000000000000000000000000000000000000000"b,
			"0000000000000010000000000000000000000000000000000000000000000000"b,
			"0000000000001000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000001000000000000000000000000000000000000000000000000000000"b,
			"0000000001000000000000000000000000000000000000000000000000000000"b,
			"0000000000001000000000000000000000000000000000000000000000000000"b,
			"0000000000001000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0000000010000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000010000000000000000000000000000000000000000000000000"b,
			"0000000000000010000000000000000000000000000000000000000000000000"b,
			"0000000000000010000000000000000000000000000000000000000000000000"b,
			"0000000001000000000000000000000000000000000000000000000000000000"b,
			"0000000001000000000000000000000000000000000000000000000000000000"b,
			"0000000001101000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0100000000001000000000000000000000000000000000000000000000000000"b,
			"0000000000001000000000000000000000000000000000000000000000000000"b,
			"0000000000001000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0000000010000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000001000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000100000000000000000000000000000000000000000000000000000"b,
			"0000000000000010000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000001000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b,
			"0000000000000000000000000000000000000000000000000000000000000000"b);
dcl	1 mi_overlay	based (ptr4),
	  2 mi_overlay_bit9 bit (9),
	  2 mi_overlay_part bit (128);

declare	(addr, divide, fixed, mod, null, substr, unspec, size)
			builtin;

%include cobol_non_static;
%include cobol_type9;
%include cobol_occurs;
%include cobol_fd_token;
declare	1 cdtoken		based (cdtoken_ptr),
%include cobol_TYPE13;
declare	1 fd		based,
%include cobol_TYPE12;
%include cobol_linage_rec;
%include cobol_skey_rec;
%include cobol_fixed_common;
%include cobol_file_table;
declare	1 procname	based (rec_ptr),
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin,
	  2 string_ptr	ptr,
	  2 prev_rec	ptr,
	  2 info		bit (8),
	  2 priority	char (2),
	  2 repl_bits	bit (8),
	  2 section_num	fixed bin,
	  2 proc_num	fixed bin,
	  2 def_line	fixed bin,
	  2 length	fixed bin,
	  2 name		char (30);
     end cobol_ddsyntax;




		    cobol_delete_tokens.pl1         05/24/89  1044.4rew 05/24/89  0832.7       42048



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




/****^  HISTORY COMMENTS:
  1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060),
     audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048):
     MCR8060 cobol_delete_tokens.pl1 Reformatted code to new Cobol standard.
                                                   END HISTORY COMMENTS */


/* 6/11/77, FCH, p7 code deleted, fixed bin decls standardized */



/* format: style3 */
cobol_delete_tokens:
     proc (lo, hi);


/* ========================================================================== */
/*                                                                            */
/* This routine is intended to delete tokens from the output(input) token     */
/* stack. its action is to delete only scanned elements when more than    */
/* one element is requested to be deleted.  If only one element is requested, */
/* that element will be deleted independent of element type. Its input        */
/* paramaters are ::                                                          */
/*       lo  -  starting token for the delete                            */
/*       hi  -  ending token of the delete                               */
/*                                                                            */
/* ========================================================================== */

dcl	1 token		based (cobol_current),
	  2 fwd_link	pointer,
	  2 back_link	pointer,
	  2 rep_link	pointer,
	  2 l_info	bit (8),
	  2 size		fixed bin,
	  2 line		fixed bin,
	  2 column	fixed bin,
	  2 type		fixed bin;

dcl	(lo, hi)		pointer;
dcl	(ct, p)		pointer static;
dcl	(force_sw, rtn_sw, ul_sw)
			bit (1) static;

dcl	addrel		builtin;
dcl	null		builtin;


	force_sw = "0"b;
	ul_sw = "0"b;
	goto start;

/* This entry unlinks a token from the stack, but does not FREE it. A pointer to it is returned in "lo". */

unlnk:
     entry (lo);


	ul_sw = "1"b;
	ct = cobol_current;
	goto del;

/* This entry point forces all tokens in a range to be deleted */


del_force:
     entry (lo, hi);


	force_sw = "1"b;
	ul_sw = "0"b;

start:
	ct = lo;

	if lo = null ()
	then return;				/* no tokens to delete */

	if (hi = null ()) | (lo = hi)			/* only one token to delete */
	then do;
		rtn_sw = "1"b;
		goto del;
	     end;
	else rtn_sw = "0"b;

exceptions:
	if force_sw
	then goto del;				/* if all tokens are to be deleted... */

	if (ct -> token.type = 6) | (ct -> token.type = 5)
	then do;
		if ct = hi
		then return;			/* if end of range - return */
		ct = ct -> token.fwd_link;		/* delete only scanned tokens */

		if ct = null ()
		then return;			/* if end of stack... */

		goto exceptions;
	     end;

del:
	if cobol_current = ct
	then cobol_current = ct -> token.back_link;	/* if current is being deleted, back it up */

	if ct -> token.back_link = null ()
	then do;					/* first token is being deleted */
		cobol_frst = ct -> token.fwd_link;	/* advance "frst" */

		if cobol_current = null ()
		then cobol_current = cobol_frst;	/* if backup makes current null, move it forward */
	     end;

	else ct -> token.back_link -> token.fwd_link = ct -> token.fwd_link;

/* else fix up previous tokens forward link */

	if ct -> token.fwd_link = null ()
	then cobol_top = ct -> token.back_link;

/* if last is deleted, back up "top"... */

	else ct -> token.fwd_link -> token.back_link = ct -> token.back_link;

/* else fix up next token's back link */
	p = ct -> token.fwd_link;			/* save pointer to next token */

	if ul_sw
	then do;
		lo = ct;
		ct -> token.back_link = null ();
		ct -> token.fwd_link = null ();
		return;
	     end;

	if (ct = hi) | (p = null ())
	then rtn_sw = "1"b;				/* if end of range or stack - set return */

	if ct ^= cobol_ta_ptr
	then do;

/* * * free allocated token * * */

dcl	at_st		char (1) based (ct);

		ct = addrel (ct, -1);
		at_st = "2";

	     end;

	if rtn_sw
	then return;				/* if end of range or stack - return */

	ct = p;					/* process next token */

	goto exceptions;

%include cobol_ext_lex;

     end cobol_delete_tokens;

*/
                                          -----------------------------------------------------------


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

*/
