COMPILATION LISTING OF SEGMENT cobol_find_secdef 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 1012.7 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_find_secdef.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 11/18/76 by ORN to eliminate cobol_version_unique include file */ 23 /* Modified since Version 2.0 */ 24 25 /* format: style3 */ 26 cobol_find_secdef: 27 proc (type8_ptr, sectno, hashptr, retptr); 28 29 /* DECLARATION OF THE PARAMETERS */ 30 31 dcl type8_ptr ptr; /* Points to the "type 8" record that contains the name of the section being searched 32* for. (input) */ 33 34 dcl sectno fixed bin (15); /* Contains the section number of the section being searched for. (input) */ 35 36 dcl hashptr ptr; /* Points to the string base table. (input) */ 37 38 dcl retptr ptr; /* Points to the name table buffer entry of the found section definition. If 39* the section name is not found in this load of the name table buffer, retptr is set 40* to "null()". (output) */ 41 42 43 44 dcl 1 procname based (retptr), 45 2 size fixed bin (15), 46 2 line fixed bin (15), 47 2 column fixed bin (7), 48 2 type fixed bin (7), 49 2 string_ptr ptr, 50 2 prev_rec ptr, 51 2 info1 bit (1), 52 2 info2 bit (1), 53 2 info3 bit (1), 54 2 info4 bit (1), 55 2 info5 bit (1), 56 2 info6 bit (1), 57 2 info7 bit (1), 58 2 info8 bit (1), 59 2 priority char (2), 60 2 repl_bits bit (8), 61 2 section_num fixed bin (15), 62 2 proc_num fixed bin (15), 63 2 def_line fixed bin (15), 64 2 length fixed bin (7), 65 2 name char (30); 66 67 dcl template char (500) based (retptr); 68 dcl temp_array (500) char (1) based (retptr);/*[*/ 69 dcl arrpntr (1:512) ptr based (hashptr); /*]*/ 70 /*[[[ 71*dcl arrpntr(1:256) ptr based (hashptr); ]]]*/ 72 73 dcl aname char (30); 74 dcl alength fixed bin (15); 75 dcl i fixed bin (7); 76 77 dcl hashno fixed bin (15); 78 dcl n1 fixed bin (15) based (name_size_ptr); 79 dcl name_size_ptr ptr; 80 dcl n fixed bin (15); 81 dcl 1 auser_word based (type8_ptr), 82 2 size fixed bin (15), 83 2 line fixed bin (15), 84 2 column fixed bin (7), 85 2 type fixed bin (7), 86 2 info1 bit (1), 87 2 info2 bit (1), 88 2 info3 bit (6), 89 2 length fixed bin (7), 90 2 word char (30); /*[*/ 91 dcl addr builtin; 92 dcl fixed builtin; 93 dcl mod builtin; 94 dcl null builtin; 95 dcl substr builtin; 96 dcl unspec builtin; /*]*/ 97 98 99 start: 100 substr (aname, 1, auser_word.length) = substr (auser_word.word, 1, auser_word.length); 101 alength = auser_word.length; 102 call hash; /* HASH THE SECTION NAME */ 103 104 retptr = arrpntr (hashno); /* Get a pointer to the first entry in the name table buffer string 105* with this hash code */ 106 107 /* TRY TO FIND THE SECTION NAME IN THE NAME TABLE BUFFER */ 108 109 do while (retptr ^= null ()); 110 111 if procname.type = 18 112 then do; /* The current entry in the name table buffer pointed at by retptr is a section name */ 113 114 n = size_TOKEN (procname.type) - 3; 115 name_size_ptr = addr (temp_array (n)); 116 if alength = n1 /* lengths equal? */ 117 then if substr (aname, 1, alength) = substr (template, n + 4, alength) 118 /* names the same? */ 119 then if auser_word.column = procname.proc_num 120 then do; 121 if procname.info5 122 then sectno = procname.section_num; 123 return; 124 end; 125 126 end; /* The current entry in the name table buffer pointed at by retptr is a section name */ 127 128 retptr = procname.string_ptr; /* Get a pointer to the previous entry in this string of names */ 129 130 end; /* DO WHILE */ 131 132 /* When we drop thru to here, retptr is "null()", and the search has not been successful */ 133 134 return; /* Simply return */ 135 136 hash: 137 proc; /* AGAIN !!! */ 138 139 hashno = 0; 140 do i = 1 to alength; 141 hashno = hashno + fixed (unspec (substr (aname, i, 1)), 15); 142 end; 143 144 /*[*/ 145 hashno = mod (hashno, 512) + 1; /*]*/ 146 /*[[[ hashno=mod(hashno,256)+1; ]]]*/ 147 148 end hash; 149 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_size_values.incl.pl1 */ 1 3 /* Last modified on 11/18/76 by ORN */ 1 4 1 5 /* This include file contains constant values associated with 1 6*the fixed sizes of Multics COBOL tokens and other data */ 1 7 1 8 dcl size_COMHDR fixed bin static options(constant) init(56); 1 9 dcl size_NAMESIZE fixed bin static options(constant) init(4); 1 10 1 11 dcl size_TOKEN (40) fixed bin static options(constant) init( 1 12 /* TOKEN NUMBER NAME STRUCTURE PTR SIZE (fixed portion in bytes) */ 1 13 /* 1 reserved word reserved_word rw_ptr */ 28, 1 14 /* 2 numeric literal numeric_lit nlit_ptr */ 36, 1 15 /* 3 alphanumeric literal alphanum_lit alit_ptr */ 24, 1 16 /* 4 */ 0, 1 17 /* 5 diagnostic message message message_ptr */ 32, 1 18 /* 6 */ 0, 1 19 /* 7 procedure definition proc_def proc_def_ptr */ 52, 1 20 /* 8 user word user_word */ 24, 1 21 /* 9 data name data_name dn_ptr */ 112, 1 22 /* 10 index name index_name ind_ptr */ 80, 1 23 /* 11 */ 52, 1 24 /* 12 file name fd_token name_ptr */ 48, 1 25 /* 13 communication name cdtoken cdtoken_ptr */ 64, 1 26 /* 14 */ 100, 1 27 /* 15 */ 68, 1 28 /* 16 sort file name (use type 12 structure) */ 48, 1 29 /* 17 mnemonic name mnemonic_name name_ptr */ 56, 1 30 /* 18 procedure reference proc_ref proc_ref_ptr */ 52, 1 31 /* 19 end statement end_stmt eos_ptr */ 38, 1 32 /* 20 */ 120, 1 33 /* 21 */ 84, 1 34 /* 22 */ 56, 1 35 /* 23 */ 0, 1 36 /* 24 */ 0, 1 37 /* 25 */ 0, 1 38 /* 26 */ 0, 1 39 /* 27 */ 0, 1 40 /* 28 */ 0, 1 41 /* 29 */ 0, 1 42 /* 30 internal tag int_tag tag_ptr */ 49, 1 43 /* 31 equate tag equate_tags equate_ptr */ 37, 1 44 /* 32 */ 0, 1 45 /* 33 */ 0, 1 46 /* 34 */ 0, 1 47 /* 35 */ 0, 1 48 /* 36 */ 0, 1 49 /* 37 */ 0, 1 50 /* 38 */ 0, 1 51 /* 39 */ 0, 1 52 /* 40 alphabet name alphabet_name alpha_name_ptr */ 580); 1 53 /* 100 internal register cobol_type100 cobol_type100_ptr 17 */ 1 54 /* 102 immediate constant immed_const immed_const_ptr 20 */ 1 55 1 56 /* END INCLUDE FILE ... cobol_size_values.incl.pl1 */ 1 57 150 151 152 end cobol_find_secdef; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0835.3 cobol_find_secdef.pl1 >spec>install>MR12.3-1048>cobol_find_secdef.pl1 150 1 03/27/82 0439.8 cobol_size_values.incl.pl1 >ldd>include>cobol_size_values.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. addr builtin function dcl 91 ref 115 alength 000110 automatic fixed bin(15,0) dcl 74 set ref 101* 116 116 116 140 aname 000100 automatic char(30) packed unaligned dcl 73 set ref 99* 116 141 arrpntr based pointer array dcl 69 ref 104 auser_word based structure level 1 unaligned dcl 81 column 2 based fixed bin(7,0) level 2 dcl 81 ref 116 fixed builtin function dcl 92 ref 141 hashno 000112 automatic fixed bin(15,0) dcl 77 set ref 104 139* 141* 141 145* 145 hashptr parameter pointer dcl 36 ref 26 104 i 000111 automatic fixed bin(7,0) dcl 75 set ref 140* 141* info5 10(04) based bit(1) level 2 packed packed unaligned dcl 44 ref 121 length 5 based fixed bin(7,0) level 2 dcl 81 ref 99 99 101 mod builtin function dcl 93 ref 145 n 000116 automatic fixed bin(15,0) dcl 80 set ref 114* 115 116 n1 based fixed bin(15,0) dcl 78 ref 116 name_size_ptr 000114 automatic pointer dcl 79 set ref 115* 116 null builtin function dcl 94 ref 109 proc_num 12 based fixed bin(15,0) level 2 dcl 44 ref 116 procname based structure level 1 unaligned dcl 44 retptr parameter pointer dcl 38 set ref 26 104* 109 111 114 115 116 116 121 121 128* 128 section_num 11 based fixed bin(15,0) level 2 dcl 44 ref 121 sectno parameter fixed bin(15,0) dcl 34 set ref 26 121* size_TOKEN 000000 constant fixed bin(17,0) initial array dcl 1-11 ref 114 string_ptr 4 based pointer level 2 dcl 44 ref 128 substr builtin function dcl 95 set ref 99* 99 116 116 141 temp_array based char(1) array packed unaligned dcl 68 set ref 115 template based char(500) packed unaligned dcl 67 ref 116 type 3 based fixed bin(7,0) level 2 dcl 44 ref 111 114 type8_ptr parameter pointer dcl 31 ref 26 99 99 99 101 116 unspec builtin function dcl 96 ref 141 word 6 based char(30) level 2 packed packed unaligned dcl 81 ref 99 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. size_COMHDR internal static fixed bin(17,0) initial dcl 1-8 size_NAMESIZE internal static fixed bin(17,0) initial dcl 1-9 NAMES DECLARED BY EXPLICIT CONTEXT. cobol_find_secdef 000061 constant entry external dcl 26 hash 000160 constant entry internal dcl 136 ref 102 start 000066 constant label dcl 99 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 240 250 211 250 Length 434 211 10 147 26 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_find_secdef 87 external procedure is an external procedure. hash internal procedure shares stack frame of external procedure cobol_find_secdef. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_find_secdef 000100 aname cobol_find_secdef 000110 alength cobol_find_secdef 000111 i cobol_find_secdef 000112 hashno cobol_find_secdef 000114 name_size_ptr cobol_find_secdef 000116 n cobol_find_secdef THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return_mac mdfx1 ext_entry NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 26 000054 99 000066 101 000075 102 000077 104 000100 109 000107 111 000115 114 000122 115 000125 116 000131 121 000146 123 000153 128 000154 130 000156 134 000157 136 000160 139 000161 140 000162 141 000171 142 000200 145 000202 148 000207 ----------------------------------------------------------- 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