COMPILATION LISTING OF SEGMENT sort_output_proc Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/11/82 1231.3 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 03/20/82 by FCH, [1], decrease size of IN */ 11 12 sort_output_proc: proc(output_proc_code); 13 14 /* EXTERNAL ENTRIES */ 15 dcl iox_$attach_ioname entry(char(*), ptr, char(*), fixed bin(35)); 16 dcl iox_$open entry(ptr, fixed bin, bit(1) aligned, fixed bin(35)); 17 dcl iox_$write_record entry(ptr, ptr, fixed bin(21), fixed bin(35)); 18 dcl iox_$close entry(ptr, fixed bin(35)); 19 dcl iox_$detach_iocb entry(ptr, fixed bin(35)); 20 dcl iox_$destroy_iocb entry(ptr, fixed bin(35)); 21 dcl sub_err_ entry options(variable); 22 23 24 /* EXTERNAL STATIC */ 25 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); 26 27 28 dcl (error_table_$not_detached, 29 error_table_$not_attached, 30 error_table_$not_closed, 31 error_table_$end_of_info, 32 error_table_$data_loss, 33 error_table_$data_gain, 34 error_table_$data_seq_error, 35 error_table_$not_open, 36 error_table_$out_of_sequence, 37 error_table_$request_not_recognized, 38 error_table_$long_record, 39 error_table_$fatal_error) fixed bin(35) external static; 40 41 /* PARAMETERS AND AUTOMATIC */ 42 dcl output_proc_code fixed bin(35) parameter; 43 44 dcl out_attach_desc char(176), 45 out_iocb_ptr ptr, 46 iox_code fixed bin(35), 47 out_mode fixed bin, 48 seq_output fixed bin init(5), 49 no_extend bit(1) aligned init("0"b), 50 sort_code fixed bin(35), 51 out_buff_ptr ptr, 52 out_rec_len fixed bin(21), 53 out_buff_len fixed bin(21) init(32768); 54 dcl data_gain_sw bit(1) init("0"b); 55 56 dcl retval fixed bin(35); 57 dcl cleanup condition; 58 59 /* Start. */ 60 output_proc_code = 0; 61 out_iocb_ptr = null(); 62 on cleanup call cleanup_proc; 63 /* Attach. */ 64 if curr_output_file_attach = "" then out_attach_desc = "vfile_ "||curr_output_file_name; 65 else out_attach_desc = curr_output_file_attach; 66 /* without extend */ 67 call iox_$attach_ioname(unique_prefix||"sort_out_1_", out_iocb_ptr, out_attach_desc, iox_code); 68 if iox_code ^= 0 then 69 do; 70 /* error_table_$not_detached */ 71 call iox_error("Attaching"); 72 end; 73 74 /* Open. */ 75 out_mode = seq_output; 76 call iox_$open(out_iocb_ptr, out_mode, no_extend, iox_code); 77 if iox_code ^= 0 then 78 do; 79 /* error_table_$not_attached, 80* $not_closed */ 81 call iox_error("Opening"); 82 end; 83 84 /* Retrieve and write. */ 85 retrieve: call sort_return(out_buff_ptr, out_rec_len, sort_code); 86 if sort_code = error_table_$end_of_info then 87 go to close; 88 if sort_code ^= 0 then 89 do; 90 /* sort_$return errors */ 91 if sort_code = error_table_$data_loss then do; 92 call sub_err_(sort_code, (whoami), "c", null(), retval, ""); 93 go to close; 94 end; 95 else if sort_code = error_table_$data_gain then do; 96 if data_gain_sw = "0"b then call sub_err_(sort_code, (whoami), "c", null(), retval, ""); 97 data_gain_sw = "1"b; 98 end; 99 else if sort_code = error_table_$data_seq_error then do; 100 if curr_output_file_attach = "" then 101 call sub_err_(sort_code, (whoami), "c", null(), retval, 102 " Record ^d of output file, file name ^a", 103 write_count + 1, curr_output_file_name); 104 else call sub_err_(sort_code, (whoami), "c", null(), retval, 105 " Record ^d of output file, attach description ^a", 106 write_count + 1, curr_output_file_attach); 107 end; 108 else if sort_code = error_table_$out_of_sequence then do; 109 call sub_err_(sort_code, (whoami), "c", null(), retval, 110 " Calling sort_$return."); 111 call cleanup_proc; 112 go to exit; 113 end; 114 else do; /* error_table_$fatal_error */ 115 output_proc_code = sort_code; 116 call cleanup_proc; 117 go to exit; 118 end; 119 end; 120 call iox_$write_record(out_iocb_ptr, out_buff_ptr, out_rec_len, iox_code); 121 if iox_code ^= 0 then 122 do; 123 /* no errors returned? */ 124 call iox_error("Writing"); 125 end; 126 write_count = write_count + 1; 127 go to retrieve; 128 129 /* Close. */ 130 close: call iox_$close(out_iocb_ptr, iox_code); 131 if iox_code ^= 0 then 132 do; 133 /* error_table_$not_open */ 134 call iox_error("Closing"); 135 end; 136 137 /* Detach. */ 138 call iox_$detach_iocb(out_iocb_ptr, iox_code); 139 if iox_code ^= 0 then 140 do; 141 /* error_table_$not_attached, 142* $not_closed */ 143 call iox_error("Detaching"); 144 end; 145 146 /* Destroy iocb. */ 147 call iox_$destroy_iocb(out_iocb_ptr, iox_code); 148 out_iocb_ptr = null(); 149 /* no errors returned? */ 150 exit: 151 return; /* to driver */ 152 return: entry(pt,fb,fb1); 153 dcl pt ptr, 154 fb fixed bin(21), 155 fb1 fixed bin(35); 156 call sort_return(pt,fb,fb1); 157 return; 158 159 sort_return: proc(retp,retbl,ec); 160 /* PARAMETERS, INTERNAL STATIC, AUTOMATIC, & BASED */ 161 dcl (retp ptr, 162 retbl fixed bin(21)) parameter; 163 dcl (t,n,v1,v2,l,x,j,y,lft,rit,i) fixed bin(30) int static; 164 dcl 165 (ns,np) fixed bin(30) int static, 166 s(36) static, 167 retfb fixed bin(30); 168 dcl i1 fixed bin(30); 169 /*1*/ dcl 1 IN(127 * 1024) based, 170 2 ctr fixed bin(30), /* serial record count */ 171 2 by_off fixed bin(30); /* byte offset of current record */ 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); 172 173 174 dcl retval fixed bin(35); 175 176 /* following declarations are for output record exit */ 177 dcl hold_ptr ptr int static, 178 hold_len fixed bin(21) int static, 179 s_retp ptr int static, 180 s_retbl fixed bin(21) int static, 181 rec_ptr_2 ptr int static, /* next record pointer */ 182 rec_len_2 fixed bin(21) int static, /* next record length */ 183 u_rec_ptr_2 ptr int static, /* rec_ptr_2 handed to the user */ 184 u_rec_len_2 fixed bin(21) int static, /* rec_len_2 handed to the user */ 185 action fixed bin int static, /* action code */ 186 equal_key fixed bin(1) int static, 187 seq_check_sw bit(1) int static, 188 close_exit_sw bit(1) int static, 189 cur_rec_ptr ptr int static, /* current record pointer */ 190 area_len fixed bin(21) int static, /* current record length */ 191 equal_key_sw bit(1) int static, 192 old_retp ptr int static; /* old retp pointer */ 193 dcl old_rec_ptr ptr int static; /* previous record for sequence checker */ 194 dcl hold_cur_rec_ptr ptr int static, /* hold ptr to output record in sort's area */ 195 hold_area_len int static; /* hold length of output record in case user destroys it */ 196 ec = 0; /* initially set error code */ 197 /* test state code */ 198 if state ^= 5 then /* sequence error */ 199 do; 200 ec = error_table_$out_of_sequence; 201 return; 202 end; 203 if disaster2 = 0 then do; /* Initial call to RETURN. */ 204 disaster2 = 1; 205 old_rec_ptr=null(); /* set initially for sequence check previous record */ 206 /* following set for output record exit */ 207 equal_key_sw="0"b; 208 equal_key=1; 209 seq_check_sw="1"b; 210 action=10; 211 if release_count = 0 then 212 do; /* no records released */ 213 ec = error_table_$end_of_info; 214 if output_record_exit_sw = 0 then return; 215 else do; /* prepare to take exit */ 216 retp=null(); 217 ns=1; 218 n = 0; 219 go to in; 220 end; 221 end; 222 call A0; 223 return_count = return_count + 1; 224 go to rel_ck; 225 end; 226 227 g_a_w: if output_record_exit_sw ^= 0 & action = 3 | action = 11 then 228 do; /* output rec sw on and just completed inserting a record */ 229 if old_retp = rec_ptr_b /* just returned current was in rec_ptr_b */ 230 then cur_rec_ptr=rec_ptr_a; /* set new current area to rec_ptr_a */ 231 else cur_rec_ptr=rec_ptr_b; /* just returned current was in rec_ptr_1- 232* set new current area to rec_ptr_b */ 233 substr(cur_rec_ptr->S,1,u_rec_len_2)=substr(u_rec_ptr_2->S,1,u_rec_len_2); 234 area_len=u_rec_len_2; /* move just inserted record into current area */ 235 if action=11 then ec=error_table_$end_of_info; 236 /* just inserted a record at end of file-reset ec */ 237 rec_ptr_2=hold_ptr; /* move previous next record into current next */ 238 rec_len_2=hold_len; 239 output_rec_inserted=output_rec_inserted+1; 240 go to in; /* transfer to point where exit routine is called-after determining new winner*/ 241 end; 242 if mii<2 then do; /* Single merge string. */ 243 if ns>n then do; 244 disaster2 = 2; 245 /* data lost test */ 246 if release_count > return_count /* data lost */ 247 then ec = error_table_$data_loss; 248 else 249 ec = error_table_$end_of_info; /* all records have been gotten from single merge string */ 250 end; 251 else do; 252 retp = msp (1); 253 /* update array element indicating current byte offset in string */ 254 /* below adjusts IN.by_off for double word alignment */ 255 retfb=divide(srp->IN.by_off(1) + fb + 4 - 1 +7,8,24)*8 + 1; 256 srp->IN.by_off(1) = retfb; 257 retp = addr(substr(retp->S,retfb,1)); 258 /* get byte position using word preceding record */ 259 w_p = ptr(retp,fixed(rel(retp),21)-1); /* move back 1 word to get length of record */ 260 retbl = fb; /* set up length */ 261 /* set buffer pointer to correct record within string */ 262 return_count = return_count +1; /* increment return count */ 263 ns = ns+1; 264 end; 265 go to rel_ck; 266 end; 267 268 /* Multiple merge strings. */ 269 call A2; 270 call A1; 271 return_count = return_count + 1; 272 rel_ck: if release_count < return_count then 273 do; /* data gain test */ 274 if ec =error_table_$end_of_info then return; /* already at end of info */ 275 ec=error_table_$data_gain; 276 return; 277 end; 278 in:; 279 /* following code is for output record exit routine */ 280 if output_record_exit_sw ^= 0 then 281 do; /* take output record exit */ 282 if action = error_table_$end_of_info then 283 do; /* just wrote last record */ 284 ec=error_table_$end_of_info; /* reset error code */ 285 return; 286 end; 287 if action ^= 3 then 288 do; /* just got winner record */ 289 /* save winner record pointer */ 290 s_retp=retp; 291 s_retbl=retbl; 292 end; 293 if action=10 then 294 do; /* indicating first time through-no curent record,no previously 295* written record */ 296 rec_ptr_2=retp; /* set up next record-to winner */ 297 rec_len_2=retbl; 298 cur_rec_ptr=null(); /* set current record ptr to null */ 299 ent: action=0; 300 if ec=error_table_$end_of_info then rec_ptr_2=null(); 301 /* deleted every successive record of the file */ 302 u_rec_ptr_2=rec_ptr_2; /* set user's next pointer and next length */ 303 u_rec_len_2=rec_len_2; 304 if close_exit_sw="0"b then 305 call sort_output_record_exit(cur_rec_ptr,area_len,u_rec_ptr_2,u_rec_len_2, 306 action,equal_key,equal_key_sw,seq_check_sw,close_exit_sw); 307 old_retp=null(); /* to indicate,next time through,that there is no previous record- 308* therefore no sequence check */ 309 if action=3 then 310 do; /* insert record at beginning of file */ 311 call ck_len(u_rec_len_2,"inserted"); /* check returned record length */ 312 cur_rec_ptr=rec_ptr_b; /* arbitrarily set to b */ 313 substr(cur_rec_ptr->S,1,u_rec_len_2)=substr(u_rec_ptr_2->S,1,u_rec_len_2); 314 /* set up current record */ 315 area_len=u_rec_len_2; 316 rec_ptr_2=retp; /* reset next reocrd to same-previous next record */ 317 rec_len_2=retbl; 318 output_rec_inserted=output_rec_inserted+1; 319 go to in; /* don't write current record-rather go back & call exit */ 320 end; 321 if ec = error_table_$end_of_info then action=ec; 322 /* deleted the entire file */ 323 go to g_a_w; 324 end; 325 if action= 0 then 326 do; /* just completed accepting record */ 327 if old_retp=rec_ptr_b /* just returned current was in rec_ptr_b */ 328 then cur_rec_ptr=rec_ptr_a; /* set new current area to rec_ptr_a */ 329 else cur_rec_ptr=rec_ptr_b; /* set new current area to rec_ptr_b */ 330 substr(cur_rec_ptr->S,1,rec_len_2)=substr(rec_ptr_2->S,1,rec_len_2); 331 /* move previous next record into current area */ 332 area_len=rec_len_2; 333 rec_ptr_2=retp; /* set up new next record */ 334 rec_len_2=retbl; 335 end; 336 else if action=1 then 337 do; /* just completed deleting the current record */ 338 substr(cur_rec_ptr->S,1,rec_len_2)=substr(rec_ptr_2->S,1,rec_len_2); 339 /* move old next record into current record area */ 340 area_len=rec_len_2; 341 rec_ptr_2=retp; /* set up new next record */ 342 rec_len_2=retbl; 343 output_rec_deleted=output_rec_deleted+1; 344 end; 345 else if action=2 then 346 do; /* just completed deleting next record-leave old current record alone */ 347 rec_ptr_2=retp; /* set up new next record */ 348 rec_len_2=retbl; 349 output_rec_deleted=output_rec_deleted+1; 350 if cur_rec_ptr=null() then go to ent; /* just deleted first record(of the file) */ 351 end; 352 else if ^(action=11 | action=3) then 353 do; /* illegal action code */ 354 call sub_err_(error_table_$request_not_recognized,(whoami), "c", null(), retval, 355 "Invalid action = ^d by user output_record exit procedure.",action); 356 ec=error_table_$fatal_error; 357 goto exit; 358 end; 359 action=0; /* set here in case close exit is on */ 360 if close_exit_sw="1"b then go to sim; /* close exit switch is on */ 361 if ec=error_table_$end_of_info then rec_ptr_2=null(); /* no next rec-end of info */ 362 if equal_key_sw="1"b then /* equal key swtich on */ 363 do; /* check for equal keys between current and next */ 364 pt1=cur_rec_ptr; /* current record */ 365 pt2=rec_ptr_2; /* next record */ 366 if pt1^=null() & pt2^= null() then 367 call sort_comp; /* invoke sort's comparison routine */ 368 equal_key=result; 369 end; 370 u_rec_ptr_2=rec_ptr_2; /* set user's next pointer and next length */ 371 u_rec_len_2=rec_len_2; 372 hold_cur_rec_ptr = cur_rec_ptr; /* save pointer to output record */ 373 hold_area_len = area_len; /* save length of output record */ 374 call sort_output_record_exit(cur_rec_ptr,area_len,u_rec_ptr_2,u_rec_len_2, 375 action,equal_key,equal_key_sw,seq_check_sw,close_exit_sw); 376 if action ^= 1 & cur_rec_ptr ^= hold_cur_rec_ptr then 377 do; /* move record pointed to by user into an area belonging to the sort */ 378 substr(hold_cur_rec_ptr->S, 1, area_len) = substr(cur_rec_ptr->S, 1, area_len); 379 cur_rec_ptr = hold_cur_rec_ptr; 380 end; 381 if action=1 | action=2 then 382 do; /* delete current or next record */ 383 /* don't return a record back to sort_output */ 384 /* rather go back and get anther winner */ 385 /* don't perform sequence check */ 386 if ec=error_table_$end_of_info then /* no more records-simply */ 387 do; /* return after incrementing deletion count */ 388 output_rec_deleted=output_rec_deleted+1; 389 return; 390 end; 391 if action = 1 then 392 do; /* restore held values */ 393 cur_rec_ptr = hold_cur_rec_ptr; 394 area_len = hold_area_len; 395 end; 396 if action=2 then call ck_len(area_len,"summarized"); /* check returned current record len */ 397 goto g_a_w; /* transfer to get another winner */ 398 end; 399 sim: if action=0 then 400 do; /* accept current record */ 401 call ck_len(area_len,"altered"); /* check returned current rec length */ 402 retp=cur_rec_ptr; /* set record return pointer to current record */ 403 retbl=area_len; 404 end; 405 else if action=3 then 406 do; /* insert record pointed to by rec_ptr_2-next record */ 407 call ck_len(u_rec_len_2,"inserted"); /* check length of record to be inserted */ 408 call ck_len(area_len,"altered"); /* check returned current record length */ 409 hold_ptr=s_retp; /* save old next pointer */ 410 hold_len=s_retbl; 411 retp=cur_rec_ptr; /* set return record to current record */ 412 retbl=area_len; 413 end; 414 else 415 do; /* illegal action code */ 416 call sub_err_(error_table_$request_not_recognized,(whoami), "c", null(), retval, 417 "Invalid action = ^d by user output_record exit procedure.",action); 418 ec=error_table_$fatal_error; 419 goto exit; 420 end; 421 if ec=error_table_$end_of_info then 422 do; /* no more records to be read */ 423 if action ^= 3 then 424 do; /* no record to be inserted */ 425 ec=0; /* reset ec so that sort_output will write record */ 426 /* retp should already be set */ 427 action=error_table_$end_of_info; /* set to indicate,on next time 428* through, no records left */ 429 end; 430 else do; /* insert record at end of file-in rec_ptr_2 */ 431 /* action=s 3 */ 432 ec=0; /* reset so that sort_output will write current record */ 433 action=11; /* indicating no more records to be read */ 434 end; 435 v1=mii; /* in case of multiple merge strings-an extra pass will be made 436* through A2 and A! */ 437 end; 438 if seq_check_sw="1"b & old_retp^=null() then 439 /* seq bit on and a previously written record */ 440 do; /* perform sequence check-between current and record previously written- 441* cur_rec_ptr and rec_ptr_a or rec_ptr_b */ 442 if retp=rec_ptr_a 443 then pt1=rec_ptr_b; /* previous record is in rec_ptr_b */ 444 else pt1=rec_ptr_a; /* previous record is in rec_ptr_a */ 445 pt2=retp; /* current record */ 446 call sort_comp; 447 if result= 1 then ec=error_table_$data_seq_error; /* out of sequence-fatal error */ 448 end; 449 con: old_retp=retp; /* set so that,on next time through,can distinguish which 450* record pointer was used */ 451 return; 452 end; /* end sort output record exit code */ 453 if old_rec_ptr=null() | ec=error_table_$end_of_info 454 then old_rec_ptr=retp; /* set for next time through */ 455 else do; /* perorm sequence check */ 456 pt1=old_rec_ptr; /* set previous record pointer */ 457 pt2=retp; /* current record pointer */ 458 call sort_comp; 459 if result = 1 then 460 ec=error_table_$data_seq_error; 461 old_rec_ptr=retp; /* set for next time through */ 462 end; 463 exit: return; 464 465 A0: proc; 466 if mii<2 then do; /* Single sorted string. */ 467 n = mip(1); /* number of records in first string */ 468 if n<1 then do; 469 /* Ignore possible error. */ 470 end; 471 else do; 472 /* set first element of array to indicate-for single merge 473* string case-character position of current record in this merge string */ 474 srp->IN.by_off(1) = 9; 475 retp = msp(1); /* string pointer */ 476 retfb = srp->IN.by_off(1); /* set byte offset from srp-IN array */ 477 retp = addr(substr(retp->S,retfb,1)); /* adjust pointer */ 478 /* get byte position using word preceding record */ 479 w_p = ptr(retp,fixed(rel(retp),21)-1); /* move back 1 work-to get length */ 480 retbl = fb; /* set up length */ 481 ns = 2; 482 end; 483 return; 484 end; 485 486 /* Initialize for multiple merge strings. */ 487 488 do i = 1 to mii; /* Set indices for merge. */ 489 sip -> I (i) = i; /* sets ups I array */ 490 srp->IN.ctr(i) = 1; /* record number in merge string */ 491 srp->IN.by_off(i) = 9; /* set to char position of each record in each merge string */ 492 end; 493 494 /* 495* calculate the lengths of 496* lists and their start pointers 497* in a linear set. 498* */ 499 t = 0; 500 l = mii; /* number of merge srings */ 501 do n = 1 by 1 while (l>1); 502 s (n) = t; /* start of the next list. */ 503 if substr(unspec(l),36,1) then 504 do; /* l odd */ 505 l = l+1; /* make the length even */ 506 sip->I(t+l) = 0; /* clear 2nd word of pair if l was odd */ 507 end; 508 t = t+l; /* accumulate the lengths. */ 509 l = divide(l,2,24); 510 end; 511 n = n-1; 512 513 /* Set s(n) to (one more than) the index to the list 514* for the final 2 records to be compared. */ 515 /* below rearranges I array to reflect sorted records(the first record of each merge 516* string being looked at) */ 517 do i = 2 to n; 518 lft = s (i-1); 519 rit = s (i) ; 520 do j = 1 by 2 to (rit - lft); 521 x = lft+j; 522 v1 = sip -> I (x); /* indices in I(sip) */ 523 v2 = sip -> I (x+1); 524 if v2>0 then do; 525 /* below sets up pointers to record within S string (v1th & v2nd) */ 526 /* msp(vn) points to beginning of S string while by_off gives the offset within */ 527 pt2 = addr(msp(v2)->S1(srp->IN.by_off(v2))); 528 pt1 = addr(msp(v1)->S1(srp->IN.by_off(v1))); 529 call sort_comp; 530 compares_counter=compares_counter+1; 531 if result = 0 then /* records ranked equal */ 532 do; 533 if v1 < v2 /* compare merge string numbers */ 534 then result = -1; /* rank record 1 first */ 535 else result = 1; /* rank record 2 first */ 536 end; 537 if result = 1 then v1 = v2; /* record 2 ranks first-switch order */ 538 end; 539 rit = rit+1; 540 sip -> I (rit) = v1; 541 end; 542 end; 543 y = s (n)+1; 544 call A1; 545 return; 546 end A0; 547 548 A1: proc; 549 /* Obtain the next record to output. */ 550 v1 = sip -> I (y); 551 v2 = sip -> I (y+1); 552 if v1 ^= 0 then; 553 else if v2 ^= 0 then; 554 else do; 555 /* data lost test */ 556 if release_count > return_count 557 then ec = error_table_$data_loss; 558 else 559 ec = error_table_$end_of_info; 560 return_count=return_count-1; /* pre-adjust return_count */ 561 return; 562 end; 563 if v1 = 0 then do; 564 v1 = v2; 565 end; 566 else 567 if v2>0 then do; 568 /* below sets up pointers to records within S string */ 569 pt2 = addr(msp(v2)->S1(srp->IN.by_off(v2))); 570 pt1 = addr(msp(v1)->S1(srp->IN.by_off(v1))); 571 call sort_comp; 572 compares_counter=compares_counter+1; 573 if result = 0 then /* records ranked equal */ 574 do; 575 if v1 < v2 /* compare merge string numbers */ 576 then result = -1; /* rank record 1 first */ 577 else result = 1; /* rank record 2 first */ 578 end; 579 580 if result = 1 then do; /* second record first */ 581 v1 = v2; 582 end; 583 end; 584 retp = msp (v1); 585 retfb = srp->IN.by_off(v1); /* set byte offset from srp->IN array */ 586 retp = addr(substr(retp->S,retfb,1)); /* set pointer to correct record within string */ 587 /* get byte position using word preceding record */ 588 w_p = ptr(retp,fixed(rel(retp),21)-1); /* move back 1 word-to get length */ 589 retbl = fb; /* set up length */ 590 return; 591 end A1; 592 A2: proc; 593 /* Delete last record output. */ 594 i = srp->IN.ctr(v1) + 1; /* index of new record to look at -in v1th string */ 595 if i > mip(v1) then sip->I(v1) = 0; /* v1th string depleted */ 596 /* no more records in ths string to be looked at */ 597 srp->IN.ctr(v1) = i; /* update the index in v1th string to look at */ 598 /* below adjusts IN.by_off for double word alignment */ 599 retfb=divide(srp->IN.by_off(v1)+fb + 4 -1 +7,8,24)*8 +1; 600 srp->IN.by_off(v1) = retfb; 601 do j = 2 to n; 602 if substr (unspec (v1), 36, 1) then v2 = v1+1; else v2 = v1-1; 603 x = divide(v1+1,2,24); 604 lft = s (j-1); 605 v2 = sip -> I (v2+lft); 606 v1 = sip -> I (v1+lft); 607 if v1 = 0 then v1 = v2; 608 else 609 if v2>0 then do; 610 /* below sets up pointers to records within S string */ 611 pt2 = addr(msp(v2)->S1(srp->IN.by_off(v2))); 612 pt1 = addr(msp(v1)->S1(srp->IN.by_off(v1))); 613 call sort_comp; 614 compares_counter=compares_counter+1; 615 if result = 0 then /* records ranked equal */ 616 do; 617 if v1 < v2 /* compare merge string numbers */ 618 then result = -1; /* rank record 1 first */ 619 else result = 1; /* rank record 2 first */ 620 end; 621 if result = 1 then v1 = v2; /* record 2 ranks first-switch order */ 622 end; 623 sip -> I (x+s (j)) = v1; 624 v1 = x; 625 end; 626 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; 627 628 ck_len: proc(length,action_type); 629 /* this will be called from output record exit-its function is to 630* check the length passed to it against max record length and 631* return the appropriate error code */ 632 /* */ 633 dcl length fixed bin(21) parameter, 634 action_type char(*) parameter, 635 sub_err_ entry options(variable); 636 if length > max_rec_length then 637 do; /* record too long */ 638 call sub_err_(error_table_$long_record,(whoami), "c", null(), retval, 639 "Record ^a by user output_record exit procedure.",action_type); 640 ec=error_table_$fatal_error; 641 go to exit; 642 end; 643 end ck_len; 644 end; 645 646 647 iox_error: proc(action); 648 dcl action char(*) parameter; 649 output_proc_code = error_table_$fatal_error; 650 if curr_output_file_attach = "" then 651 call sub_err_(iox_code, (whoami), "c", null(), retval, 652 " ^a output file, file name ^a", 653 action, curr_output_file_name); 654 else 655 call sub_err_(iox_code, (whoami), "c", null(), retval, 656 " ^a output file, attach description ^a", 657 action, curr_output_file_attach); 658 call cleanup_proc; 659 go to exit; 660 end iox_error; 661 662 663 cleanup_proc: proc; 664 if out_iocb_ptr = null() then return; 665 call iox_$close(out_iocb_ptr, iox_code); 666 call iox_$detach_iocb(out_iocb_ptr, iox_code); 667 call iox_$destroy_iocb(out_iocb_ptr, iox_code); 668 end cleanup_proc; 669 670 671 end sort_output_proc; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/82 1025.0 sort_output_proc.pl1 >spec>on>11/11/82>sort_output_proc.pl1 26 1 12/20/77 1614.2 sort_ext.incl.pl1 >ldd>include>sort_ext.incl.pl1 172 2 04/26/76 1500.0 sort_common.incl.pl1 >ldd>include>sort_common.incl.pl1 627 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 489* 506* 522 523 540* 550 551 595* 605 606 623* IN based structure array level 1 unaligned dcl 169 S based char(1044480) unaligned dcl 2-12 set ref 233* 233 257 313* 313 330* 330 338* 338 378* 378 477 586 3-25 3-25 3-29 3-29 3-104 3-105 3-116 3-117 3-119 3-120 S1 based char(1) array unaligned dcl 2-12 set ref 527 528 569 570 611 612 action 000111 internal static fixed bin(17,0) dcl 177 in procedure "sort_return" set ref 210* 227 227 235 282 287 293 299* 304* 309 321* 325 336 345 352 352 354* 359* 374* 376 381 381 391 396 399 405 416* 423 427* 433* action parameter char unaligned dcl 648 in procedure "iox_error" set ref 647 650* 654* action_type parameter char unaligned dcl 633 set ref 628 638* area_len 000120 internal static fixed bin(21,0) dcl 177 set ref 234* 304* 315* 332* 340* 373 374* 378 378 394* 396* 401* 403 408* 412 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 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 by_off 1 based fixed bin(30,0) array level 2 dcl 169 set ref 255 256* 474* 476 491* 527 528 569 570 585 599 600* 611 612 cleanup 000172 stack reference condition dcl 57 ref 62 close_exit_sw 000114 internal static bit(1) unaligned dcl 177 set ref 304 304* 360 374* compare_sw defined fixed bin(1,0) dcl 1-19 ref 3-17 compares_counter defined fixed bin(34,0) dcl 1-16 set ref 530* 530 572* 572 614* 614 ctr based fixed bin(30,0) array level 2 dcl 169 set ref 490* 594 597* cur_rec_ptr 000116 internal static pointer dcl 177 set ref 229* 231* 233 298* 304* 312* 313 327* 329* 330 338 350 364 372 374* 376 378 379* 393* 402 411 curr_output_file_attach defined char(256) unaligned dcl 1-31 set ref 64 65 100 104* 650 654* curr_output_file_name defined char(256) unaligned dcl 1-34 set ref 64 100* 650* data_gain_sw 000170 automatic bit(1) initial unaligned dcl 54 set ref 54* 96 97* 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 203 204* 244* dt defined fixed bin(30,0) array dcl 1-43 ref 3-24 ec parameter fixed bin(35,0) dcl 2-14 set ref 159 196* 200* 213* 235* 246* 248* 274 275* 284* 300 321 321 356* 361 386 418* 421 425* 432* 447* 453 459* 556* 558* 640* equal_key 000112 internal static fixed bin(1,0) dcl 177 set ref 208* 304* 368* 374* equal_key_sw 000121 internal static bit(1) unaligned dcl 177 set ref 207* 304* 362 374* error_table_$data_gain 000250 external static fixed bin(35,0) dcl 28 ref 95 275 error_table_$data_loss 000246 external static fixed bin(35,0) dcl 28 ref 91 246 556 error_table_$data_seq_error 000252 external static fixed bin(35,0) dcl 28 ref 99 447 459 error_table_$end_of_info 000244 external static fixed bin(35,0) dcl 28 ref 86 213 235 248 274 282 284 300 321 361 386 421 427 453 558 error_table_$fatal_error 000262 external static fixed bin(35,0) dcl 28 ref 356 418 640 649 error_table_$long_record 000260 external static fixed bin(35,0) dcl 28 set ref 638* error_table_$out_of_sequence 000254 external static fixed bin(35,0) dcl 28 ref 108 200 error_table_$request_not_recognized 000256 external static fixed bin(35,0) dcl 28 set ref 354* 416* fb parameter fixed bin(21,0) dcl 153 in procedure "sort_output_proc" set ref 152 156* fb based fixed bin(21,0) dcl 2-14 in procedure "sort_return" ref 255 260 480 589 599 fb1 based fixed bin(35,0) array dcl 3-3 in procedure "sort_comp" ref 3-43 3-43 3-47 3-47 fb1 parameter fixed bin(35,0) dcl 153 in procedure "sort_output_proc" set ref 152 156* 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 000130 internal static fixed bin(17,0) dcl 194 set ref 373* 394 hold_cur_rec_ptr 000126 internal static pointer dcl 194 set ref 372* 376 378 379 393 hold_len 000074 internal static fixed bin(21,0) dcl 177 set ref 238 410* hold_ptr 000072 internal static pointer dcl 177 set ref 237 409* i 000022 internal static fixed bin(30,0) dcl 163 set ref 488* 489 489 490 491* 517* 518 519* 594* 595 597 i1 000207 automatic fixed bin(30,0) dcl 168 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 iox_$attach_ioname 000132 constant entry external dcl 15 ref 67 iox_$close 000140 constant entry external dcl 18 ref 130 665 iox_$destroy_iocb 000144 constant entry external dcl 20 ref 147 667 iox_$detach_iocb 000142 constant entry external dcl 19 ref 138 666 iox_$open 000134 constant entry external dcl 16 ref 76 iox_$write_record 000136 constant entry external dcl 17 ref 120 iox_code 000156 automatic fixed bin(35,0) dcl 44 set ref 67* 68 76* 77 120* 121 130* 131 138* 139 147* 650* 654* 665* 666* 667* j 000016 internal static fixed bin(30,0) dcl 163 set ref 520* 521* 601* 604 623* l 000014 internal static fixed bin(30,0) dcl 163 set ref 500* 501 503 505* 505 506 508 509* 509 leng defined fixed bin(30,0) array dcl 1-68 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 length parameter fixed bin(21,0) dcl 633 ref 628 636 lft 000020 internal static fixed bin(30,0) dcl 163 set ref 518* 520 521 604* 605 606 max_rec_length defined fixed bin(30,0) dcl 1-84 ref 636 mii defined fixed bin(17,0) dcl 1-99 ref 242 435 466 488 500 mip defined fixed bin(30,0) array dcl 1-105 ref 467 595 msp defined pointer array dcl 1-108 ref 252 475 527 528 569 570 584 611 612 n 000011 internal static fixed bin(30,0) dcl 163 set ref 218* 243 467* 468 501* 502* 511* 511 517 543 601 no_extend 000161 automatic bit(1) initial dcl 44 set ref 44* 76* no_of_keys defined fixed bin(30,0) dcl 1-111 ref 3-23 ns 000023 internal static fixed bin(30,0) dcl 164 set ref 217* 243 263* 263 481* old_rec_ptr 000124 internal static pointer dcl 193 set ref 205* 453 453* 456 461* old_retp 000122 internal static pointer dcl 177 set ref 229 307* 327 438 449* out_attach_desc 000100 automatic char(176) unaligned dcl 44 set ref 64* 65* 67* out_buff_len 000167 automatic fixed bin(21,0) initial dcl 44 set ref 44* out_buff_ptr 000164 automatic pointer dcl 44 set ref 85* 120* out_iocb_ptr 000154 automatic pointer dcl 44 set ref 61* 67* 76* 120* 130* 138* 147* 148* 664 665* 666* 667* out_mode 000157 automatic fixed bin(17,0) dcl 44 set ref 75* 76* out_rec_len 000166 automatic fixed bin(21,0) dcl 44 set ref 85* 120* output_proc_code parameter fixed bin(35,0) dcl 42 set ref 12 60* 115* 649* output_rec_deleted defined fixed bin(30,0) dcl 1-123 set ref 343* 343 349* 349 388* 388 output_rec_inserted defined fixed bin(30,0) dcl 1-126 set ref 239* 239 318* 318 output_record_exit_sw defined fixed bin(1,0) dcl 1-129 ref 214 227 280 pt parameter pointer dcl 153 set ref 152 156* pt1 000212 automatic pointer dcl 2-14 set ref 364* 366 442* 444* 456* 528* 570* 612* 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 000214 automatic pointer dcl 2-14 set ref 365* 366 445* 457* 527* 569* 611* 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 rec_len_2 000104 internal static fixed bin(21,0) dcl 177 set ref 238* 297* 303 317* 330 330 332 334* 338 338 340 342* 348* 371 rec_ptr_2 000102 internal static pointer dcl 177 set ref 237* 296* 300* 302 316* 330 333* 338 341* 347* 361* 365 370 rec_ptr_a defined pointer dcl 1-145 ref 229 327 442 444 rec_ptr_b defined pointer dcl 1-148 ref 229 231 312 327 329 442 release_count defined fixed bin(30,0) dcl 1-151 ref 211 246 272 556 result 000210 automatic fixed bin(1,0) dcl 2-1 set ref 368 447 459 531 533* 535* 537 573 575* 577* 580 615 617* 619* 621 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 161 set ref 159 260* 291 297 317 334 342 348 403* 412* 480* 589* retfb 000206 automatic fixed bin(30,0) dcl 164 set ref 255* 256 257 476* 477 585* 586 599* 600 retp parameter pointer dcl 161 set ref 159 216* 252* 257* 257 259 259 290 296 316 333 341 347 402* 411* 442 445 449 453 457 461 475* 477* 477 479 479 584* 586* 586 588 588 return_count defined fixed bin(30,0) dcl 1-157 set ref 223* 223 246 262* 262 271* 271 272 556 560* 560 retval 000171 automatic fixed bin(35,0) dcl 56 in procedure "sort_output_proc" set ref 92* 96* 100* 104* 109* 650* 654* retval 000216 automatic fixed bin(35,0) dcl 174 in procedure "sort_return" set ref 354* 416* 638* rev defined fixed bin(1,0) array dcl 1-160 ref 3-129 rit 000021 internal static fixed bin(30,0) dcl 163 set ref 519* 520 539* 539 540 s 000024 internal static fixed bin(17,0) array dcl 164 set ref 502* 518 519 543 604 623 s_retbl 000100 internal static fixed bin(21,0) dcl 177 set ref 291* 410 s_retp 000076 internal static pointer dcl 177 set ref 290* 409 seq_check_sw 000113 internal static bit(1) unaligned dcl 177 set ref 209* 304* 374* 438 seq_output 000160 automatic fixed bin(17,0) initial dcl 44 set ref 44* 75 sip defined pointer dcl 1-166 ref 489 506 522 523 540 550 551 595 605 606 623 sort_code 000162 automatic fixed bin(35,0) dcl 44 set ref 85* 86 88 91 92* 95 96* 99 100* 104* 108 109* 115 sort_ext$b 000150 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 sort_ext$compare_sw 000154 external static fixed bin(1,0) dcl 1-18 ref 3-17 3-17 sort_ext$compares_counter 000152 external static fixed bin(34,0) dcl 1-15 set ref 530* 530 530 530 572* 572 572 572 614* 614 614 614 sort_ext$curr_output_file_attach 000156 external static char(256) unaligned dcl 1-30 ref 64 64 65 65 100 100 104 104 650 650 654 654 sort_ext$curr_output_file_name 000160 external static char(256) unaligned dcl 1-33 ref 64 64 100 100 650 650 sort_ext$disaster2 000162 external static fixed bin(17,0) dcl 1-39 set ref 203 203 204* 204 244* 244 sort_ext$dt 000164 external static fixed bin(30,0) array dcl 1-42 ref 3-24 3-24 sort_ext$leng 000166 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 sort_ext$max_rec_length 000170 external static fixed bin(30,0) dcl 1-82 ref 636 636 sort_ext$mii 000172 external static fixed bin(17,0) dcl 1-98 ref 242 242 435 435 466 466 488 488 500 500 sort_ext$mip 000174 external static fixed bin(30,0) array dcl 1-104 ref 467 467 595 595 sort_ext$msp 000176 external static pointer array dcl 1-107 ref 252 252 475 475 527 527 528 528 569 569 570 570 584 584 611 611 612 612 sort_ext$no_of_keys 000200 external static fixed bin(30,0) dcl 1-110 ref 3-23 3-23 sort_ext$output_rec_deleted 000202 external static fixed bin(30,0) dcl 1-122 set ref 343* 343 343 343 349* 349 349 349 388* 388 388 388 sort_ext$output_rec_inserted 000204 external static fixed bin(30,0) dcl 1-125 set ref 239* 239 239 239 318* 318 318 318 sort_ext$output_record_exit_sw 000206 external static fixed bin(1,0) dcl 1-128 ref 214 214 227 227 280 280 sort_ext$rec_ptr_a 000210 external static pointer dcl 1-144 ref 229 229 327 327 442 442 444 444 sort_ext$rec_ptr_b 000212 external static pointer dcl 1-147 ref 229 229 231 231 312 312 327 327 329 329 442 442 sort_ext$release_count 000214 external static fixed bin(30,0) dcl 1-150 ref 211 211 246 246 272 272 556 556 sort_ext$return_count 000216 external static fixed bin(30,0) dcl 1-156 set ref 223* 223 223 223 246 246 262* 262 262 262 271* 271 271 271 272 272 556 556 560* 560 560 560 sort_ext$rev 000220 external static fixed bin(1,0) array dcl 1-159 ref 3-129 3-129 sort_ext$sip 000222 external static pointer dcl 1-165 ref 489 489 506 506 522 522 523 523 540 540 550 550 551 551 595 595 605 605 606 606 623 623 sort_ext$sort_compare_exit 000224 external static entry variable dcl 1-168 ref 3-19 sort_ext$sort_output_record_exit 000226 external static entry variable dcl 1-178 ref 304 304 374 374 sort_ext$srp 000230 external static pointer dcl 1-183 ref 255 255 256 256 474 474 476 476 490 490 491 491 527 527 528 528 569 569 570 570 585 585 594 594 597 597 599 599 600 600 611 611 612 612 sort_ext$state 000232 external static fixed bin(17,0) dcl 1-192 ref 198 198 sort_ext$unique_prefix 000234 external static char(16) unaligned dcl 1-215 ref 67 67 sort_ext$w 000236 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 sort_ext$whoami 000240 external static char(6) unaligned dcl 1-227 ref 92 92 96 96 100 100 104 104 109 109 354 354 416 416 638 638 650 650 654 654 sort_ext$write_count 000242 external static fixed bin(30,0) dcl 1-230 set ref 100 100 104 104 126* 126 126 126 sort_output_record_exit defined entry variable dcl 1-180 ref 304 374 srp defined pointer dcl 1-184 ref 255 256 474 476 490 491 527 528 569 570 585 594 597 599 600 611 612 state defined fixed bin(17,0) dcl 1-193 ref 198 sub_err_ 000146 constant entry external dcl 21 in procedure "sort_output_proc" ref 92 96 100 104 109 354 416 650 654 sub_err_ 000264 constant entry external dcl 633 in procedure "ck_len" ref 638 t 000010 internal static fixed bin(30,0) dcl 163 set ref 499* 502 506 508* 508 u_rec_len_2 000110 internal static fixed bin(21,0) dcl 177 set ref 233 233 234 303* 304* 311* 313 313 315 371* 374* 407* u_rec_ptr_2 000106 internal static pointer dcl 177 set ref 233 302* 304* 313 370* 374* unique_prefix defined char(16) unaligned dcl 1-216 ref 67 v1 000012 internal static fixed bin(30,0) dcl 163 set ref 435* 522* 528 528 533 537* 540 550* 552 563 564* 570 570 575 581* 584 585 594 595 595 597 599 600 602 602 602 603 606* 606 607 607* 612 612 617 621* 623 624* v2 000013 internal static fixed bin(30,0) dcl 163 set ref 523* 524 527 527 533 537 551* 553 564 566 569 569 575 581 602* 602* 605* 605 607 608 611 611 617 621 w defined fixed bin(30,0) array dcl 1-219 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 w_p 000070 internal static pointer dcl 2-14 set ref 255 259* 260 479* 480 588* 589 599 whoami defined char(6) unaligned dcl 1-228 ref 92 96 100 104 109 354 416 638 650 654 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 write_count defined fixed bin(30,0) dcl 1-231 set ref 100 104 126* 126 x 000015 internal static fixed bin(30,0) dcl 163 set ref 521* 522 523 603* 623 624 y 000017 internal static fixed bin(30,0) dcl 163 set ref 543* 550 551 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. R based structure array level 1 unaligned dcl 2-3 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 debug_sw defined bit(1) unaligned dcl 1-37 error_table_$not_attached external static fixed bin(35,0) dcl 28 error_table_$not_closed external static fixed bin(35,0) dcl 28 error_table_$not_detached external static fixed bin(35,0) dcl 28 error_table_$not_open external static fixed bin(35,0) dcl 28 in_buff_ptr defined pointer dcl 1-65 input_driver_is_sort defined bit(1) unaligned dcl 1-46 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 merge_in_iocb_ptrs defined pointer array dcl 1-90 merge_input_file_attaches defined char(256) array unaligned dcl 1-93 merge_input_file_names defined char(256) array unaligned dcl 1-96 min_rec_length defined fixed bin(30,0) dcl 1-102 np internal static fixed bin(30,0) dcl 164 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 read_count defined fixed bin(30,0) dcl 1-142 report_sw defined bit(2) unaligned dcl 1-154 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$debug_sw external static bit(1) unaligned dcl 1-36 sort_ext$in_buff_ptr external static pointer dcl 1-64 sort_ext$input_driver_is_sort external static bit(1) unaligned dcl 1-45 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$merge_in_iocb_ptrs external static pointer array dcl 1-89 sort_ext$merge_input_file_attaches external static char(256) array unaligned dcl 1-92 sort_ext$merge_input_file_names external static char(256) array unaligned dcl 1-95 sort_ext$min_rec_length external static fixed bin(30,0) dcl 1-101 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$read_count external static fixed bin(30,0) dcl 1-141 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$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_input_record_exit defined entry variable dcl 1-175 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 NAMES DECLARED BY EXPLICIT CONTEXT. A0 002405 constant entry internal dcl 465 ref 222 A1 002657 constant entry internal dcl 548 ref 270 544 A2 003017 constant entry internal dcl 592 ref 269 ck_len 003573 constant entry internal dcl 628 ref 311 396 401 407 408 cleanup_proc 004066 constant entry internal dcl 663 ref 62 111 116 658 close 001034 constant label dcl 130 ref 86 93 con 002337 constant label dcl 449 in procedure "sort_return" con 003572 constant label dcl 3-130 in procedure "sort_comp" ref 3-20 ent 001415 constant label dcl 299 ref 350 esc 003565 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 001112 constant label dcl 150 in procedure "sort_output_proc" ref 112 117 659 exit 002404 constant label dcl 463 in procedure "sort_return" ref 357 419 641 g_a_w 001211 constant label dcl 227 ref 323 397 in 001357 constant label dcl 278 ref 219 240 319 iox_error 003673 constant entry internal dcl 647 ref 71 81 124 134 143 lab 000000 constant label array(10) dcl 3-25 ref 3-24 next_key 003561 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 001344 constant label dcl 272 ref 224 265 retrieve 000406 constant label dcl 85 set ref 127 return 001117 constant entry external dcl 152 sim 002100 constant label dcl 399 ref 360 sort_comp 003204 constant entry internal dcl 3-1 ref 366 446 458 529 571 613 sort_output_proc 000231 constant entry external dcl 12 sort_return 001141 constant entry internal dcl 159 ref 85 156 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 257 477 527 528 569 570 586 611 612 3-101 3-103 3-113 3-115 divide builtin function ref 255 509 599 603 fixed builtin function ref 259 479 588 null builtin function ref 61 92 92 96 96 100 100 104 104 109 109 148 205 216 298 300 307 350 354 354 361 366 366 416 416 438 453 638 638 650 650 654 654 664 ptr builtin function ref 259 479 588 rel builtin function ref 259 479 588 substr builtin function set ref 233 233 257 313* 313 330* 330 338* 338 378* 378 477 503 586 602 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 503 602 3-64 3-66 3-92 3-93 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4704 5172 4171 4714 Length 5662 4171 266 453 513 122 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME sort_output_proc 560 external procedure is an external procedure. on unit on line 62 64 on unit sort_return internal procedure shares stack frame of external procedure sort_output_proc. A0 internal procedure shares stack frame of external procedure sort_output_proc. A1 internal procedure shares stack frame of external procedure sort_output_proc. A2 internal procedure shares stack frame of external procedure sort_output_proc. sort_comp internal procedure shares stack frame of external procedure sort_output_proc. ck_len internal procedure shares stack frame of external procedure sort_output_proc. iox_error internal procedure shares stack frame of external procedure sort_output_proc. cleanup_proc 70 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 t sort_return 000011 n sort_return 000012 v1 sort_return 000013 v2 sort_return 000014 l sort_return 000015 x sort_return 000016 j sort_return 000017 y sort_return 000020 lft sort_return 000021 rit sort_return 000022 i sort_return 000023 ns sort_return 000024 s sort_return 000070 w_p sort_return 000072 hold_ptr sort_return 000074 hold_len sort_return 000076 s_retp sort_return 000100 s_retbl sort_return 000102 rec_ptr_2 sort_return 000104 rec_len_2 sort_return 000106 u_rec_ptr_2 sort_return 000110 u_rec_len_2 sort_return 000111 action sort_return 000112 equal_key sort_return 000113 seq_check_sw sort_return 000114 close_exit_sw sort_return 000116 cur_rec_ptr sort_return 000120 area_len sort_return 000121 equal_key_sw sort_return 000122 old_retp sort_return 000124 old_rec_ptr sort_return 000126 hold_cur_rec_ptr sort_return 000130 hold_area_len sort_return STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME sort_output_proc 000100 out_attach_desc sort_output_proc 000154 out_iocb_ptr sort_output_proc 000156 iox_code sort_output_proc 000157 out_mode sort_output_proc 000160 seq_output sort_output_proc 000161 no_extend sort_output_proc 000162 sort_code sort_output_proc 000164 out_buff_ptr sort_output_proc 000166 out_rec_len sort_output_proc 000167 out_buff_len sort_output_proc 000170 data_gain_sw sort_output_proc 000171 retval sort_output_proc 000206 retfb sort_return 000207 i1 sort_return 000210 result sort_return 000212 pt1 sort_return 000214 pt2 sort_return 000216 retval sort_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. alloc_cs call_var call_ext_out_desc call_ext_out call_int_this call_int_other return enable shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. iox_$attach_ioname iox_$close iox_$destroy_iocb iox_$detach_iocb iox_$open iox_$write_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_$long_record error_table_$out_of_sequence error_table_$request_not_recognized sort_ext$b sort_ext$compare_sw sort_ext$compares_counter sort_ext$curr_output_file_attach sort_ext$curr_output_file_name sort_ext$disaster2 sort_ext$dt sort_ext$leng sort_ext$max_rec_length sort_ext$mii sort_ext$mip 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$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$srp sort_ext$state sort_ext$unique_prefix sort_ext$w sort_ext$whoami sort_ext$write_count LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 44 000216 54 000223 12 000226 60 000237 61 000241 62 000243 64 000265 65 000310 67 000314 68 000347 71 000351 75 000360 76 000362 77 000377 81 000401 85 000406 86 000410 88 000414 91 000416 92 000420 93 000464 95 000465 96 000467 97 000535 98 000537 99 000540 100 000542 104 000632 107 000714 108 000715 109 000717 111 000771 112 000775 115 000776 116 001000 117 001004 120 001005 121 001022 124 001024 126 001031 127 001033 130 001034 131 001045 134 001047 138 001054 139 001065 143 001067 147 001077 148 001110 150 001112 152 001113 156 001125 157 001140 159 001141 196 001143 198 001144 200 001150 201 001152 203 001153 204 001155 205 001157 207 001161 208 001162 209 001164 210 001166 211 001170 213 001172 214 001174 216 001177 217 001201 218 001203 219 001204 222 001205 223 001206 224 001210 227 001211 229 001222 231 001232 233 001235 234 001242 235 001244 237 001252 238 001254 239 001256 240 001257 242 001260 243 001263 244 001266 246 001270 248 001277 250 001302 252 001303 255 001307 256 001320 257 001321 259 001325 260 001333 262 001335 263 001336 265 001337 269 001340 270 001341 271 001342 272 001344 274 001347 275 001354 276 001356 278 001357 280 001360 282 001363 284 001366 285 001371 287 001372 290 001374 291 001400 293 001402 296 001405 297 001411 298 001413 299 001415 300 001417 302 001425 303 001427 304 001431 307 001462 309 001465 311 001470 312 001506 313 001512 315 001517 316 001521 317 001525 318 001527 319 001530 321 001531 323 001536 325 001537 327 001541 329 001551 330 001554 332 001561 333 001563 334 001567 335 001571 336 001572 338 001574 340 001602 341 001604 342 001610 343 001612 344 001613 345 001614 347 001616 348 001622 349 001624 350 001625 351 001631 352 001632 354 001636 356 001711 357 001715 359 001716 360 001717 361 001723 362 001731 364 001735 365 001737 366 001741 368 001752 370 001755 371 001757 372 001761 373 001763 374 001765 376 002013 378 002023 379 002031 381 002032 386 002037 388 002043 389 002044 391 002045 393 002050 394 002052 396 002054 397 002077 399 002100 401 002102 402 002120 403 002124 404 002126 405 002127 407 002131 408 002147 409 002166 410 002171 411 002173 412 002176 413 002200 416 002201 418 002254 419 002260 421 002261 423 002265 425 002270 427 002271 429 002273 432 002274 433 002275 435 002277 438 002301 442 002311 444 002321 445 002324 446 002327 447 002330 449 002337 451 002344 453 002345 456 002362 457 002364 458 002367 459 002370 461 002377 463 002404 465 002405 466 002406 467 002412 468 002414 470 002416 474 002417 475 002423 476 002427 477 002433 479 002437 480 002445 481 002447 483 002451 488 002452 489 002461 490 002464 491 002472 492 002474 499 002476 500 002477 501 002501 502 002507 503 002512 505 002515 506 002516 508 002522 509 002524 510 002526 511 002530 517 002532 518 002542 519 002544 520 002547 521 002557 522 002561 523 002565 524 002570 527 002571 528 002603 529 002615 530 002616 531 002620 533 002622 535 002630 537 002632 539 002636 540 002637 541 002644 542 002647 543 002651 544 002655 545 002656 548 002657 550 002660 551 002666 552 002670 553 002673 556 002676 558 002705 560 002710 561 002713 563 002714 564 002716 565 002720 566 002721 569 002723 570 002735 571 002747 572 002750 573 002752 575 002754 577 002762 580 002764 581 002766 584 002770 585 002776 586 003002 588 003006 589 003014 590 003016 592 003017 594 003020 595 003031 597 003040 599 003042 600 003051 601 003052 602 003062 602 003071 603 003074 604 003100 605 003103 606 003110 607 003114 608 003120 611 003122 612 003134 613 003146 614 003147 615 003151 617 003153 619 003161 621 003163 623 003167 624 003177 625 003201 626 003203 3 1 003204 3 17 003205 3 19 003210 3 20 003222 3 21 003224 3 23 003225 3 24 003233 3 25 003236 3 29 003251 3 33 003255 3 34 003256 3 38 003271 3 42 003275 3 43 003276 3 47 003305 3 51 003310 3 52 003311 3 56 003323 3 60 003326 3 61 003327 3 63 003331 3 64 003332 3 66 003342 3 67 003346 3 68 003354 3 70 003357 3 71 003360 3 75 003367 3 79 003372 3 80 003373 3 84 003405 3 88 003410 3 89 003411 3 91 003413 3 92 003414 3 93 003424 3 95 003430 3 96 003436 3 98 003441 3 99 003442 3 101 003445 3 102 003447 3 103 003452 3 104 003454 3 105 003467 3 107 003473 3 108 003502 3 110 003505 3 111 003506 3 113 003511 3 114 003513 3 115 003516 3 116 003520 3 117 003533 3 119 003537 3 120 003543 3 122 003546 3 123 003555 3 125 003560 3 126 003561 3 127 003563 3 128 003564 3 129 003565 3 131 003572 628 003573 636 003604 638 003611 640 003665 641 003671 643 003672 647 003673 649 003704 650 003710 654 003777 658 004060 659 004064 663 004065 664 004073 665 004100 666 004110 667 004122 668 004134 ----------------------------------------------------------- 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