COMPILATION LISTING OF SEGMENT merge_return Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/11/82 1229.4 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 /* Modified on 01/25/82 by FCH, [1], delete variable initial list */ 11 12 return: proc(retp,retbl,ec); 13 /* EXTERNAL ENTRIES */ 14 /* EXTERNAL STATIC */ 15 1 1 dcl 1 sort_ext$acl(1) ext, 1 2 2 x_user_id char(32), 1 3 2 x_modes bit(36), 1 4 2 x_pad bit(36), 1 5 2 x_acl_code fixed bin(35); 1 6 dcl 1 acl(1) 1 7 defined(sort_ext$acl), 1 8 2 user_id char(32), 1 9 2 modes bit(36), 1 10 2 pad bit(36), 1 11 2 acl_code fixed bin(35); 1 12 dcl sort_ext$b(0: 31) fixed bin(30) ext; /* keys - bit offset (usually) for sort_comp */ 1 13 dcl b(0: 31) fixed bin(30) 1 14 defined (sort_ext$b); 1 15 dcl sort_ext$compares_counter fixed bin(34) ext; /* compares executed, excluding sequence checker */ 1 16 dcl compares_counter fixed bin(34) 1 17 defined(sort_ext$compares_counter); 1 18 dcl sort_ext$compare_sw fixed bin(1) ext; /* 1 = user compare exit specified */ 1 19 dcl compare_sw fixed bin(1) 1 20 defined (sort_ext$compare_sw); 1 21 dcl sort_ext$curr_input_file_attach char(256) ext; /* attach description, current input file (Sort) */ 1 22 dcl curr_input_file_attach char(256) 1 23 defined(sort_ext$curr_input_file_attach); 1 24 dcl sort_ext$curr_input_file_name char(256) ext; /* pathname, current input file (Sort) */ 1 25 dcl curr_input_file_name char(256) 1 26 defined (sort_ext$curr_input_file_name); 1 27 dcl sort_ext$curr_input_file_num fixed bin(17) ext; /* number for current input file (Sort) */ 1 28 dcl curr_input_file_num fixed bin(17) 1 29 defined (sort_ext$curr_input_file_num); 1 30 dcl sort_ext$curr_output_file_attach char(256) ext; /* attach description, output file */ 1 31 dcl curr_output_file_attach char(256) 1 32 defined(sort_ext$curr_output_file_attach); 1 33 dcl sort_ext$curr_output_file_name char(256) ext; /* pathname, output file */ 1 34 dcl curr_output_file_name char(256) 1 35 defined (sort_ext$curr_output_file_name); 1 36 dcl sort_ext$debug_sw bit(1) ext; /* 1 = -debug argument specified */ 1 37 dcl debug_sw bit(1) 1 38 defined(sort_ext$debug_sw); 1 39 dcl sort_ext$disaster2 fixed bin(17) ext; /* 0 = first call to sort_return or merge_return */ 1 40 dcl disaster2 fixed bin(17) 1 41 defined (sort_ext$disaster2); 1 42 dcl sort_ext$dt(0: 31) fixed bin(30) ext; /* keys - datatype for sort_comp */ 1 43 dcl dt(0: 31) fixed bin(30) 1 44 defined (sort_ext$dt); 1 45 dcl sort_ext$input_driver_is_sort bit(1) ext; /* 1 = Sort reads input files, 0 = input_file exit */ 1 46 dcl input_driver_is_sort bit(1) 1 47 defined(sort_ext$input_driver_is_sort); 1 48 dcl sort_ext$input_file_exit_sw bit(1) ext; /* 1 = user input_file exit specified */ 1 49 dcl input_file_exit_sw bit(1) 1 50 defined(sort_ext$input_file_exit_sw); 1 51 dcl sort_ext$input_file_max fixed bin(17) ext; /* number of input files specified [init(10)] */ 1 52 /* must also change merge_return: merge_read_count & input_file_len */ 1 53 dcl input_file_max fixed bin(17) 1 54 defined(sort_ext$input_file_max); 1 55 dcl sort_ext$input_record_exit_sw fixed bin(1) ext; /* 1 = user input_record exit specified */ 1 56 dcl input_record_exit_sw fixed bin(1) 1 57 defined(sort_ext$input_record_exit_sw); 1 58 dcl sort_ext$input_rec_deleted fixed bin(30) ext; /* number of records deleted at input_record exit */ 1 59 dcl input_rec_deleted fixed bin(30) 1 60 defined(sort_ext$input_rec_deleted); 1 61 dcl sort_ext$input_rec_inserted fixed bin(30) ext; /* number of records inserted _record exit */ 1 62 dcl input_rec_inserted fixed bin(30) 1 63 defined(sort_ext$input_rec_inserted); 1 64 dcl sort_ext$in_buff_ptr ptr ext; /* buffer for an input record (Sort or Merge reading) */ 1 65 dcl in_buff_ptr ptr 1 66 defined (sort_ext$in_buff_ptr); 1 67 dcl sort_ext$leng(0: 31) fixed bin(30) ext; /* keys - length or precision for sort_comp */ 1 68 dcl leng(0: 31) fixed bin(30) 1 69 defined (sort_ext$leng); 1 70 dcl sort_ext$max1 fixed bin(30) ext; /* limits size of unsorted string SS (sort_release) */ 1 71 dcl max1 fixed bin(30) 1 72 defined (sort_ext$max1); 1 73 dcl sort_ext$max2 fixed bin(30) ext; /* limits size of unsorted string SS (sort_release) */ 1 74 dcl max2 fixed bin(30) 1 75 defined (sort_ext$max2); 1 76 dcl sort_ext$max3 fixed bin(30) ext; /* maximum number of records per string SS */ 1 77 dcl max3 fixed bin(30) 1 78 defined (sort_ext$max3); 1 79 dcl sort_ext$max4 fixed bin(30) ext; /* maximum merge order allowed (sort_presort) */ 1 80 dcl max4 fixed bin(30) 1 81 defined (sort_ext$max4); 1 82 dcl sort_ext$max_rec_length fixed bin(30) ext; /* maximum record length permitted by Sort or Merge; */ 1 83 /* slightly less than sys_info$max_seg_size */ 1 84 dcl max_rec_length fixed bin(30) 1 85 defined (sort_ext$max_rec_length); 1 86 dcl sort_ext$merge_compares fixed bin(34) ext; /* number of compares in merge */ 1 87 dcl merge_compares fixed bin(34) 1 88 defined(sort_ext$merge_compares); 1 89 dcl sort_ext$merge_in_iocb_ptrs(10) ptr ext; /* iox_ iocb's for Merge input files */ 1 90 dcl merge_in_iocb_ptrs(10) ptr 1 91 defined(sort_ext$merge_in_iocb_ptrs); 1 92 dcl sort_ext$merge_input_file_attaches(10) char(256) ext; /* attach descriptions, Merge input files */ 1 93 dcl merge_input_file_attaches(10) char(256) 1 94 defined(sort_ext$merge_input_file_attaches); 1 95 dcl sort_ext$merge_input_file_names(10) char(256) ext; /* pathnames, Merge input files */ 1 96 dcl merge_input_file_names(10) char(256) 1 97 defined(sort_ext$merge_input_file_names); 1 98 dcl sort_ext$mii fixed bin(17) ext; /* merge order for Sort [init(0)] */ 1 99 dcl mii fixed bin(17) 1 100 defined (sort_ext$mii); 1 101 dcl sort_ext$min_rec_length fixed bin(30) ext; /* record length required to include all key fields */ 1 102 dcl min_rec_length fixed bin(30) 1 103 defined (sort_ext$min_rec_length); 1 104 dcl sort_ext$mip (1000) fixed bin(30) ext; /* number of records in each string MS for merge */ 1 105 dcl mip (1000) fixed bin(30) 1 106 defined (sort_ext$mip); 1 107 dcl sort_ext$msp (1000) ptr ext; /* sorted strings MS(1:mii) to be merged */ 1 108 dcl msp (1000) ptr 1 109 defined (sort_ext$msp); 1 110 dcl sort_ext$no_of_keys fixed bin(30) ext; /* number of keys specified */ 1 111 dcl no_of_keys fixed bin(30) 1 112 defined(sort_ext$no_of_keys); 1 113 dcl sort_ext$old_input_file_num fixed bin(17) ext; /* used for identifying files with bad key data */ 1 114 dcl old_input_file_num fixed bin(17) /* (illegal_procedure handler in sort_presort) */ 1 115 defined(sort_ext$old_input_file_num); 1 116 dcl sort_ext$output_driver_is_sort bit(1) ext; /* 1 = Sort or Merge writes output file; */ 1 117 dcl output_driver_is_sort bit(1) /* 0 = output_file exit */ 1 118 defined(sort_ext$output_driver_is_sort); 1 119 dcl sort_ext$output_file_exit_sw bit(1) ext; /* 1 = user output_file exit specified */ 1 120 dcl output_file_exit_sw bit(1) 1 121 defined(sort_ext$output_file_exit_sw); 1 122 dcl sort_ext$output_rec_deleted fixed bin(30) ext; /* number of records deleted at output_record exit */ 1 123 dcl output_rec_deleted fixed bin(30) 1 124 defined(sort_ext$output_rec_deleted); 1 125 dcl sort_ext$output_rec_inserted fixed bin(30) ext; /* number of record inserted at output_record exit */ 1 126 dcl output_rec_inserted fixed bin(30) 1 127 defined(sort_ext$output_rec_inserted); 1 128 dcl sort_ext$output_record_exit_sw fixed bin(1) ext; /* 1 = user output_record exit specified */ 1 129 dcl output_record_exit_sw fixed bin(1) 1 130 defined(sort_ext$output_record_exit_sw); 1 131 dcl sort_ext$presort_compares fixed bin(34) ext; /* number of compares in presort */ 1 132 dcl presort_compares fixed bin(34) 1 133 defined(sort_ext$presort_compares); 1 134 dcl 1 sort_ext$pu(5) ext, 1 135 2 x_n fixed bin, /* [init((5) 1)] */ 1 136 2 x_rcpu fixed bin(71); 1 137 dcl 1 pu(5) 1 138 defined(sort_ext$pu), 1 139 2 n fixed bin, 1 140 2 rcpu fixed bin(71); 1 141 dcl sort_ext$read_count fixed bin(30) ext; /* number of records read by Sort (or by Merge) */ 1 142 dcl read_count fixed bin(30) 1 143 defined (sort_ext$read_count); 1 144 dcl sort_ext$rec_ptr_a ptr ext; /* buffer for output_record exit and sequence checker */ 1 145 dcl rec_ptr_a ptr 1 146 defined(sort_ext$rec_ptr_a); 1 147 dcl sort_ext$rec_ptr_b ptr ext; /* buffer for output_record exit and sequence checker */ 1 148 dcl rec_ptr_b ptr 1 149 defined(sort_ext$rec_ptr_b); 1 150 dcl sort_ext$release_count fixed bin(30) ext; /* number of records released to Sort (Merge) */ 1 151 dcl release_count fixed bin(30) 1 152 defined (sort_ext$release_count); 1 153 dcl sort_ext$report_sw bit(2) ext; /* 00 = print summary report, 01 = suppress */ 1 154 dcl report_sw bit(2) 1 155 defined (sort_ext$report_sw); 1 156 dcl sort_ext$return_count fixed bin(30) ext; /* number of records returned from Sort (Merge) */ 1 157 dcl return_count fixed bin(30) 1 158 defined (sort_ext$return_count); 1 159 dcl sort_ext$rev(0: 31) fixed bin(1) ext; /* keys - descending indicator for sort_comp */ 1 160 dcl rev(0: 31) fixed bin(1) 1 161 defined (sort_ext$rev); 1 162 dcl sort_ext$sii fixed bin(30) ext; /* number of records, current string (sort_release) */ 1 163 dcl sii fixed bin(30) 1 164 defined (sort_ext$sii); 1 165 dcl sort_ext$sip ptr ext; /* SI - tree of indices (subscripts) for records */ 1 166 dcl sip ptr /* being sorted or merged */ 1 167 defined (sort_ext$sip); 1 168 dcl sort_ext$sort_compare_exit variable /* entry point, user compare exit procedure */ 1 169 entry(ptr, ptr) returns(fixed bin(1)) ext; 1 170 dcl sort_ext$sort_desc_pn char(168) ext; /* pathname, Sort (Merge) Description segment */ 1 171 dcl sort_desc_pn char(168) 1 172 defined(sort_ext$sort_desc_pn); 1 173 dcl sort_ext$sort_input_record_exit variable /* entry point, user input_record exit procedure */ 1 174 entry(ptr, fixed bin(21), fixed bin, bit(1)) ext; 1 175 dcl sort_input_record_exit variable 1 176 entry(ptr, fixed bin(21), fixed bin, bit(1)) 1 177 defined(sort_ext$sort_input_record_exit); 1 178 dcl sort_ext$sort_output_record_exit variable /* entry point, user output_record exit procedure */ 1 179 entry(ptr, fixed bin(21), ptr, fixed bin(21), fixed bin, fixed bin(1), bit(1), bit(1), bit(1)) ext; 1 180 dcl sort_output_record_exit variable 1 181 entry(ptr, fixed bin(21), ptr, fixed bin(21), fixed bin, fixed bin(1), bit(1), bit(1), bit(1)) 1 182 defined(sort_ext$sort_output_record_exit); 1 183 dcl sort_ext$srp ptr ext; /* SR - position and length of each record */ 1 184 dcl srp ptr /* in SS string for presort */ 1 185 defined (sort_ext$srp); 1 186 dcl sort_ext$ssi fixed bin(30) ext; /* char offset in SS of current record (sort_release) */ 1 187 dcl ssi fixed bin(30) 1 188 defined (sort_ext$ssi); 1 189 dcl sort_ext$ssp ptr ext; /* SS - unsorted string during presort */ 1 190 dcl ssp ptr 1 191 defined (sort_ext$ssp); 1 192 dcl sort_ext$state fixed bin(17) ext; /* state variable controlling sequence of calls to */ 1 193 dcl state fixed bin(17) /* the various stages of the Sort (Merge) [init(0)] */ 1 194 defined (sort_ext$state); 1 195 dcl sort_ext$terminate_print_sw bit(1) ext; /* 0 = command prints (sort_merge_print_report) */ 1 196 dcl terminate_print_sw bit(1) /* 1 = subroutine prints (sort_merge_terminate) */ 1 197 defined (sort_ext$terminate_print_sw); 1 198 dcl 1 sort_ext$time_info(5) ext, /* used for -time information */ 1 199 2 x_etime fixed bin(71), 1 200 2 x_vtime fixed bin(71), 1 201 2 x_pf fixed bin, 1 202 2 x_pd_f fixed bin; 1 203 dcl 1 time_info(5) 1 204 defined(sort_ext$time_info), 1 205 2 etime fixed bin(71), 1 206 2 vtime fixed bin(71), 1 207 2 pf fixed bin, 1 208 2 pd_f fixed bin; 1 209 dcl sort_ext$time_sw bit(1) ext; /* 1 = -time argument specified */ 1 210 dcl time_sw bit(1) 1 211 defined(sort_ext$time_sw); 1 212 dcl sort_ext$user_out_sw char(32) ext; /* I/O switch for summary report, diagnostics: */ 1 213 dcl user_out_sw char(32) /* "user_output", "" = suppress, other = user switch */ 1 214 defined(sort_ext$user_out_sw); 1 215 dcl sort_ext$unique_prefix char(16) ext; /* unique to each invocation, for temporary names */ 1 216 dcl unique_prefix char(16) 1 217 defined (sort_ext$unique_prefix); /* -4- */ 1 218 dcl sort_ext$w(0: 31) fixed bin(30) ext; /* keys - word (sometimes char) offset for sort_comp */ 1 219 dcl w(0: 31) fixed bin(30) 1 220 defined (sort_ext$w); 1 221 dcl sort_ext$wf_dir_name char(168) aligned ext; /* -td directory pathname argument */ 1 222 dcl wf_dir_name char(168) aligned 1 223 defined(sort_ext$wf_dir_name); 1 224 dcl sort_ext$wf_full_name char(168) ext; /* absolute -td directory pathname */ 1 225 dcl wf_full_name char(168) 1 226 defined (sort_ext$wf_full_name); /* -42- */ 1 227 dcl sort_ext$whoami char(6) ext; /* "sort", "merge", "sort_", "merge_" called */ 1 228 dcl whoami char(6) 1 229 defined (sort_ext$whoami); /* -2- */ 1 230 dcl sort_ext$write_count fixed bin(30) ext; /* number of records written by Sort (Merge) */ 1 231 dcl write_count fixed bin(30) 1 232 defined (sort_ext$write_count); 16 17 dcl error_table_$data_gain fixed bin(35) ext, 18 error_table_$data_loss fixed bin(35) ext, 19 error_table_$out_of_sequence fixed bin(35) ext, 20 error_table_$data_seq_error fixed bin(35) ext, 21 error_table_$end_of_info fixed bin(35) ext, 22 error_table_$long_record fixed bin(35) ext, 23 error_table_$short_record fixed bin(35) ext, 24 error_table_$fatal_error fixed bin(35) ext, 25 error_table_$request_not_recognized fixed bin(35) ext, 26 error_table_$improper_data_format fixed bin(35) ext; 27 /* PARAMETERS,AUTOMATIC, & BASED */ 28 dcl merge_read_count(10) fixed bin(30) int static; /* read count of each file */ 29 dcl (retp ptr, 30 retbl fixed bin(21)) parameter; 31 dcl 32 (ns,np) fixed bin(30) int static, 33 s(36) static, 34 retfb fixed bin(30); 35 dcl i1 fixed bin(30); 36 dcl 1 IN(127 * 1024) based, 37 2 ctr fixed bin(30), /* serial record count */ 38 2 by_off fixed bin(30); /* byte offset of current record */ 39 dcl (t,n,v1,v2,l,x,j,y,lft,rit,i) fixed bin(30) int static; 2 1 dcl result fixed bin(1); /* result of compare procedure (Sort's or user's) */ 2 2 2 3 dcl I (255*1024) fixed bin(30) based, /* an array, which when based upon sip (presort) 2 4* contain entries which are indexes to rows in R table */ 2 5 /* when based upon mip (merge) each row contains the 2 6* number of records in each merge string */ 2 7 1 R (85*1024) based, /* 85 = 255/3 */ 2 8 2 pt fixed bin(30), /* references the first character in the S string 2 9* of each record */ 2 10 2 ln fixed bin(30); /* references the number of characters in each 2 11* record of the S string */ 2 12 dcl S char(255*4096) based, /* string of presort records */ 2 13 S1(255*4096) char(1) based; /* used in adjusting pointers */ 2 14 dcl ec fixed bin(35) parameter, 2 15 pt1 ptr, 2 16 pt2 ptr, 2 17 w_p ptr int static, 2 18 fb fixed bin(21) based(w_p); 40 41 42 dcl retval fixed bin(35); 43 /* following declarations are for output record exit */ 44 dcl hold_ptr ptr int static, 45 hold_len fixed bin(21) int static, 46 s_retp ptr int static, 47 s_retbl fixed bin(21) int static, 48 rec_ptr_2 ptr int static, /* next record pointer */ 49 rec_len_2 fixed bin(21) int static, /* next record length */ 50 u_rec_ptr_2 ptr int static, /* rec_ptr_2 handed to the user */ 51 u_rec_len_2 fixed bin(21) int static, /* rec_len_2 handed to the user */ 52 action fixed bin int static, /* action code */ 53 equal_key fixed bin(1) int static, 54 seq_check_sw bit(1) int static, 55 close_exit_sw bit(1) int static, 56 cur_rec_ptr ptr int static, /* current record pointer */ 57 area_len fixed bin(21) int static, /* current record length */ 58 equal_key_sw bit(1) int static, 59 old_retp ptr int static; /* old retp pointer */ 60 dcl old_rec_ptr ptr int static; /* previous record for sequence checker */ 61 /* Following inserted for merge */ 62 dcl in_attach_desc char(176), 63 in_switch char(32), 64 in_switch_length fixed bin(17), 65 iox_code fixed bin(35), 66 in_mode fixed bin init(4), 67 no_extend bit(1) aligned init("0"b); 68 dcl input_file_len(10) fixed bin(21) int static, /* record length of each file */ 69 /*1*/ in_buff_len fixed bin(21) ; 70 dcl hold_cur_rec_ptr ptr int static, /* hold ptr to current record in sort's area */ 71 hold_area_len fixed bin(17) int static; /* hold length of current record */ 72 dcl iox_$attach_ioname entry(char(*), ptr, char(*), fixed bin(35)); 73 dcl iox_$open entry(ptr, fixed bin, bit(1) aligned, fixed bin(35)); 74 dcl iox_$read_record entry(ptr, ptr, fixed bin(21), fixed bin(21), fixed bin(35)); 75 dcl iox_$close entry(ptr, fixed bin(35)); 76 dcl iox_$detach_iocb entry(ptr, fixed bin(35)); 77 dcl iox_$destroy_iocb entry(ptr, fixed bin(35)); 78 79 dcl establish_cleanup_proc_ entry(entry); 80 dcl sub_err_ entry options(variable); 81 dcl ioa_$rsnnl entry options(variable); 82 83 /*1*/ in_buff_len = max_rec_length; /* maximum record length */ 84 ec = 0; /* initially set error code */ 85 /* test state code */ 86 if state ^= 5 then /* sequence error */ 87 do; 88 ec = error_table_$out_of_sequence; 89 return; 90 end; 91 on illegal_procedure call illegal_procedure_handler; 92 if disaster2 = 0 then do; /* Initial call to RETURN. */ 93 disaster2 = 1; 94 old_rec_ptr=null(); /* set initially for sequence check previous record */ 95 /* following set for output record exit */ 96 equal_key_sw="0"b; 97 equal_key=1; 98 seq_check_sw="1"b; 99 action=10; 100 if mii = 0 then 101 do; /* no records released */ 102 ec = error_table_$end_of_info; 103 if output_record_exit_sw = 0 then return; 104 else do; /* prepare to take exit */ 105 retp=null(); 106 go to in; 107 end; 108 end; 109 call A0; 110 return_count = return_count + 1; 111 go to rel_ck; 112 end; 113 114 g_a_w: if output_record_exit_sw ^= 0 & action = 3 | action = 11 then 115 do; /* output rec sw on and just completed inserting a record */ 116 if old_retp = rec_ptr_b /* just returned current was in rec_ptr_b */ 117 then cur_rec_ptr=rec_ptr_a; /* set new current area to rec_ptr_a */ 118 else cur_rec_ptr=rec_ptr_b; /* just returned current was in rec_ptr_1- 119* set new current area to rec_ptr_b */ 120 substr(cur_rec_ptr->S,1,u_rec_len_2)=substr(u_rec_ptr_2->S,1,u_rec_len_2); 121 area_len=u_rec_len_2; /* move just inserted record into current area */ 122 if action=11 then ec=error_table_$end_of_info; 123 /* just inserted a record at end of file-reset ec */ 124 rec_ptr_2=hold_ptr; /* move previous next record into current next */ 125 rec_len_2=hold_len; 126 old_rec_ptr=msp(v1); /* save winner area ptr */ 127 msp(v1)=msp(mii+1); /* replace winner ptr with spare ptr */ 128 msp(mii+1)=old_rec_ptr; /* replace spare ptr with winner ptr */ 129 output_rec_inserted=output_rec_inserted+1; 130 go to in; /* transfer to point where exit routine is called-after determining new winner*/ 131 end; 132 if output_record_exit_sw^=0 & action=error_table_$end_of_info 133 then go to in; /* just wrote last record */ 134 if mii=1 then 135 do; /* single merge input file */ 136 /* read another record from winner merge file */ 137 call iox_$read_record(merge_in_iocb_ptrs(1),msp(1),in_buff_len,input_file_len(1),iox_code); 138 if iox_code = error_table_$end_of_info then /* end_of file- */ 139 do; /* end of file, close-detach-destroy iocb ponter */ 140 /* Close */ 141 close: call iox_$close(merge_in_iocb_ptrs(1), iox_code); 142 if iox_code ^= 0 then 143 do; 144 /* error_table_$not_open */ 145 call iox_error("Closing",1); 146 end; 147 148 /* Detach */ 149 call iox_$detach_iocb(merge_in_iocb_ptrs(1), iox_code); 150 if iox_code ^= 0 then 151 do; 152 /* error_table_$not_attached, 153* $not_closed */ 154 call iox_error("Detaching",1); 155 end; 156 157 /* Destroy iocb */ 158 call iox_$destroy_iocb(merge_in_iocb_ptrs(1), iox_code); 159 merge_in_iocb_ptrs(1) = null(); 160 /* no errors returned? */ 161 ec=error_table_$end_of_info; 162 read_count=merge_read_count(1); /* set read count */ 163 goto rel_ck; 164 end; 165 else if iox_code ^= 0 then 166 call iox_error("Reading",1); 167 else do; /* record successfully read */ 168 merge_read_count(1)=merge_read_count(1)+1; /* increment read count */ 169 release_count=release_count+1; 170 w_p=ptr(msp(1),fixed(rel(msp(1)),21)-1); /* move back 1 word 171* to set length */ 172 fb=input_file_len(1); 173 retbl=fb; /* set winner length */ 174 retp=msp(1); /* set return pointer to record(winner) just read */ 175 end; 176 return_count=return_count+1; 177 go to rel_ck; 178 end; 179 180 /* Multiple merge strings. */ 181 call A2; 182 call A1; 183 return_count = return_count + 1; 184 rel_ck: if release_count < return_count then 185 do; /* data gain test */ 186 if ec=error_table_$end_of_info then return; /* already at end of info */ 187 ec=error_table_$data_gain; 188 return; 189 end; 190 in:; 191 /* following code is for output record exit routine */ 192 if output_record_exit_sw ^= 0 then 193 do; /* take output record exit */ 194 if action = error_table_$end_of_info then 195 do; /* just wrote last record */ 196 ec=error_table_$end_of_info; /* reset error code */ 197 return; 198 end; 199 if action ^= 3 then 200 do; /* just got winner record */ 201 /* save winner record pointer */ 202 s_retp=retp; 203 s_retbl=retbl; 204 end; 205 if action=10 then 206 do; /* indicating first time through-no curent record,no previously 207* written record */ 208 rec_ptr_2=retp; /* set up next record-to winner */ 209 rec_len_2=retbl; 210 cur_rec_ptr=null(); /* set current record ptr to null */ 211 ent: action=0; 212 if ec=error_table_$end_of_info then rec_ptr_2=null(); 213 /* deleted every successive record of the file */ 214 u_rec_ptr_2=rec_ptr_2; /* set user's next pointer and next length */ 215 u_rec_len_2=rec_len_2; 216 if close_exit_sw="0"b then 217 call sort_output_record_exit(cur_rec_ptr,area_len,u_rec_ptr_2,u_rec_len_2, 218 action,equal_key,equal_key_sw,seq_check_sw,close_exit_sw); 219 old_retp=null(); /* to indicate,next time through,that there is no previous record- 220* therefore no sequence check */ 221 if action=3 then 222 do; /* insert record at beginning of file */ 223 call ck_len(u_rec_len_2,"inserted"); /* check returned record length */ 224 cur_rec_ptr=rec_ptr_b; /* arbitrarily set to b */ 225 substr(cur_rec_ptr->S,1,u_rec_len_2)=substr(u_rec_ptr_2->S,1,u_rec_len_2); 226 /* set up current record */ 227 area_len=u_rec_len_2; 228 rec_ptr_2=retp; /* reset next reocrd to same-previous next record */ 229 rec_len_2=retbl; 230 output_rec_inserted=output_rec_inserted+1; 231 go to in; /* don't write current record-rather go back & call exit */ 232 end; 233 if ec = error_table_$end_of_info then action=ec; 234 /* deleted the entire file */ 235 msp(v1)=msp(mii+1); /* replace winner buffer pointer */ 236 msp(mii+1)=retp; /* replace spare buffer ptr with winner ptr */ 237 go to g_a_w; 238 end; 239 if action= 0 then 240 do; /* just completed accepting record */ 241 if old_retp=rec_ptr_b /* just returned current was in rec_ptr_b */ 242 then cur_rec_ptr=rec_ptr_a; /* set new current area to rec_ptr_a */ 243 else cur_rec_ptr=rec_ptr_b; /* set new current area to rec_ptr_b */ 244 substr(cur_rec_ptr->S,1,rec_len_2)=substr(rec_ptr_2->S,1,rec_len_2); 245 /* move previous next record into current area */ 246 area_len=rec_len_2; 247 rec_ptr_2=retp; /* set up new next record */ 248 rec_len_2=retbl; 249 end; 250 else if action=1 then 251 do; /* just completed deleting the current record */ 252 substr(cur_rec_ptr->S,1,rec_len_2)=substr(rec_ptr_2->S,1,rec_len_2); 253 /* move old next record into current record area */ 254 area_len=rec_len_2; 255 rec_ptr_2=retp; /* set up new next record */ 256 rec_len_2=retbl; 257 output_rec_deleted=output_rec_deleted+1; 258 end; 259 else if action=2 then 260 do; /* just completed deleting next record-leave old current record alone */ 261 rec_ptr_2=retp; /* set up new next record */ 262 rec_len_2=retbl; 263 output_rec_deleted=output_rec_deleted+1; 264 if cur_rec_ptr=null() then go to ent; /* just deleted first record(of the file) */ 265 end; 266 else if ^(action=11 | action=3) then 267 do; /* illegal action code */ 268 call sub_err_(error_table_$request_not_recognized,whoami, "c", null(), retval, 269 "Invalid action = ^d by user output_record exit procedure.",action ); 270 ec=error_table_$fatal_error; 271 goto exit; 272 end; 273 action=0; /* set here in case close exit is on */ 274 if close_exit_sw="1"b then go to sim; /* close exit switch is on */ 275 if ec=error_table_$end_of_info then rec_ptr_2=null(); /* no next rec-end of info */ 276 if equal_key_sw="1"b then /* equal key swtich on */ 277 do; /* check for equal keys between current and next */ 278 pt1=cur_rec_ptr; /* current record */ 279 pt2=rec_ptr_2; /* next record */ 280 if pt1^=null() & pt2^= null() then 281 call sort_comp; /* invoke sort's comparison routine */ 282 equal_key=result; 283 end; 284 u_rec_ptr_2=rec_ptr_2; /* set user's next pointer and next length */ 285 u_rec_len_2=rec_len_2; 286 hold_cur_rec_ptr=cur_rec_ptr; /* save pointer to current record */ 287 hold_area_len=area_len; /* dave length of current record */ 288 call sort_output_record_exit(cur_rec_ptr,area_len,u_rec_ptr_2,u_rec_len_2, 289 action,equal_key,equal_key_sw,seq_check_sw,close_exit_sw); 290 if action ^= 1 & cur_rec_ptr ^= hold_cur_rec_ptr then 291 do; /* move record pointed to by user ptr into sort's area */ 292 substr(hold_cur_rec_ptr->S,1,area_len)=substr(cur_rec_ptr->S,1,area_len); 293 cur_rec_ptr=hold_cur_rec_ptr; /* restore cur_rec_ptr to user area */ 294 end; 295 if action=1 | action=2 then 296 do; /* delete current or next record */ 297 /* don't return a record back to sort_output */ 298 /* rather go back and get anther winner */ 299 /* don't perform sequence check */ 300 if ec=error_table_$end_of_info then /* no more records-simply */ 301 do; /* return after incrementing deletion count */ 302 output_rec_deleted=output_rec_deleted+1; 303 return; 304 end; 305 if action=1 then 306 do; /* deleting current record */ 307 msp(v1)=msp(mii+1); /* replace winner buffer ptr with spare ptr */ 308 msp(mii+1)=rec_ptr_2; /* preserve next record pointer */ 309 cur_rec_ptr=hold_cur_rec_ptr; /* restore held value of cur_rec_ptr */ 310 area_len=hold_area_len; /* restore area len */ 311 end; 312 if action=2 then call ck_len(area_len,"summarized"); /* check returned current record len */ 313 goto g_a_w; /* transfer to get another winner */ 314 end; 315 sim: if action=0 then 316 do; /* accept current record */ 317 call ck_len(area_len,"altered"); /* check returned current rec length */ 318 retp=cur_rec_ptr; /* set record return pointer to current record */ 319 retbl=area_len; 320 end; 321 else if action=3 then 322 do; /* insert record pointed to by rec_ptr_2-next record */ 323 call ck_len(u_rec_len_2,"inserted"); /* check length of record to be inserted */ 324 call ck_len(area_len,"altered"); /* check returned current record length */ 325 hold_ptr=s_retp; /* save old next pointer */ 326 hold_len=s_retbl; 327 retp=cur_rec_ptr; /* set return record to current record */ 328 retbl=area_len; 329 end; 330 else 331 do; /* illegal action code */ 332 call sub_err_(error_table_$request_not_recognized,whoami, "c", null(), retval, 333 "Invalid action = ^d by user output_record exit procedure.",action); 334 ec=error_table_$fatal_error; 335 goto exit; 336 end; 337 if ec=error_table_$end_of_info then 338 do; /* no more records to be read */ 339 if action ^= 3 then 340 do; /* no record to be inserted */ 341 ec=0; /* reset ec so that sort_output will write record */ 342 /* retp should already be set */ 343 action=error_table_$end_of_info; /* set to indicate,on next time 344* through, no records left */ 345 end; 346 else do; /* insert record at end of file-in rec_ptr_2 */ 347 /* action=s 3 */ 348 ec=0; /* reset so that sort_output will write current record */ 349 action=11; /* indicating no more records to be read */ 350 end; 351 v1=mii; /* in case of multiple merge strings-an extra pass will be made 352* through A2 and A! */ 353 end; 354 if seq_check_sw="1"b & old_retp^=null() then 355 /* seq bit on and a previously written record */ 356 do; /* perform sequence check-between current and record previously written- 357* cur_rec_ptr and rec_ptr_a or rec_ptr_b */ 358 if retp=rec_ptr_a 359 then pt1=rec_ptr_b; /* previous record is in rec_ptr_b */ 360 else pt1=rec_ptr_a; /* previous record is in rec_ptr_a */ 361 pt2=retp; /* current record */ 362 call sort_comp; 363 if result= 1 then ec=error_table_$data_seq_error; /* out of sequence-fatal error */ 364 end; 365 old_rec_ptr=msp(v1); /* temporarily save winner ptr */ 366 msp(v1)=msp(mii+1); /* replace winner buffer pointer with spare */ 367 msp(mii+1)=old_rec_ptr; /* replace spare ptr with winner ptr */ 368 con: old_retp=retp; /* set so that,on next time through,can distinguish which 369* record pointer was used */ 370 return; 371 end; /* end sort output record exit code */ 372 if return_count=0 then return; /* null output file-no sequence check */ 373 /* following is sequence checker */ 374 if return_count=1 | ec=error_table_$end_of_info then 375 do; /* set up initially for sequence check */ 376 msp(v1)=msp(mii+1); /* replace winner buffer pointer with extra buffer ptr */ 377 msp(mii+1)=retp; /* replace miith ptr with winner area pointer */ 378 end; 379 else do; 380 pt1=msp(mii+1); /* set previous record pointer */ 381 pt2=retp; /* set current record pointer */ 382 call sort_comp; /* perform sequence check */ 383 if result=1 then ec=error_table_$data_seq_error; /* sequence error */ 384 msp(v1)=msp(mii+1);/* replace winner buffer pointer */ 385 msp(mii+1)=retp; /* replace miith ptr with winner area ptr */ 386 end; 387 exit: return; 388 389 A0: proc; 390 if mii=1 then /* single merge input file */ 391 do; 392 call init_return; /* get first winner */ 393 if merge_read_count(1)=0 then /* a single null input file */ 394 do; 395 ec=error_table_$end_of_info; 396 goto rel_ck; 397 end; 398 retp=msp(1); /* set winner pointer */ 399 retbl=fb; /* set winner length */ 400 v1=1; /* set for use in sequence checker */ 401 return; 402 end; 403 404 do i = 1 to mii; /* Set indices for merge. */ 405 sip -> I (i) = i; /* sets ups I array */ 406 end; 407 408 /* 409* calculate the lengths of 410* lists and their start pointers 411* in a linear set. 412* */ 413 t = 0; 414 l = mii; /* number of merge srings */ 415 do n = 1 by 1 while (l>1); 416 s (n) = t; /* start of the next list. */ 417 if substr(unspec(l),36,1) then 418 do; /* l odd */ 419 l = l+1; /* make the length even */ 420 sip->I(t+l) = 0; /* clear 2nd word of pair if l was odd */ 421 end; 422 t = t+l; /* accumulate the lengths. */ 423 l = divide(l,2,24); 424 end; 425 n = n-1; 426 call init_return; /* call. proc which will read first record of each merge file, 427* along with firstly attaching,opening, etc. */ 428 429 /* Set s(n) to (one more than) the index to the list 430* for the final 2 records to be compared. */ 431 /* below rearranges I array to reflect sorted records(the first record of each merge 432* string being looked at) */ 433 do i = 2 to n; 434 lft = s (i-1); 435 rit = s (i) ; 436 do j = 1 by 2 to (rit - lft); 437 x = lft+j; 438 v1 = sip -> I (x); /* indices in I(sip) */ 439 v2 = sip -> I (x+1); 440 if v1=0 then v1=v2; /* no first record */ 441 else if v2>0 then 442 do; 443 pt1=msp(v1); 444 pt2=msp(v2); 445 call sort_comp; 446 compares_counter=compares_counter+1; 447 if result=0 then /* rec0rds ranked equal */ 448 do; 449 if v1I(rit)=v1; 457 end; 458 end; 459 i = s (n)+2; 460 461 y = s (n)+1; 462 call A1; 463 return; 464 init_return: proc; 465 dcl i fixed bin(30); 466 467 do i = 1 to mii; 468 merge_read_count(i)=0; /* initialize read count for ith file */ 469 call ioa_$rsnnl(unique_prefix || "sort_in_^d_",in_switch,in_switch_length,i); 470 /* converts from fixed bin to character srtring */ 471 if merge_input_file_attaches(i) = "" 472 then in_attach_desc="vfile_ "||merge_input_file_names(i); 473 else in_attach_desc=merge_input_file_attaches(i); 474 call iox_$attach_ioname(in_switch,merge_in_iocb_ptrs(i),in_attach_desc,iox_code); 475 if iox_code ^= 0 then 476 call iox_error("Attaching",i); 477 call iox_$open(merge_in_iocb_ptrs(i),in_mode,no_extend,iox_code); 478 if iox_code ^= 0 then 479 call iox_error("Opening",i); 480 /* read in first record of each file */ 481 call iox_$read_record(merge_in_iocb_ptrs(i),msp(i),in_buff_len, 482 input_file_len(i),iox_code); 483 if iox_code = error_table_$end_of_info then /* end_of file- */ 484 do; /* end of file, close-detach-destroy iocb ponter */ 485 /* Close */ 486 close: call iox_$close(merge_in_iocb_ptrs(i), iox_code); 487 if iox_code ^= 0 then 488 do; 489 /* error_table_$not_open */ 490 call iox_error("Closing",i); 491 end; 492 493 /* Detach */ 494 call iox_$detach_iocb(merge_in_iocb_ptrs(i), iox_code); 495 if iox_code ^= 0 then 496 do; 497 /* error_table_$not_attached, 498* $not_closed */ 499 call iox_error("Detaching",i); 500 end; 501 502 /* Destroy iocb */ 503 call iox_$destroy_iocb(merge_in_iocb_ptrs(i), iox_code); 504 merge_in_iocb_ptrs(i) = null(); 505 /* no errors returned? */ 506 sip->I(i) = 0; 507 goto con; 508 end; 509 if iox_code ^= 0 then 510 call iox_error("Reading",i); 511 if input_file_len(i)>max_rec_length then iox_code=error_table_$long_record; 512 else if input_file_len(i) I (y); 538 v2 = sip -> I (y+1); 539 if v1 ^= 0 then; 540 else if v2 ^= 0 then; 541 else do; 542 /* data lost test */ 543 if release_count > return_count 544 then ec = error_table_$data_loss; 545 else 546 ec = error_table_$end_of_info; 547 return_count=return_count-1; /* pre-adjust return_count */ 548 do i=1 to mii; 549 read_count=merge_read_count(i)+read_count; /* summarize read count */ 550 end; 551 return; 552 end; 553 if v1 = 0 then do; 554 v1 = v2; 555 end; 556 else 557 if v2>0 then do; 558 /* below sets up pointers to records within S string */ 559 pt1 = msp(v1); 560 pt2 = msp(v2); 561 call sort_comp; 562 compares_counter=compares_counter+1; 563 if result = 0 then /* records ranked equal */ 564 do; 565 if v1 < v2 /* compare merge string numbers */ 566 then result = -1; /* rank record 1 first */ 567 else result = 1; /* rank record 2 first */ 568 end; 569 570 if result = 1 then do; /* second record first */ 571 v1 = v2; 572 end; 573 end; 574 retp=msp(v1); 575 retbl=input_file_len(v1); /* set elngth */ 576 return; 577 end A1; 578 A2: proc; 579 /* read another record from winner merge file */ 580 call iox_$read_record(merge_in_iocb_ptrs(v1),msp(v1),in_buff_len,input_file_len(v1),iox_code); 581 if iox_code = error_table_$end_of_info then /* end_of file- */ 582 do; /* end of file, close-detach-destroy iocb ponter */ 583 /* Close */ 584 close: call iox_$close(merge_in_iocb_ptrs(v1), iox_code); 585 if iox_code ^= 0 then 586 do; 587 /* error_table_$not_open */ 588 call iox_error("Closing",v1); 589 end; 590 591 /* Detach */ 592 call iox_$detach_iocb(merge_in_iocb_ptrs(v1), iox_code); 593 if iox_code ^= 0 then 594 do; 595 /* error_table_$not_attached, 596* $not_closed */ 597 call iox_error("Detaching",v1); 598 end; 599 600 /* Destroy iocb */ 601 call iox_$destroy_iocb(merge_in_iocb_ptrs(v1), iox_code); 602 merge_in_iocb_ptrs(v1) = null(); 603 /* no errors returned? */ 604 sip->I(v1) = 0; 605 end; 606 else if iox_code ^= 0 then 607 call iox_error("Reading",v1); 608 else do; /* record successfully read */ 609 if input_file_len(v1)>max_rec_length then iox_code=error_table_$long_record; 610 else if input_file_len(v1) I (v1+lft); 635 v2 = sip -> I (v2+lft); 636 if v1 = 0 then v1 = v2; 637 else 638 if v2>0 then do; 639 /* below sets up pointers to records within S string */ 640 pt1=msp(v1); 641 pt2=msp(v2); 642 call sort_comp; 643 compares_counter=compares_counter+1; 644 if result = 0 then /* records ranked equal */ 645 do; 646 if v1 < v2 /* compare merge string numbers */ 647 then result = -1; /* rank record 1 first */ 648 else result = 1; /* rank record 2 first */ 649 end; 650 if result = 1 then v1 = v2; /* record 2 ranks first-switch order */ 651 end; 652 sip -> I (x+s (j)) = v1; 653 v1 = x; 654 end; 655 end A2; 3 1 sort_comp: proc; 3 2 /* sort's standard comparison routine */ 3 3 dcl b_str bit(32000) based, /* used for bit string data type */ 3 4 fb1(0:32000) fixed bin(35) based, /* used for bin, aligned, size = 36 bits-1 word */ 3 5 fb2(0:32000) fixed bin(71) based, /* used for bin, aligned, size = 72 bits-2 words */ 3 6 (work_1,work_2) fixed bin(71),/* used for bin unaligned */ 3 7 flb1(0:32000) float bin(27) based, /* used for float bin, aligned, size = 36 bits-1 word */ 3 8 flb2(0:32000) float bin(63) based, /* used for float bin, aligned, size = 72 bits-2 words */ 3 9 (work_3,work_4) float bin(63) aligned, /* used for float bin,unaligned */ 3 10 (work_5,work_6) dec(59), /* used for decimal */ 3 11 (work_7,work_8) float dec(59); /* floating decimal-taking 61 bytes */ 3 12 dcl dec_char char(61) based aligned, 3 13 dec_ptr1 ptr, 3 14 dec_ptr2 ptr; 3 15 dcl dec_ptr3 ptr, 3 16 dec_ptr4 ptr; 3 17 if compare_sw ^= 0 then 3 18 do; /* invoke user's compare routine */ 3 19 result = sort_ext$sort_compare_exit(pt1,pt2); 3 20 if result ^= 0 then go to con; 3 21 end; 3 22 else do; 3 23 do i1 = 0 to no_of_keys; 3 24 go to lab(dt(i1)); 3 25 lab(1): /* data type = char */ 3 26 if substr(pt1->S,b(i1),leng(i1))< 3 27 substr(pt2->S,b(i1),leng(i1)) 3 28 then result = -1; /* record 1 ranks first */ 3 29 else if substr(pt1->S,b(i1),leng(i1))> 3 30 substr(pt2->S,b(i1),leng(i1)) 3 31 then result = 1; 3 32 else go to next_key; 3 33 go to esc; 3 34 lab(2): /* data type = bit */ 3 35 if substr(pt1->b_str,b(i1),leng(i1)) < 3 36 substr(pt2->b_str,b(i1),leng(i1)) 3 37 then result = -1; 3 38 else if substr(pt1->b_str,b(i1),leng(i1)) > 3 39 substr(pt2->b_str,b(i1),leng(i1)) 3 40 then result = 1; /* record 2 ranks first */ 3 41 else go to next_key; 3 42 go to esc; 3 43 lab(3): /* data type = binary-aligned-size= 1 word */ 3 44 if pt1->fb1(w(i1)) < 3 45 pt2->fb1(w(i1)) 3 46 then result = -1; /* record 1 ranks first */ 3 47 else if pt1->fb1(w(i1))> 3 48 pt2->fb1(w(i1)) 3 49 then result = 1; /* record 2 ranks first */ 3 50 else go to next_key; 3 51 go to esc; 3 52 lab(4): /* data type = binary-aligned-size = 2 words */ 3 53 if pt1->fb2(w(i1)) < 3 54 pt2->fb2(w(i1)) 3 55 then result = -1; /* record 1 ranks first */ 3 56 else if pt1->fb2(w(i1)) > 3 57 pt2->fb2(w(i1)) 3 58 then result = 1; /* record 2 ranks first */ 3 59 else go to next_key; 3 60 go to esc; 3 61 lab(5): /* data type = binary-unaligned: 1<= len <= 71 */ 3 62 work_1 = 0; 3 63 work_2 = 0; /* 0 out work areas */ 3 64 substr(unspec(work_1),1,leng(i1)+1)=substr(pt1->b_str,b(i1),leng(i1)+1); 3 65 /* move unaligned bit string into aligned work field */ 3 66 substr(unspec(work_2),1,leng(i1)+1)=substr(pt2->b_str,b(i1),leng(i1)+1); 3 67 if work_1 < work_2 then result = -1; /* record 1 ranks first */ 3 68 else if work_1 > work_2 then result = 1; /* record 2 ranks first */ 3 69 else go to next_key; 3 70 go to esc; 3 71 lab(6): /* data type = floating bin-aligned,size = 1 word */ 3 72 if pt1->flb1(w(i1)) < 3 73 pt2->flb1(w(i1)) 3 74 then result = -1; /* record 1 ranks first */ 3 75 else if pt1->flb1(w(i1)) > 3 76 pt2->flb1(w(i1)) 3 77 then result = 1; /* record 2 ranks first */ 3 78 else go to next_key; 3 79 go to esc; 3 80 lab(7): /* data type = floating bin - aligned, size = 2 words */ 3 81 if pt1->flb2(w(i1)) < 3 82 pt2->flb2(w(i1)) 3 83 then result = -1; /* record 1 ranks first */ 3 84 else if pt1->flb2(w(i1)) > 3 85 pt2->flb2(w(i1)) 3 86 then result = 1; /* record 2 ranks first */ 3 87 else go to next_key; 3 88 go to esc; 3 89 lab(8): /* data type = floating bin-unaligned */ 3 90 work_3 = 0; 3 91 work_4 = 0; /* 0 out work areas */ 3 92 substr(unspec(work_3),1,leng(i1)+9)=substr(pt1->b_str,b(i1),leng(i1)+9); 3 93 substr(unspec(work_4),1,leng(i1)+9)=substr(pt2->b_str,b(i1),leng(i1)+9); 3 94 /* move unaligned bit string into aligned work field */ 3 95 if work_3 < work_4 then result = -1; /* recordnks first */ 3 96 else if work_3 > work_4 then result = 1; /* record 2 ranks first */ 3 97 else go to next_key; 3 98 go to esc; 3 99 lab(9): /* data type = decimal */ 3 100 work_5 = 0; 3 101 dec_ptr3 = addr(work_5); 3 102 work_6 = 0; /* 0 out work areas */ 3 103 dec_ptr4 = addr(work_6); 3 104 substr(dec_ptr3->dec_char,1,leng(i1)+1)=substr(pt1->S,b(i1),leng(i1)+1); 3 105 substr(dec_ptr4->dec_char,1,leng(i1)+1)=substr(pt2->S,b(i1),leng(i1)+1); 3 106 /* move decimal field into work field */ 3 107 if work_5 < work_6 then result = -1; /* record 1 ranks first */ 3 108 else if work_5 > work_6 then result = 1; /* record 2 ranks first */ 3 109 else go to next_key; 3 110 go to esc; 3 111 lab(10): /* data type = floating decimal */ 3 112 work_7 = 0; 3 113 dec_ptr1 = addr(work_7); 3 114 work_8 = 0; /* 0 out work areas */ 3 115 dec_ptr2 = addr(work_8); 3 116 substr(dec_ptr1->dec_char,1,leng(i1)+1)=substr(pt1->S,b(i1),leng(i1)+1); 3 117 substr(dec_ptr2->dec_char,1,leng(i1)+1)=substr(pt2->S,b(i1),leng(i1)+1); 3 118 /* move sign and digits into work areas */ 3 119 substr(dec_ptr1->dec_char,61,1)=substr(pt1->S,leng(i1)+1+b(i1),1); 3 120 substr(dec_ptr2->dec_char,61,1)=substr(pt2->S,leng(i1)+1+b(i1),1); 3 121 /* move exponent portion into work field */ 3 122 if work_7 < work_8 then result = -1; /* record 1 ranks first */ 3 123 else if work_7 > work_8 then result = 1; /* record 2 ranks first */ 3 124 else go to next_key; 3 125 go to esc; 3 126 next_key: end; /* ends do loop */ 3 127 result = 0; /* all keys equal */ 3 128 return; 3 129 esc: if rev(i1) ^= 0 then result = -result; /* reverse ranking */ 3 130 con: end; /* ends sort's comparison routine */ 3 131 end sort_comp; 656 657 ck_len: proc(length,action_type); 658 /* this will be called from output record exit-its function is to 659* check the length passed to it against max record length and 660* return the appropriate error code */ 661 /* */ 662 dcl length fixed bin(21) parameter, 663 action_type char(*) parameter, 664 sub_err_ entry options(variable); 665 if length > max_rec_length then 666 do; /* record too long */ 667 call sub_err_(error_table_$long_record,whoami, "c", null(), retval, 668 "Record ^a by user output_record exit procedure.", 669 action_type); 670 ec=error_table_$fatal_error; 671 go to exit; 672 end; 673 end ck_len; 674 dcl illegal_procedure condition; 675 676 illegal_procedure_handler: proc; 677 dcl key_part char(40), 678 type char(10), 679 file char(20), 680 file_part char(168), 681 len fixed bin(17); 682 if compare_sw = 1 then key_part = "user compare exit procedure"; 683 else do; 684 if dt(i1) = 9 then type = "dec"; 685 else if dt(i1) = 10 then type = "float dec"; 686 else type = "unknown"; 687 call ioa_$rsnnl("key ^d, ^a(^d) ^d(^d)", key_part, len, 688 i1 + 1, type, leng(i1), w(i1), mod(b(i1) - 1, 4)*9); 689 end; 690 if input_driver_is_sort = "1"b then do; 691 call sub_err_(error_table_$improper_data_format, whoami, "c", null(), retval, 692 " Invalid key data. Please check ^a and/or input files ^d and ^d.", 693 key_part, v1, v2); 694 end; 695 else do; /* user input_file exit procedure */ 696 call sub_err_(error_table_$improper_data_format, whoami, "c", null(), retval, 697 " Invalid key data. Please check ^a and/or user input_file exit procedure.", 698 key_part); 699 end; 700 ec = error_table_$fatal_error; 701 go to exit; 702 end illegal_procedure_handler; 703 iox_error: proc(action,index); 704 dcl action char(*) parameter, 705 index fixed bin(30) parameter; 706 ec = error_table_$fatal_error; 707 if merge_input_file_attaches(index) = "" then 708 call sub_err_(iox_code, whoami, "c", null(), retval, 709 "^a input file ^d, file name ^a", 710 action,index,merge_input_file_names(index)); 711 else call sub_err_(iox_code, whoami, "c", null(), retval, 712 "^a input file ^d, attach description ^a", 713 action,index,merge_input_file_attaches(index)); 714 go to exit; 715 end iox_error; 716 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/82 1024.6 merge_return.pl1 >spec>on>11/11/82>merge_return.pl1 16 1 12/20/77 1614.2 sort_ext.incl.pl1 >ldd>include>sort_ext.incl.pl1 40 2 04/26/76 1500.0 sort_common.incl.pl1 >ldd>include>sort_common.incl.pl1 656 3 04/26/76 1448.1 sort_comp.incl.pl1 >ldd>include>sort_comp.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. I based fixed bin(30,0) array dcl 2-3 set ref 405* 420* 438 439 456* 506* 537 538 604* 634 635 652* S based char(1044480) unaligned dcl 2-12 set ref 120* 120 225* 225 244* 244 252* 252 292* 292 3-25 3-25 3-29 3-29 3-104 3-105 3-116 3-117 3-119 3-120 action 000123 internal static fixed bin(17,0) dcl 44 in procedure "return" set ref 99* 114 114 122 132 194 199 205 211* 216* 221 233* 239 250 259 266 266 268* 273* 288* 290 295 295 305 312 315 321 332* 339 343* 349* action parameter char unaligned dcl 704 in procedure "iox_error" set ref 703 707* 711* action_type parameter char unaligned dcl 662 set ref 657 667* area_len 000132 internal static fixed bin(21,0) dcl 44 set ref 121* 216* 227* 246* 254* 287 288* 292 292 310* 312* 317* 319 324* 328 b defined fixed bin(30,0) array dcl 1-13 ref 3-25 3-25 3-29 3-29 3-34 3-34 3-38 3-38 3-64 3-66 3-92 3-93 3-104 3-105 3-116 3-117 3-119 3-120 687 b_str based bit(32000) unaligned dcl 3-3 ref 3-34 3-34 3-38 3-38 3-64 3-66 3-92 3-93 close_exit_sw 000126 internal static bit(1) unaligned dcl 44 set ref 216 216* 274 288* compare_sw defined fixed bin(1,0) dcl 1-19 ref 3-17 682 compares_counter defined fixed bin(34,0) dcl 1-16 set ref 446* 446 562* 562 643* 643 cur_rec_ptr 000130 internal static pointer dcl 44 set ref 116* 118* 120 210* 216* 224* 225 241* 243* 244 252 264 278 286 288* 290 292 293* 309* 318 327 dec_char based char(61) dcl 3-12 set ref 3-104* 3-105* 3-116* 3-117* 3-119* 3-120* dec_ptr1 000364 automatic pointer dcl 3-12 set ref 3-113* 3-116 3-119 dec_ptr2 000366 automatic pointer dcl 3-12 set ref 3-115* 3-117 3-120 dec_ptr3 000370 automatic pointer dcl 3-15 set ref 3-101* 3-104 dec_ptr4 000372 automatic pointer dcl 3-15 set ref 3-103* 3-105 disaster2 defined fixed bin(17,0) dcl 1-40 set ref 92 93* dt defined fixed bin(30,0) array dcl 1-43 ref 3-24 684 685 ec parameter fixed bin(35,0) dcl 2-14 set ref 12 84* 88* 102* 122* 161* 186 187* 196* 212 233 233 270* 275 300 334* 337 341* 348* 363* 374 383* 395* 523* 543* 545* 621* 670* 700* 706* equal_key 000124 internal static fixed bin(1,0) dcl 44 set ref 97* 216* 282* 288* equal_key_sw 000133 internal static bit(1) unaligned dcl 44 set ref 96* 216* 276 288* error_table_$data_gain 000254 external static fixed bin(35,0) dcl 17 ref 187 error_table_$data_loss 000256 external static fixed bin(35,0) dcl 17 ref 543 error_table_$data_seq_error 000262 external static fixed bin(35,0) dcl 17 ref 363 383 error_table_$end_of_info 000264 external static fixed bin(35,0) dcl 17 ref 102 122 132 138 161 186 194 196 212 233 275 300 337 343 374 395 483 545 581 error_table_$fatal_error 000272 external static fixed bin(35,0) dcl 17 ref 270 334 523 621 670 700 706 error_table_$improper_data_format 000276 external static fixed bin(35,0) dcl 17 set ref 691* 696* error_table_$long_record 000266 external static fixed bin(35,0) dcl 17 set ref 511 609 667* error_table_$out_of_sequence 000260 external static fixed bin(35,0) dcl 17 ref 88 error_table_$request_not_recognized 000274 external static fixed bin(35,0) dcl 17 set ref 268* 332* error_table_$short_record 000270 external static fixed bin(35,0) dcl 17 ref 512 610 fb based fixed bin(21,0) dcl 2-14 set ref 172* 173 399 530* 628* fb1 based fixed bin(35,0) array dcl 3-3 ref 3-43 3-43 3-47 3-47 fb2 based fixed bin(71,0) array dcl 3-3 ref 3-52 3-52 3-56 3-56 flb1 based float bin(27) array dcl 3-3 ref 3-71 3-71 3-75 3-75 flb2 based float bin(63) array dcl 3-3 ref 3-80 3-80 3-84 3-84 hold_area_len 000154 internal static fixed bin(17,0) dcl 70 set ref 287* 310 hold_cur_rec_ptr 000152 internal static pointer dcl 70 set ref 286* 290 292 293 309 hold_len 000106 internal static fixed bin(21,0) dcl 44 set ref 125 326* hold_ptr 000104 internal static pointer dcl 44 set ref 124 325* i 000100 internal static fixed bin(30,0) dcl 39 in procedure "return" set ref 404* 405 405* 433* 434 435* 459* 548* 549* i 000226 automatic fixed bin(30,0) dcl 465 in procedure "init_return" set ref 467* 468 469* 471 471 473 474 475* 477 478* 481 481 481 486 490* 494 499* 503 504 506 509* 511 512 515 515 515* 515 519 519* 519 526 528 528 530* i1 000100 automatic fixed bin(30,0) dcl 35 set ref 3-23* 3-24 3-25 3-25 3-25 3-25 3-29 3-29 3-29 3-29 3-34 3-34 3-34 3-34 3-38 3-38 3-38 3-38 3-43 3-43 3-47 3-47 3-52 3-52 3-56 3-56 3-64 3-64 3-64 3-66 3-66 3-66 3-71 3-71 3-75 3-75 3-80 3-80 3-84 3-84 3-92 3-92 3-92 3-93 3-93 3-93 3-104 3-104 3-104 3-105 3-105 3-105 3-116 3-116 3-116 3-117 3-117 3-117 3-119 3-119 3-120 3-120* 3-129 684 685 687 687 687 687 illegal_procedure 000200 stack reference condition dcl 674 ref 91 in_attach_desc 000107 automatic char(176) unaligned dcl 62 set ref 471* 473* 474* in_buff_len 000177 automatic fixed bin(21,0) dcl 68 set ref 83* 137* 481* 580* in_mode 000175 automatic fixed bin(17,0) initial dcl 62 set ref 62* 477* in_switch 000163 automatic char(32) unaligned dcl 62 set ref 469* 474* in_switch_length 000173 automatic fixed bin(17,0) dcl 62 set ref 469* index parameter fixed bin(30,0) dcl 704 set ref 703 707 707* 707 711* 711 input_driver_is_sort defined bit(1) unaligned dcl 1-46 ref 690 input_file_len 000140 internal static fixed bin(21,0) array dcl 68 set ref 137* 172 481* 511 512 530 575 580* 609 610 628 ioa_$rsnnl 000316 constant entry external dcl 81 ref 469 687 iox_$attach_ioname 000300 constant entry external dcl 72 ref 474 iox_$close 000306 constant entry external dcl 75 ref 141 486 584 iox_$destroy_iocb 000312 constant entry external dcl 77 ref 158 503 601 iox_$detach_iocb 000310 constant entry external dcl 76 ref 149 494 592 iox_$open 000302 constant entry external dcl 73 ref 477 iox_$read_record 000304 constant entry external dcl 74 ref 137 481 580 iox_code 000174 automatic fixed bin(35,0) dcl 62 set ref 137* 138 141* 142 149* 150 158* 165 474* 475 477* 478 481* 483 486* 487 494* 495 503* 509 511* 512* 513 515* 519* 522* 580* 581 584* 585 592* 593 601* 606 609* 610* 611 613* 617* 620* 707* 711* j 000074 internal static fixed bin(30,0) dcl 39 set ref 436* 437* 630* 631 652* key_part 000106 automatic char(40) unaligned dcl 677 set ref 682* 687* 691* 696* l 000072 internal static fixed bin(30,0) dcl 39 set ref 414* 415 417 419* 419 420 422 423* 423 len 000123 automatic fixed bin(17,0) dcl 677 set ref 687* leng defined fixed bin(30,0) array dcl 1-68 set ref 3-25 3-25 3-29 3-29 3-34 3-34 3-38 3-38 3-64 3-64 3-66 3-66 3-92 3-92 3-93 3-93 3-104 3-104 3-105 3-105 3-116 3-116 3-117 3-117 3-119 3-120 687* length parameter fixed bin(21,0) dcl 662 ref 657 665 lft 000076 internal static fixed bin(30,0) dcl 39 set ref 434* 436 437 631* 634 635 max_rec_length defined fixed bin(30,0) dcl 1-84 ref 83 511 609 665 merge_in_iocb_ptrs defined pointer array dcl 1-90 set ref 137* 141* 149* 158* 159* 474* 477* 481* 486* 494* 503* 504* 580* 584* 592* 601* 602* merge_input_file_attaches defined char(256) array unaligned dcl 1-93 set ref 471 473 515 519* 613 617* 707 711* merge_input_file_names defined char(256) array unaligned dcl 1-96 set ref 471 515* 613* 707* merge_read_count 000010 internal static fixed bin(30,0) array dcl 28 set ref 162 168* 168 393 468* 515* 519* 526* 549 613* 617* 624* 624 mii defined fixed bin(17,0) dcl 1-99 ref 100 127 128 134 235 236 307 308 351 366 367 376 377 380 384 385 390 404 414 467 548 min_rec_length defined fixed bin(30,0) dcl 1-102 ref 512 610 msp defined pointer array dcl 1-108 set ref 126 127* 127 128* 137* 170 170 174 235* 235 236* 307* 307 308* 365 366* 366 367* 376* 376 377* 380 384* 384 385* 398 443 444 481* 528 528 559 560 574 580* 626 626 640 641 n 000067 internal static fixed bin(30,0) dcl 39 set ref 415* 416* 425* 425 433 459 461 630 no_extend 000176 automatic bit(1) initial dcl 62 set ref 62* 477* no_of_keys defined fixed bin(30,0) dcl 1-111 ref 3-23 old_rec_ptr 000136 internal static pointer dcl 60 set ref 94* 126* 128 365* 367 old_retp 000134 internal static pointer dcl 44 set ref 116 219* 241 354 368* output_rec_deleted defined fixed bin(30,0) dcl 1-123 set ref 257* 257 263* 263 302* 302 output_rec_inserted defined fixed bin(30,0) dcl 1-126 set ref 129* 129 230* 230 output_record_exit_sw defined fixed bin(1,0) dcl 1-129 ref 103 114 132 192 pt1 000102 automatic pointer dcl 2-14 set ref 278* 280 358* 360* 380* 443* 559* 640* 3-19* 3-25 3-29 3-34 3-38 3-43 3-47 3-52 3-56 3-64 3-71 3-75 3-80 3-84 3-92 3-104 3-116 3-119 pt2 000104 automatic pointer dcl 2-14 set ref 279* 280 361* 381* 444* 560* 641* 3-19* 3-25 3-29 3-34 3-38 3-43 3-47 3-52 3-56 3-66 3-71 3-75 3-80 3-84 3-93 3-105 3-117 3-120 read_count defined fixed bin(30,0) dcl 1-142 set ref 162* 549* 549 rec_len_2 000116 internal static fixed bin(21,0) dcl 44 set ref 125* 209* 215 229* 244 244 246 248* 252 252 254 256* 262* 285 rec_ptr_2 000114 internal static pointer dcl 44 set ref 124* 208* 212* 214 228* 244 247* 252 255* 261* 275* 279 284 308 rec_ptr_a defined pointer dcl 1-145 ref 116 241 358 360 rec_ptr_b defined pointer dcl 1-148 ref 116 118 224 241 243 358 release_count defined fixed bin(30,0) dcl 1-151 set ref 169* 169 184 527* 527 543 625* 625 result 000101 automatic fixed bin(1,0) dcl 2-1 set ref 282 363 383 447 449* 451* 453 563 565* 567* 570 644 646* 648* 650 3-19* 3-20 3-25* 3-29* 3-34* 3-38* 3-43* 3-47* 3-52* 3-56* 3-67* 3-68* 3-71* 3-75* 3-80* 3-84* 3-95* 3-96* 3-107* 3-108* 3-122* 3-123* 3-127* 3-129* 3-129 retbl parameter fixed bin(21,0) dcl 29 set ref 12 173* 203 209 229 248 256 262 319* 328* 399* 575* retp parameter pointer dcl 29 set ref 12 105* 174* 202 208 228 236 247 255 261 318* 327* 358 361 368 377 381 385 398* 574* return_count defined fixed bin(30,0) dcl 1-157 set ref 110* 110 176* 176 183* 183 184 372 374 543 547* 547 retval 000106 automatic fixed bin(35,0) dcl 42 set ref 268* 332* 515* 519* 613* 617* 667* 691* 696* 707* 711* rev defined fixed bin(1,0) array dcl 1-160 ref 3-129 rit 000077 internal static fixed bin(30,0) dcl 39 set ref 435* 436 455* 455 456 s 000022 internal static fixed bin(17,0) array dcl 31 set ref 416* 434 435 459 461 631 652 s_retbl 000112 internal static fixed bin(21,0) dcl 44 set ref 203* 326 s_retp 000110 internal static pointer dcl 44 set ref 202* 325 seq_check_sw 000125 internal static bit(1) unaligned dcl 44 set ref 98* 216* 288* 354 sip defined pointer dcl 1-166 ref 405 420 438 439 456 506 537 538 604 634 635 652 sort_ext$b 000156 external static fixed bin(30,0) array dcl 1-12 ref 3-25 3-25 3-25 3-25 3-29 3-29 3-29 3-29 3-34 3-34 3-34 3-34 3-38 3-38 3-38 3-38 3-64 3-64 3-66 3-66 3-92 3-92 3-93 3-93 3-104 3-104 3-105 3-105 3-116 3-116 3-117 3-117 3-119 3-119 3-120 3-120 687 687 sort_ext$compare_sw 000162 external static fixed bin(1,0) dcl 1-18 ref 3-17 3-17 682 682 sort_ext$compares_counter 000160 external static fixed bin(34,0) dcl 1-15 set ref 446* 446 446 446 562* 562 562 562 643* 643 643 643 sort_ext$disaster2 000164 external static fixed bin(17,0) dcl 1-39 set ref 92 92 93* 93 sort_ext$dt 000166 external static fixed bin(30,0) array dcl 1-42 ref 3-24 3-24 684 684 685 685 sort_ext$input_driver_is_sort 000170 external static bit(1) unaligned dcl 1-45 ref 690 690 sort_ext$leng 000172 external static fixed bin(30,0) array dcl 1-67 ref 3-25 3-25 3-25 3-25 3-29 3-29 3-29 3-29 3-34 3-34 3-34 3-34 3-38 3-38 3-38 3-38 3-64 3-64 3-64 3-64 3-66 3-66 3-66 3-66 3-92 3-92 3-92 3-92 3-93 3-93 3-93 3-93 3-104 3-104 3-104 3-104 3-105 3-105 3-105 3-105 3-116 3-116 3-116 3-116 3-117 3-117 3-117 3-117 3-119 3-119 3-120 3-120 687 687 sort_ext$max_rec_length 000174 external static fixed bin(30,0) dcl 1-82 ref 83 83 511 511 609 609 665 665 sort_ext$merge_in_iocb_ptrs 000176 external static pointer array dcl 1-89 set ref 137 137 141 141 149 149 158 158 159* 159 474 474 477 477 481 481 486 486 494 494 503 503 504* 504 580 580 584 584 592 592 601 601 602* 602 sort_ext$merge_input_file_attaches 000200 external static char(256) array unaligned dcl 1-92 ref 471 471 473 473 515 515 519 519 613 613 617 617 707 707 711 711 sort_ext$merge_input_file_names 000202 external static char(256) array unaligned dcl 1-95 ref 471 471 515 515 613 613 707 707 sort_ext$mii 000204 external static fixed bin(17,0) dcl 1-98 ref 100 100 127 127 128 128 134 134 235 235 236 236 307 307 308 308 351 351 366 366 367 367 376 376 377 377 380 380 384 384 385 385 390 390 404 404 414 414 467 467 548 548 sort_ext$min_rec_length 000206 external static fixed bin(30,0) dcl 1-101 ref 512 512 610 610 sort_ext$msp 000210 external static pointer array dcl 1-107 set ref 126 126 127* 127 127 127 128* 128 137 137 170 170 170 170 174 174 235* 235 235 235 236* 236 307* 307 307 307 308* 308 365 365 366* 366 366 366 367* 367 376* 376 376 376 377* 377 380 380 384* 384 384 384 385* 385 398 398 443 443 444 444 481 481 528 528 528 528 559 559 560 560 574 574 580 580 626 626 626 626 640 640 641 641 sort_ext$no_of_keys 000212 external static fixed bin(30,0) dcl 1-110 ref 3-23 3-23 sort_ext$output_rec_deleted 000214 external static fixed bin(30,0) dcl 1-122 set ref 257* 257 257 257 263* 263 263 263 302* 302 302 302 sort_ext$output_rec_inserted 000216 external static fixed bin(30,0) dcl 1-125 set ref 129* 129 129 129 230* 230 230 230 sort_ext$output_record_exit_sw 000220 external static fixed bin(1,0) dcl 1-128 ref 103 103 114 114 132 132 192 192 sort_ext$read_count 000222 external static fixed bin(30,0) dcl 1-141 set ref 162* 162 549* 549 549 549 sort_ext$rec_ptr_a 000224 external static pointer dcl 1-144 ref 116 116 241 241 358 358 360 360 sort_ext$rec_ptr_b 000226 external static pointer dcl 1-147 ref 116 116 118 118 224 224 241 241 243 243 358 358 sort_ext$release_count 000230 external static fixed bin(30,0) dcl 1-150 set ref 169* 169 169 169 184 184 527* 527 527 527 543 543 625* 625 625 625 sort_ext$return_count 000232 external static fixed bin(30,0) dcl 1-156 set ref 110* 110 110 110 176* 176 176 176 183* 183 183 183 184 184 372 372 374 374 543 543 547* 547 547 547 sort_ext$rev 000234 external static fixed bin(1,0) array dcl 1-159 ref 3-129 3-129 sort_ext$sip 000236 external static pointer dcl 1-165 ref 405 405 420 420 438 438 439 439 456 456 506 506 537 537 538 538 604 604 634 634 635 635 652 652 sort_ext$sort_compare_exit 000240 external static entry variable dcl 1-168 ref 3-19 sort_ext$sort_output_record_exit 000242 external static entry variable dcl 1-178 ref 216 216 288 288 sort_ext$state 000244 external static fixed bin(17,0) dcl 1-192 ref 86 86 sort_ext$unique_prefix 000246 external static char(16) unaligned dcl 1-215 ref 469 469 sort_ext$w 000250 external static fixed bin(30,0) array dcl 1-218 ref 3-43 3-43 3-43 3-43 3-47 3-47 3-47 3-47 3-52 3-52 3-52 3-52 3-56 3-56 3-56 3-56 3-71 3-71 3-71 3-71 3-75 3-75 3-75 3-75 3-80 3-80 3-80 3-80 3-84 3-84 3-84 3-84 687 687 sort_ext$whoami 000252 external static char(6) unaligned dcl 1-227 ref 268 268 332 332 515 515 519 519 613 613 617 617 667 667 691 691 696 696 707 707 711 711 sort_output_record_exit defined entry variable dcl 1-180 ref 216 288 state defined fixed bin(17,0) dcl 1-193 ref 86 sub_err_ 000320 constant entry external dcl 662 in procedure "ck_len" ref 667 sub_err_ 000314 constant entry external dcl 80 in procedure "return" ref 268 332 515 519 613 617 691 696 707 711 t 000066 internal static fixed bin(30,0) dcl 39 set ref 413* 416 420 422* 422 type 000120 automatic char(10) unaligned dcl 677 set ref 684* 685* 686* 687* u_rec_len_2 000122 internal static fixed bin(21,0) dcl 44 set ref 120 120 121 215* 216* 223* 225 225 227 285* 288* 323* u_rec_ptr_2 000120 internal static pointer dcl 44 set ref 120 214* 216* 225 284* 288* unique_prefix defined char(16) unaligned dcl 1-216 ref 469 v1 000070 internal static fixed bin(30,0) dcl 39 set ref 126 127 235 307 351* 365 366 376 384 400* 438* 440 440* 443 449 453* 456 537* 539 553 554* 559 565 571* 574 575 580 580 580 584 588* 592 597* 601 602 604 606* 609 610 613 613 613* 613 617 617* 617 624 624 626 626 628 632 632 632 633 634* 634 636 636* 640 646 650* 652 653* 691* v2 000071 internal static fixed bin(30,0) dcl 39 set ref 439* 440 441 444 449 453 538* 540 554 556 560 565 571 632* 632* 635* 635 636 637 641 646 650 691* w defined fixed bin(30,0) array dcl 1-219 set ref 3-43 3-43 3-47 3-47 3-52 3-52 3-56 3-56 3-71 3-71 3-75 3-75 3-80 3-80 3-84 3-84 687* w_p 000102 internal static pointer dcl 2-14 set ref 170* 172 173 399 528* 530 626* 628 whoami defined char(6) unaligned dcl 1-228 set ref 268* 332* 515* 519* 613* 617* 667* 691* 696* 707* 711* work_1 000256 automatic fixed bin(71,0) dcl 3-3 set ref 3-61* 3-64 3-67 3-68 work_2 000260 automatic fixed bin(71,0) dcl 3-3 set ref 3-63* 3-66 3-67 3-68 work_3 000262 automatic float bin(63) dcl 3-3 set ref 3-89* 3-92 3-95 3-96 work_4 000264 automatic float bin(63) dcl 3-3 set ref 3-91* 3-93 3-95 3-96 work_5 000266 automatic fixed dec(59,0) dcl 3-3 set ref 3-99* 3-101 3-107 3-108 work_6 000305 automatic fixed dec(59,0) dcl 3-3 set ref 3-102* 3-103 3-107 3-108 work_7 000324 automatic float dec(59) dcl 3-3 set ref 3-111* 3-113 3-122 3-123 work_8 000344 automatic float dec(59) dcl 3-3 set ref 3-114* 3-115 3-122 3-123 x 000073 internal static fixed bin(30,0) dcl 39 set ref 437* 438 439 633* 652 653 y 000075 internal static fixed bin(30,0) dcl 39 set ref 461* 537 538 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. IN based structure array level 1 unaligned dcl 36 R based structure array level 1 unaligned dcl 2-3 S1 based char(1) array unaligned dcl 2-12 acl defined structure array level 1 unaligned dcl 1-6 curr_input_file_attach defined char(256) unaligned dcl 1-22 curr_input_file_name defined char(256) unaligned dcl 1-25 curr_input_file_num defined fixed bin(17,0) dcl 1-28 curr_output_file_attach defined char(256) unaligned dcl 1-31 curr_output_file_name defined char(256) unaligned dcl 1-34 debug_sw defined bit(1) unaligned dcl 1-37 establish_cleanup_proc_ 000000 constant entry external dcl 79 file automatic char(20) unaligned dcl 677 file_part automatic char(168) unaligned dcl 677 in_buff_ptr defined pointer dcl 1-65 input_file_exit_sw defined bit(1) unaligned dcl 1-49 input_file_max defined fixed bin(17,0) dcl 1-53 input_rec_deleted defined fixed bin(30,0) dcl 1-59 input_rec_inserted defined fixed bin(30,0) dcl 1-62 input_record_exit_sw defined fixed bin(1,0) dcl 1-56 max1 defined fixed bin(30,0) dcl 1-71 max2 defined fixed bin(30,0) dcl 1-74 max3 defined fixed bin(30,0) dcl 1-77 max4 defined fixed bin(30,0) dcl 1-80 merge_compares defined fixed bin(34,0) dcl 1-87 mip defined fixed bin(30,0) array dcl 1-105 np internal static fixed bin(30,0) dcl 31 ns internal static fixed bin(30,0) dcl 31 old_input_file_num defined fixed bin(17,0) dcl 1-114 output_driver_is_sort defined bit(1) unaligned dcl 1-117 output_file_exit_sw defined bit(1) unaligned dcl 1-120 presort_compares defined fixed bin(34,0) dcl 1-132 pu defined structure array level 1 unaligned dcl 1-137 report_sw defined bit(2) unaligned dcl 1-154 retfb automatic fixed bin(30,0) dcl 31 sii defined fixed bin(30,0) dcl 1-163 sort_desc_pn defined char(168) unaligned dcl 1-171 sort_ext$acl external static structure array level 1 unaligned dcl 1-1 sort_ext$curr_input_file_attach external static char(256) unaligned dcl 1-21 sort_ext$curr_input_file_name external static char(256) unaligned dcl 1-24 sort_ext$curr_input_file_num external static fixed bin(17,0) dcl 1-27 sort_ext$curr_output_file_attach external static char(256) unaligned dcl 1-30 sort_ext$curr_output_file_name external static char(256) unaligned dcl 1-33 sort_ext$debug_sw external static bit(1) unaligned dcl 1-36 sort_ext$in_buff_ptr external static pointer dcl 1-64 sort_ext$input_file_exit_sw external static bit(1) unaligned dcl 1-48 sort_ext$input_file_max external static fixed bin(17,0) dcl 1-51 sort_ext$input_rec_deleted external static fixed bin(30,0) dcl 1-58 sort_ext$input_rec_inserted external static fixed bin(30,0) dcl 1-61 sort_ext$input_record_exit_sw external static fixed bin(1,0) dcl 1-55 sort_ext$max1 external static fixed bin(30,0) dcl 1-70 sort_ext$max2 external static fixed bin(30,0) dcl 1-73 sort_ext$max3 external static fixed bin(30,0) dcl 1-76 sort_ext$max4 external static fixed bin(30,0) dcl 1-79 sort_ext$merge_compares external static fixed bin(34,0) dcl 1-86 sort_ext$mip external static fixed bin(30,0) array dcl 1-104 sort_ext$old_input_file_num external static fixed bin(17,0) dcl 1-113 sort_ext$output_driver_is_sort external static bit(1) unaligned dcl 1-116 sort_ext$output_file_exit_sw external static bit(1) unaligned dcl 1-119 sort_ext$presort_compares external static fixed bin(34,0) dcl 1-131 sort_ext$pu external static structure array level 1 unaligned dcl 1-134 sort_ext$report_sw external static bit(2) unaligned dcl 1-153 sort_ext$sii external static fixed bin(30,0) dcl 1-162 sort_ext$sort_desc_pn external static char(168) unaligned dcl 1-170 sort_ext$sort_input_record_exit external static entry variable dcl 1-173 sort_ext$srp external static pointer dcl 1-183 sort_ext$ssi external static fixed bin(30,0) dcl 1-186 sort_ext$ssp external static pointer dcl 1-189 sort_ext$terminate_print_sw external static bit(1) unaligned dcl 1-195 sort_ext$time_info external static structure array level 1 unaligned dcl 1-198 sort_ext$time_sw external static bit(1) unaligned dcl 1-209 sort_ext$user_out_sw external static char(32) unaligned dcl 1-212 sort_ext$wf_dir_name external static char(168) dcl 1-221 sort_ext$wf_full_name external static char(168) unaligned dcl 1-224 sort_ext$write_count external static fixed bin(30,0) dcl 1-230 sort_input_record_exit defined entry variable dcl 1-175 srp defined pointer dcl 1-184 ssi defined fixed bin(30,0) dcl 1-187 ssp defined pointer dcl 1-190 terminate_print_sw defined bit(1) unaligned dcl 1-196 time_info defined structure array level 1 unaligned dcl 1-203 time_sw defined bit(1) unaligned dcl 1-210 user_out_sw defined char(32) unaligned dcl 1-213 wf_dir_name defined char(168) dcl 1-222 wf_full_name defined char(168) unaligned dcl 1-225 write_count defined fixed bin(30,0) dcl 1-231 NAMES DECLARED BY EXPLICIT CONTEXT. A0 001775 constant entry internal dcl 389 ref 109 A1 002766 constant entry internal dcl 535 ref 182 462 A2 003113 constant entry internal dcl 578 ref 181 ck_len 004233 constant entry internal dcl 657 ref 223 312 317 323 324 close 002445 constant label dcl 486 in procedure "init_return" close 003144 constant label dcl 584 in procedure "A2" close 000525 constant label dcl 141 in procedure "return" con 001703 constant label dcl 368 in procedure "return" con 004232 constant label dcl 3-130 in procedure "sort_comp" ref 3-20 con 002763 constant label dcl 531 in procedure "init_return" ref 507 ent 000725 constant label dcl 211 ref 264 esc 004225 constant label dcl 3-129 ref 3-33 3-42 3-51 3-60 3-70 3-79 3-88 3-98 3-110 3-125 exit 001774 constant label dcl 387 ref 271 335 524 622 671 701 714 g_a_w 000406 constant label dcl 114 ref 237 313 illegal_procedure_handler 004326 constant entry internal dcl 676 ref 91 in 000667 constant label dcl 190 ref 106 130 132 231 init_return 002221 constant entry internal dcl 464 ref 392 426 iox_error 004606 constant entry internal dcl 703 ref 145 154 165 475 478 490 499 509 588 597 606 lab 000000 constant label array(10) dcl 3-25 ref 3-24 next_key 004221 constant label dcl 3-126 ref 3-29 3-38 3-47 3-56 3-68 3-75 3-84 3-96 3-108 3-123 rel_ck 000654 constant label dcl 184 ref 111 163 177 396 return 000312 constant entry external dcl 12 sim 001433 constant label dcl 315 ref 274 sort_comp 003644 constant entry internal dcl 3-1 ref 280 362 382 445 561 642 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 3-101 3-103 3-113 3-115 divide builtin function ref 423 633 fixed builtin function ref 170 528 626 mod builtin function ref 687 null builtin function ref 94 105 159 210 212 219 264 268 268 275 280 280 332 332 354 504 515 515 519 519 602 613 613 617 617 667 667 691 691 696 696 707 707 711 711 ptr builtin function ref 170 528 626 rel builtin function ref 170 528 626 substr builtin function set ref 120 120 225* 225 244* 244 252* 252 292* 292 417 632 3-25 3-25 3-29 3-29 3-34 3-34 3-38 3-38 3-64* 3-64 3-66* 3-66 3-92* 3-92 3-93* 3-93 3-104* 3-104 3-105* 3-105 3-116* 3-116 3-117* 3-117 3-119* 3-119 3-120* 3-120 unspec builtin function ref 417 632 3-64 3-66 3-92 3-93 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5624 6146 5052 5634 Length 6702 5052 322 520 551 146 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME return 616 external procedure is an external procedure. on unit on line 91 166 on unit A0 internal procedure shares stack frame of external procedure return. init_return internal procedure shares stack frame of external procedure return. A1 internal procedure shares stack frame of external procedure return. A2 internal procedure shares stack frame of external procedure return. sort_comp internal procedure shares stack frame of external procedure return. ck_len internal procedure shares stack frame of external procedure return. illegal_procedure_handler internal procedure shares stack frame of on unit on line 91. iox_error internal procedure shares stack frame of external procedure return. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 merge_read_count return 000022 s return 000066 t return 000067 n return 000070 v1 return 000071 v2 return 000072 l return 000073 x return 000074 j return 000075 y return 000076 lft return 000077 rit return 000100 i return 000102 w_p return 000104 hold_ptr return 000106 hold_len return 000110 s_retp return 000112 s_retbl return 000114 rec_ptr_2 return 000116 rec_len_2 return 000120 u_rec_ptr_2 return 000122 u_rec_len_2 return 000123 action return 000124 equal_key return 000125 seq_check_sw return 000126 close_exit_sw return 000130 cur_rec_ptr return 000132 area_len return 000133 equal_key_sw return 000134 old_retp return 000136 old_rec_ptr return 000140 input_file_len return 000152 hold_cur_rec_ptr return 000154 hold_area_len return STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME on unit on line 91 000106 key_part illegal_procedure_handler 000120 type illegal_procedure_handler 000123 len illegal_procedure_handler return 000100 i1 return 000101 result return 000102 pt1 return 000104 pt2 return 000106 retval return 000107 in_attach_desc return 000163 in_switch return 000173 in_switch_length return 000174 iox_code return 000175 in_mode return 000176 no_extend return 000177 in_buff_len return 000226 i init_return 000256 work_1 sort_comp 000260 work_2 sort_comp 000262 work_3 sort_comp 000264 work_4 sort_comp 000266 work_5 sort_comp 000305 work_6 sort_comp 000324 work_7 sort_comp 000344 work_8 sort_comp 000364 dec_ptr1 sort_comp 000366 dec_ptr2 sort_comp 000370 dec_ptr3 sort_comp 000372 dec_ptr4 sort_comp THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as alloc_cs call_var call_ext_out_desc call_ext_out return tra_ext mod_fx1 enable shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_$rsnnl iox_$attach_ioname iox_$close iox_$destroy_iocb iox_$detach_iocb iox_$open iox_$read_record sub_err_ sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$data_gain error_table_$data_loss error_table_$data_seq_error error_table_$end_of_info error_table_$fatal_error error_table_$improper_data_format error_table_$long_record error_table_$out_of_sequence error_table_$request_not_recognized error_table_$short_record sort_ext$b sort_ext$compare_sw sort_ext$compares_counter sort_ext$disaster2 sort_ext$dt sort_ext$input_driver_is_sort sort_ext$leng sort_ext$max_rec_length sort_ext$merge_in_iocb_ptrs sort_ext$merge_input_file_attaches sort_ext$merge_input_file_names sort_ext$mii sort_ext$min_rec_length sort_ext$msp sort_ext$no_of_keys sort_ext$output_rec_deleted sort_ext$output_rec_inserted sort_ext$output_record_exit_sw sort_ext$read_count sort_ext$rec_ptr_a sort_ext$rec_ptr_b sort_ext$release_count sort_ext$return_count sort_ext$rev sort_ext$sip sort_ext$sort_compare_exit sort_ext$sort_output_record_exit sort_ext$state sort_ext$unique_prefix sort_ext$w sort_ext$whoami LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 12 000306 62 000317 83 000322 84 000324 86 000326 88 000331 89 000333 91 000334 92 000352 93 000355 94 000357 96 000361 97 000362 98 000364 99 000366 100 000370 102 000372 103 000375 105 000377 106 000401 109 000402 110 000403 111 000405 114 000406 116 000421 118 000431 120 000434 121 000441 122 000443 124 000451 125 000453 126 000455 127 000462 128 000471 129 000472 130 000473 132 000474 134 000500 137 000503 138 000521 141 000525 142 000535 145 000537 149 000546 150 000557 154 000561 158 000572 159 000603 161 000606 162 000611 163 000613 165 000614 168 000626 169 000627 170 000630 172 000640 173 000642 174 000644 176 000645 177 000647 181 000650 182 000651 183 000652 184 000654 186 000660 187 000664 188 000666 190 000667 192 000670 194 000673 196 000676 197 000701 199 000702 202 000704 203 000710 205 000712 208 000715 209 000721 210 000723 211 000725 212 000727 214 000735 215 000737 216 000741 219 000772 221 000775 223 001000 224 001016 225 001022 227 001027 228 001031 229 001035 230 001037 231 001040 233 001041 235 001046 236 001057 237 001062 239 001063 241 001065 243 001075 244 001100 246 001105 247 001107 248 001113 249 001115 250 001116 252 001120 254 001126 255 001130 256 001134 257 001136 258 001137 259 001140 261 001142 262 001146 263 001150 264 001151 265 001155 266 001156 268 001162 270 001230 271 001234 273 001235 274 001236 275 001242 276 001250 278 001254 279 001256 280 001260 282 001271 284 001274 285 001276 286 001300 287 001302 288 001304 290 001332 292 001342 293 001350 295 001351 300 001356 302 001362 303 001363 305 001364 307 001367 308 001400 309 001402 310 001404 312 001406 313 001432 315 001433 317 001435 318 001453 319 001457 320 001461 321 001462 323 001464 324 001502 325 001521 326 001524 327 001526 328 001531 329 001533 332 001534 334 001602 335 001606 337 001607 339 001613 341 001616 343 001617 345 001621 348 001622 349 001623 351 001625 354 001627 358 001637 360 001647 361 001652 362 001655 363 001656 365 001665 366 001673 367 001702 368 001703 370 001707 372 001710 374 001712 376 001720 377 001731 378 001735 380 001736 381 001743 382 001746 383 001747 384 001756 385 001770 387 001774 389 001775 390 001776 392 002002 393 002003 395 002006 396 002011 398 002012 399 002016 400 002020 401 002022 404 002023 405 002032 406 002035 413 002037 414 002040 415 002042 416 002050 417 002053 419 002056 420 002057 422 002063 423 002065 424 002067 425 002071 426 002073 433 002074 434 002105 435 002107 436 002112 437 002122 438 002124 439 002130 440 002133 441 002140 443 002142 444 002147 445 002154 446 002155 447 002157 449 002161 451 002167 453 002171 455 002175 456 002176 457 002203 458 002206 459 002210 461 002214 462 002217 463 002220 464 002221 467 002222 468 002232 469 002234 471 002267 473 002320 474 002324 475 002353 477 002365 478 002405 481 002414 483 002441 486 002445 487 002457 490 002461 494 002466 495 002502 499 002504 503 002513 504 002530 506 002535 507 002541 509 002542 511 002551 512 002561 513 002565 515 002567 519 002657 522 002736 523 002737 524 002743 526 002744 527 002746 528 002747 530 002761 531 002763 532 002765 535 002766 537 002767 538 002775 539 002777 540 003002 543 003005 545 003014 547 003017 548 003022 549 003032 550 003034 551 003036 553 003037 554 003041 555 003043 556 003044 559 003046 560 003053 561 003060 562 003061 563 003063 565 003065 567 003073 570 003075 571 003077 574 003101 575 003107 576 003112 578 003113 580 003114 581 003140 584 003144 585 003157 588 003161 592 003200 593 003214 597 003216 601 003237 602 003253 604 003262 605 003266 606 003267 609 003310 610 003317 611 003323 613 003325 617 003416 620 003475 621 003476 622 003502 624 003503 625 003504 626 003505 628 003517 630 003522 631 003533 632 003535 632 003544 633 003547 634 003553 635 003561 636 003565 637 003572 640 003574 641 003601 642 003606 643 003607 644 003611 646 003613 648 003621 650 003623 652 003627 653 003637 654 003641 655 003643 3 1 003644 3 17 003645 3 19 003650 3 20 003662 3 21 003664 3 23 003665 3 24 003673 3 25 003676 3 29 003711 3 33 003715 3 34 003716 3 38 003731 3 42 003735 3 43 003736 3 47 003745 3 51 003750 3 52 003751 3 56 003763 3 60 003766 3 61 003767 3 63 003771 3 64 003772 3 66 004002 3 67 004006 3 68 004014 3 70 004017 3 71 004020 3 75 004027 3 79 004032 3 80 004033 3 84 004045 3 88 004050 3 89 004051 3 91 004053 3 92 004054 3 93 004064 3 95 004070 3 96 004076 3 98 004101 3 99 004102 3 101 004105 3 102 004107 3 103 004112 3 104 004114 3 105 004127 3 107 004133 3 108 004142 3 110 004145 3 111 004146 3 113 004151 3 114 004153 3 115 004156 3 116 004160 3 117 004173 3 119 004177 3 120 004203 3 122 004206 3 123 004215 3 125 004220 3 126 004221 3 127 004223 3 128 004224 3 129 004225 3 131 004232 657 004233 665 004244 667 004251 670 004320 671 004324 673 004325 676 004326 682 004327 684 004337 685 004350 686 004356 687 004361 690 004443 691 004450 694 004526 696 004527 700 004576 701 004603 703 004606 706 004617 707 004623 711 004716 714 004776 ----------------------------------------------------------- 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