1 
  2 /* BEGIN INCLUDE FILE ...   cobol_ciphase_data.incl.pl1 */
  3 /*        <<<       DRASTICALLY REVISED ON 12/27/76 by fch  >>>       */
  4 /* Modified on 05/06/81 by FCH, BUG482(TR9781) */
  5 
  6 dcl new_seg_bit  bit(1) ;  /*new segment allocated */
  7 
  8 
  9 
 10       dcl nu_line fixed bin ;  /*  introduce  for line  numerotation  */
 11 dcl fst bit(32) ;
 12 dcl infp ptr ;
 13 dcl outfp ptr ;    /*newioversr*/
 14 dcl on bit(1) internal static init("1"b);
 15 dcl off bit(1) internal static init("0"b);
 16 dcl ose_exists bit(1) ;
 17 dcl  (   ptr1 ptr,
 18     input_ptr ptr,output_ptr ptr ) ;
 19 dcl next_free_column fixed bin ;
 20 dcl eof bit(1) ;
 21 
 22 dcl curr_tbl_ptr ptr ;
 23 dcl curr_table(  200000    ) char(1) based(curr_tbl_ptr);  /*[4.4-1]*/
 24 dcl  curr_tbl_index fixed bin ;
 25 dcl  tbl_item_ptr ptr ;
 26 dcl (tbl_item_ptr1,tbl_item_ptr2) ptr ;
 27 
 28 dcl dir_ptr ptr;
 29 dcl 1 dir_struct  based (dir_ptr),
 30       2 dir1 (512) ,
 31           3 tbl fixed bin,
 32           3 dir fixed bin ,
 33       2 dir2 (512) ,
 34           3 tbl fixed bin,
 35           3 dir fixed bin ,
 36        2 table1 (200000) char(1),       /*[4.4-1]*/
 37        2 table2 (200000) char(1);      /*[4.4-1*/
 38 dcl curr_dir_ptr ptr ;
 39 dcl 1 curr_dir(512) based(curr_dir_ptr),
 40           2 tbl fixed bin,
 41           2 dir fixed bin ;
 42 dcl curr_dir_index fixed bin ;
 43 dcl end_dir1_index fixed bin ;
 44                     declare   (loc1 , loc2)       fixed bin;
 45 dcl (dir_ptr1,dir_ptr2) ptr ;
 46 
 47 dcl 1 stack(50) ,
 48       2 stk_to_dir fixed bin,
 49       2 level fixed bin;
 50 dcl curr_stk_index fixed bin ;
 51 
 52 dcl gen_ptr (30) ptr ;
 53 
 54 dcl 1 lc_stack(300) , /*[4.4-1]*/
 55           2 dcl_line char(4),
 56           2 dcl_col char(3) ;
 57 
 58 dcl ( i,
 59     end_i ,
 60     recv_i ,
 61     begin_i ,
 62     ose_gen_begin_i ) fixed bin ;
 63 
 64 
 65 
 66 
 67 dcl 1 key_tbl(10) internal static,
 68           2 key fixed bin     init(2,18,170,187,188,182,183,156,11,111),
 69           2 word char(9) init("add      ","move     ","to       ","(        ",")        ","+        ",
 70 "-        ","rounded  ","subtract ","from     "),
 71           2 word_length fixed bin init(4,5,3,2,2,2,2,8,9,5);
 72          /*  suppress  3  lines
 73 dcl key_index fixed bin ;
 74 dcl max_key_index fixed bin internal static init(10);
 75 dcl this_key fixed bin ;
 76                                      */
 77 dcl blank_name char(32) internal static init((32)" ");
 78 dcl (name1,name2) char(32) ;
 79 
 80 dcl curr_level fixed bin ;
 81 dcl move_swt bit(1) ;
 82 dcl add_swt bit(1) ;
 83 dcl subtract_swt bit(1) ;
 84 
 85 dcl sending_op bit(1) ;
 86 dcl no_of_subscr fixed bin ;
 87 dcl subscr_cnt fixed bin ;
 88 dcl dataname_subscr_sw bit(1) ;
 89 dcl indexname_subscr_sw bit(1) ;
 90 dcl orig_dimen fixed bin ;
 91 dcl cvbd_1 char(4) ;
 92 dcl cvindex fixed bin ;
 93 dcl cv_string char(10) ;
 94 dcl fixbin15 fixed bin ;
 95 dcl fixbin24 fixed bin(24) ;
 96 
 97 dcl null_match bit(1) ;
 98 dcl record char(4095) based;
 99 dcl record2 char(4095) based;
100 dcl any_item (300) char(1) based(input_ptr);
101           /*used to set ptr1 to array extension*/
102 
103 dcl  1  token_stack_tbl ,
104     2 token_stack (20000)  char(1);      /*[4.4-1]*/
105 dcl top_token_stack fixed bin ;
106 dcl token_stack_ptr ptr ;
107 dcl n fixed bin ;
108 dcl first_pair bit(1) ;
109 dcl (ptr2,ptr3,ptr4) ptr ;
110 dcl main_item_subscripted bit(1) ;
111 dcl subscr_dir_index fixed bin ;
112 dcl 1 subscr_directory(300) , /*[4.4-1]*/
113           2 sufx_ptr ptr,
114           2 tokn_ptr ptr,
115           2 index_ct fixed bin ;
116 dcl defaults bit(1) ;
117 dcl category fixed bin ;
118 dcl send_op_ptr ptr ;
119 dcl initlz_tbl_ptr ptr ;
120 dcl initlz_item_tbl (  200000 ) char(1) based(initlz_tbl_ptr); /*[4.4-1]*/
121 dcl table1_2_size fixed bin ;
122                     /* give max. size to stack items on table initlz_item_tbl */
123 dcl end_initlz_tbl_index fixed bin ;
124 dcl main_item_index fixed bin ;
125 dcl main_item_ptr ptr ;
126 dcl curr_dim fixed bin ;
127 dcl initlz_swt bit(1) ;
128 dcl initlz_items_allocated bit(1) ;
129  dcl save_the_key bit(1) ;
130      dcl nt_key char(5);
131      dcl save_key char(5);
132 dcl gen_item_allocated bit(1) ;
133 dcl alloc_seg fixed bin ;
134 dcl alloc_offset fixed bin(24) ;
135 
136 
137 
138 dcl code fixed bin ;
139 dcl nxt fixed bin internal static init(0),
140     bos fixed bin internal static init(1),
141     eos fixed bin internal static init(2);
142 
143 dcl lk_ahd_ptr(2) ptr ;       /* used to store ON,ON SIZE if not ON SIZE ERROR */
144 dcl lk_ahd_index fixed bin ;
145 
146 /* used to initialize label array in corr_in */
147 
148 /* interface between err_pro and callers */
149 dcl recov bit(1) ;
150 dcl err_num fixed bin ;
151 dcl err_image char(60) ;
152 dcl poss_prior_err bit(1) ;
153 dcl err_image_length fixed bin ;
154 
155 /* interface between corr and source_gen */
156 dcl set_new_col bit(1) ;
157          /*   suppress  2  lines
158 dcl this_word char(32) ;
159 dcl this_word_length fixed bin ;
160                                        */
161 
162 /*interface between err_pro and corr_in*/
163 dcl recovering bit(1) ;
164 
165 dcl without_on_bit  bit(1) ;  /*  bit  add  for  syntax  ON SIZE ERROR  without  ON  */
166 dcl xst fixed bin ;        /*  add for same above */
167 
168 dcl recursive_bit bit(1) ;  /*  bit  added  for  recursive  syntax  on  ADD  or  SUBTRACT  */
169 dcl relecture bit(1) ;                  /*  add for recursive array in INITIALIZE  */
170 
171 dcl array_init_bit bit(1) ;   /*  add for INITIALIZE all array  */
172 dcl n_array fixed bin ;
173 dcl second_time bit(1) ;
174 dcl fixbin_diff bit(1) ;
175 
176 /* END INCLUDE FILE ...   cobol_ciphase_data.incl.pl1 */
177