COMPILATION LISTING OF SEGMENT cobol_MSORT_ Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1028.5 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_MSORT_.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* format: style3 */ 23 cobol_MSORT_: 24 proc; /* Version 2. */ 25 26 /* 27* cobol_MSORT_ (a special version of SORT) inputs three data structures and a comparison 28* procedure. The "records" specified by the data structures are sorted according 29* to the comparison procedure and moved into the "next" merge storage areas (three 30* similar data structures). 31* 32* The array I (based on SIp) contains SIi entries. Each value in I is the index 33* to a row in R (based on SRp). Each row of R contains two values, a 34* first bit and the number of bits in a "record" located in the S string (based 35* on SSp). The records are sorted according to the procedure pointed to by "cmp". 36* The result is stored in an R table and S string, in a sorted order, based on 37* the pointers "rp" and "sp". A row in the I array (based on MIp) contains the 38* number of records for the "next" merge string. 39**/ 40 i = cobol_SM_$MIi + 1; /* Count the merge strings. */ 41 if i > cobol_SM_$max4 42 then do; 43 cobol_SM_$ec = 4; 44 signal condition (SORTM_STOP); 45 end; /* Create the next merge string R and S segments. */ 46 if cobol_FILE_$OUT ("cobol_MSORT_", (cobol_SM_$sort_dir), "SRTM.MR." || cobol_NUMS_ (i), "rwa", rp) 47 | cobol_FILE_$OUT ("cobol_MSORT_", (cobol_SM_$sort_dir), "SRTM.MS." || cobol_NUMS_ (i), "rwa", sp) 48 then do; 49 cobol_SM_$ec = 5; 50 signal condition (SORTM_STOP); 51 end; 52 53 if i = 1 54 then cmpe = cobol_SM_$cmp; /* Assign the comparison procedure 55* at the first call. */ 56 cobol_SM_$MIi = i; 57 cobol_SM_$MIp -> I (i) = cobol_SM_$SIi; /* The number of "records" in the "next" merge store. */ 58 cobol_SM_$MRp (i) = rp; /* Pointer to "next" merge R table. */ 59 cobol_SM_$MSp (i) = sp; /* Pointer to "next" merge S string. */ 60 61 /* 62* calculate the lengths of 63* lists and their start pointers 64* in a linear set. 65**/ 66 t = 0; 67 l = cobol_SM_$SIi; 68 do n = 1 by 1 while (l > 1); 69 cobol_SM_$s (n) = t; /* start of the next list. */ 70 if substr (unspec (l), 36, 1) 71 then l = l + 1; /* make the length even. */ 72 t = t + l; /* accumulate the lengths. */ 73 l = l / 2; /* next list is 1/2 the length of the present list. */ 74 end; 75 n = n - 1; 76 77 /* fill in all lists. */ 78 do i = 2 to n; 79 lft = cobol_SM_$s (i - 1); 80 rit = cobol_SM_$s (i); 81 do j = 1 by 2 to (rit - lft); 82 x = lft + j; 83 v1 = cobol_SM_$SIp -> I (x); 84 v2 = cobol_SM_$SIp -> I (x + 1); 85 if v2 > 0 86 then do; 87 cobol_SM_$fb1 = cobol_SM_$SRp -> R.pt (v1); 88 cobol_SM_$bl1 = cobol_SM_$SRp -> R.ln (v1); 89 cobol_SM_$fb2 = cobol_SM_$SRp -> R.pt (v2); 90 cobol_SM_$bl2 = cobol_SM_$SRp -> R.ln (v2); 91 call cmpe; 92 if cobol_SM_$result > 0 93 then v1 = v2; 94 end; 95 rit = rit + 1; 96 cobol_SM_$SIp -> I (rit) = v1; 97 end; 98 end; 99 100 /* calculate the list of pointers in o */ 101 y = cobol_SM_$s (n) + 1; 102 do i = 1 to cobol_SM_$SIi; 103 v1 = cobol_SM_$SIp -> I (y); 104 v2 = cobol_SM_$SIp -> I (y + 1); 105 if (v1 = 0) & (v2 = 0) 106 then i = cobol_SM_$SIi + 1; /* End "i" loop. */ 107 else do; 108 if v1 = 0 109 then v1 = v2; 110 else if v2 > 0 111 then do; 112 cobol_SM_$fb1 = cobol_SM_$SRp -> R.pt (v1); 113 cobol_SM_$bl1 = cobol_SM_$SRp -> R.ln (v1); 114 cobol_SM_$fb2 = cobol_SM_$SRp -> R.pt (v2); 115 cobol_SM_$bl2 = cobol_SM_$SRp -> R.ln (v2); 116 call cmpe; 117 if cobol_SM_$result > 0 118 then v1 = v2; 119 end; /* Move the next sorted record to the merge string. */ 120 l = cobol_SM_$SRp -> R.ln (v1); 121 substr (sp -> S, ns, l) = substr (cobol_SM_$SSp -> S, cobol_SM_$SRp -> R.pt (v1), l); 122 np = np + 1; 123 rp -> R.pt (np) = ns; /* Location of merge record. */ 124 rp -> R.ln (np) = l; /* The length of the merge record. */ 125 ns = ns + l; 126 cobol_SM_$SIp -> I (v1) = 0; /* delete the last winner. */ 127 do j = 2 to n; /* get the next winner. */ 128 lft = cobol_SM_$s (j - 1); 129 if substr (unspec (v1), 36, 1) 130 then v2 = v1 + 1; 131 else v2 = v1 - 1; 132 x = (v1 + 1) / 2; 133 v1 = cobol_SM_$SIp -> I (v1 + lft); 134 v2 = cobol_SM_$SIp -> I (v2 + lft); 135 if v1 = 0 136 then v1 = v2; 137 else if v2 > 0 138 then do; 139 cobol_SM_$fb1 = cobol_SM_$SRp -> R.pt (v1); 140 cobol_SM_$bl1 = cobol_SM_$SRp -> R.ln (v1); 141 cobol_SM_$fb2 = cobol_SM_$SRp -> R.pt (v2); 142 cobol_SM_$bl2 = cobol_SM_$SRp -> R.ln (v2); 143 call cmpe; 144 if cobol_SM_$result > 0 145 then v1 = v2; 146 end; 147 cobol_SM_$SIp -> I (x + cobol_SM_$s (j)) = v1; 148 v1 = x; 149 end; 150 end; 151 end; 152 dcl ( 153 cobol_SM_$SIp, 154 cobol_SM_$SSp, 155 cobol_SM_$MIp, 156 cobol_SM_$MRp (1000), 157 cobol_SM_$MSp (1000), 158 cobol_SM_$SRp 159 ) ptr ext, 160 ( 161 cobol_SM_$SIi, 162 cobol_SM_$s (36), 163 cobol_SM_$ec, 164 cobol_SM_$fb1, 165 cobol_SM_$fb2, 166 cobol_SM_$bl1, 167 cobol_SM_$bl2, 168 cobol_SM_$result, 169 cobol_SM_$max4, 170 cobol_SM_$MIi 171 ) fixed bin (35) ext, 172 cobol_SM_$sort_dir char (168) var ext, 173 cobol_SM_$cmp entry variable ext, 174 (sp, rp) ptr, 175 S bit (2359296) aligned based, 176 I (65536) fixed bin (35) aligned based, 177 1 R (32768) aligned based, 178 2 pt fixed bin (35), 179 2 ln fixed bin (35), 180 cobol_NUMS_ entry (fixed bin (35)) ext returns (char (13) var), 181 cobol_FILE_$OUT entry (char (*), char (*), char (*), char (*), ptr) ext returns (bit (1)), 182 cmpe entry variable static internal, 183 SORTM_STOP condition ext, 184 ( 185 ns init (1), 186 np init (0) 187 ) fixed bin (35), 188 (t, n, v1, v2, l, x, j, y, lft, rit, i) 189 fixed bin (35) static internal; 190 191 192 /***** Declaration for builtin function *****/ 193 194 dcl (substr, mod, binary, fixed, addr, addrel, rel, length, string, unspec, null, index) 195 builtin; 196 197 /***** End of declaration for builtin function *****/ 198 199 end cobol_MSORT_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0837.3 cobol_MSORT_.pl1 >spec>install>MR12.3-1048>cobol_MSORT_.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(35,0) array dcl 152 set ref 57* 83 84 96* 103 104 126* 133 134 147* R based structure array level 1 dcl 152 S based bit(2359296) dcl 152 set ref 121* 121 SORTM_STOP 000104 stack reference condition dcl 152 ref 44 50 cmpe 000010 internal static entry variable dcl 152 set ref 53* 91 116 143 cobol_FILE_$OUT 000076 constant entry external dcl 152 ref 46 46 cobol_NUMS_ 000074 constant entry external dcl 152 ref 46 46 cobol_SM_$MIi 000066 external static fixed bin(35,0) dcl 152 set ref 40 56* cobol_SM_$MIp 000034 external static pointer dcl 152 ref 57 cobol_SM_$MRp 000036 external static pointer array dcl 152 set ref 58* cobol_SM_$MSp 000040 external static pointer array dcl 152 set ref 59* cobol_SM_$SIi 000044 external static fixed bin(35,0) dcl 152 ref 57 67 102 105 cobol_SM_$SIp 000030 external static pointer dcl 152 ref 83 84 96 103 104 126 133 134 147 cobol_SM_$SRp 000042 external static pointer dcl 152 ref 87 88 89 90 112 113 114 115 120 121 139 140 141 142 cobol_SM_$SSp 000032 external static pointer dcl 152 ref 121 cobol_SM_$bl1 000056 external static fixed bin(35,0) dcl 152 set ref 88* 113* 140* cobol_SM_$bl2 000060 external static fixed bin(35,0) dcl 152 set ref 90* 115* 142* cobol_SM_$cmp 000072 external static entry variable dcl 152 ref 53 cobol_SM_$ec 000050 external static fixed bin(35,0) dcl 152 set ref 43* 49* cobol_SM_$fb1 000052 external static fixed bin(35,0) dcl 152 set ref 87* 112* 139* cobol_SM_$fb2 000054 external static fixed bin(35,0) dcl 152 set ref 89* 114* 141* cobol_SM_$max4 000064 external static fixed bin(35,0) dcl 152 ref 41 cobol_SM_$result 000062 external static fixed bin(35,0) dcl 152 ref 92 117 144 cobol_SM_$s 000046 external static fixed bin(35,0) array dcl 152 set ref 69* 79 80 101 128 147 cobol_SM_$sort_dir 000070 external static varying char(168) dcl 152 ref 46 46 i 000026 internal static fixed bin(35,0) dcl 152 set ref 40* 41 46* 46* 53 56 57 58 59 78* 79 80* 102* 105* j 000022 internal static fixed bin(35,0) dcl 152 set ref 81* 82* 127* 128 147* l 000020 internal static fixed bin(35,0) dcl 152 set ref 67* 68 70 70* 70 72 73* 73 120* 121 121 124 125 lft 000024 internal static fixed bin(35,0) dcl 152 set ref 79* 81 82 128* 133 134 ln 1 based fixed bin(35,0) array level 2 dcl 152 set ref 88 90 113 115 120 124* 140 142 n 000015 internal static fixed bin(35,0) dcl 152 set ref 68* 69* 75* 75 78 101 127 np 000113 automatic fixed bin(35,0) initial dcl 152 set ref 122* 122 123 124 152* ns 000112 automatic fixed bin(35,0) initial dcl 152 set ref 121 123 125* 125 152* pt based fixed bin(35,0) array level 2 dcl 152 set ref 87 89 112 114 121 123* 139 141 rit 000025 internal static fixed bin(35,0) dcl 152 set ref 80* 81 95* 95 96 rp 000102 automatic pointer dcl 152 set ref 46* 58 123 124 sp 000100 automatic pointer dcl 152 set ref 46* 59 121 substr builtin function dcl 194 set ref 70 121* 121 129 t 000014 internal static fixed bin(35,0) dcl 152 set ref 66* 69 72* 72 unspec builtin function dcl 194 ref 70 129 v1 000016 internal static fixed bin(35,0) dcl 152 set ref 83* 87 88 92* 96 103* 105 108 108* 112 113 117* 120 121 126 129 129 131 132 133* 133 135 135* 139 140 144* 147 148* v2 000017 internal static fixed bin(35,0) dcl 152 set ref 84* 85 89 90 92 104* 105 108 110 114 115 117 129* 131* 134* 134 135 137 141 142 144 x 000021 internal static fixed bin(35,0) dcl 152 set ref 82* 83 84 132* 147 148 y 000023 internal static fixed bin(35,0) dcl 152 set ref 101* 103 104 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. addr builtin function dcl 194 addrel builtin function dcl 194 binary builtin function dcl 194 fixed builtin function dcl 194 index builtin function dcl 194 length builtin function dcl 194 mod builtin function dcl 194 null builtin function dcl 194 rel builtin function dcl 194 string builtin function dcl 194 NAME DECLARED BY EXPLICIT CONTEXT. cobol_MSORT_ 000023 constant entry external dcl 23 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1204 1304 1023 1214 Length 1542 1023 100 222 161 20 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_MSORT_ 138 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 cmpe cobol_MSORT_ 000014 t cobol_MSORT_ 000015 n cobol_MSORT_ 000016 v1 cobol_MSORT_ 000017 v2 cobol_MSORT_ 000020 l cobol_MSORT_ 000021 x cobol_MSORT_ 000022 j cobol_MSORT_ 000023 y cobol_MSORT_ 000024 lft cobol_MSORT_ 000025 rit cobol_MSORT_ 000026 i cobol_MSORT_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_MSORT_ 000100 sp cobol_MSORT_ 000102 rp cobol_MSORT_ 000112 ns cobol_MSORT_ 000113 np cobol_MSORT_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ent_var call_ext_out_desc call_ext_out return_mac signal_op shorten_stack ext_entry trunc_fx2 divide_fx1 divide_fx3 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_FILE_$OUT cobol_NUMS_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_SM_$MIi cobol_SM_$MIp cobol_SM_$MRp cobol_SM_$MSp cobol_SM_$SIi cobol_SM_$SIp cobol_SM_$SRp cobol_SM_$SSp cobol_SM_$bl1 cobol_SM_$bl2 cobol_SM_$cmp cobol_SM_$ec cobol_SM_$fb1 cobol_SM_$fb2 cobol_SM_$max4 cobol_SM_$result cobol_SM_$s cobol_SM_$sort_dir LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 23 000022 152 000030 40 000033 41 000037 43 000041 44 000043 46 000046 49 000261 50 000265 53 000270 56 000301 57 000302 58 000307 59 000314 66 000317 67 000320 68 000322 69 000330 70 000334 72 000343 73 000347 74 000356 75 000363 78 000371 79 000400 80 000403 81 000406 82 000423 83 000427 84 000433 85 000436 87 000437 88 000446 89 000450 90 000455 91 000457 92 000463 95 000470 96 000474 97 000501 98 000506 101 000513 102 000521 103 000532 104 000537 105 000541 108 000552 110 000557 112 000561 113 000570 114 000572 115 000577 116 000601 117 000605 120 000612 121 000621 122 000635 123 000641 124 000646 125 000650 126 000654 127 000660 128 000670 129 000673 131 000703 132 000711 133 000722 134 000730 135 000734 137 000741 139 000743 140 000752 141 000754 142 000761 143 000763 144 000767 147 000774 148 001005 149 001007 151 001014 199 001021 ----------------------------------------------------------- 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