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 */