COMPILATION LISTING OF SEGMENT examine_object_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1644.1 mst Mon 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 11 12 examine_object_: proc(seg_ptr, bit_count, segment_name, archive_name, prog_list, total); 13 14 /* examine_object_ - examine the segment identified by seg_ptr and determine if it is a PL/I object segment that uses unaligned decimal data */ 15 16 /* Written by Peter C. Krupp on January 14, 1978 */ 17 18 19 dcl seg_ptr pointer; 20 dcl (segment_name, archive_name) character(*); 21 dcl prog_list(3) file variable; 22 dcl total(3) fixed bin; 23 24 dcl (addr, bin, hbound, string, substr, ltrim) builtin; 25 26 1 1 /* BEGIN INCLUDE FILE ... object_info.incl.pl1 1 2*coded February 8, 1972 by Michael J. Spier */ 1 3 /* modified May 26, 1972 by M. Weaver */ 1 4 /* modified 15 April, 1975 by M. Weaver */ 1 5 1 6 declare 1 object_info aligned based, /* structure containing object info based, returned by object_info_ */ 1 7 2 version_number fixed bin, /* version number of current structure format (=2) */ 1 8 2 textp pointer, /* pointer to beginning of text section */ 1 9 2 defp pointer, /* pointer to beginning of definition section */ 1 10 2 linkp pointer, /* pointer to beginning of linkage section */ 1 11 2 statp pointer, /* pointer to beginning of static section */ 1 12 2 symbp pointer, /* pointer to beginning of symbol section */ 1 13 2 bmapp pointer, /* pointer to beginning of break map (may be null) */ 1 14 2 tlng fixed bin, /* length in words of text section */ 1 15 2 dlng fixed bin, /* length in words of definition section */ 1 16 2 llng fixed bin, /* length in words of linkage section */ 1 17 2 ilng fixed bin, /* length in words of static section */ 1 18 2 slng fixed bin, /* length in words of symbol section */ 1 19 2 blng fixed bin, /* length in words of break map */ 1 20 2 format, /* word containing bit flags about object type */ 1 21 3 old_format bit(1) unaligned, /* on if segment isn't in new format, i.e. has old style object map */ 1 22 3 bound bit(1) unaligned, /* on if segment is bound */ 1 23 3 relocatable bit(1) unaligned, /* on if seg has relocation info in its first symbol block */ 1 24 3 procedure bit(1) unaligned, /* on if segment is an executable object program */ 1 25 3 standard bit(1) unaligned, /* on if seg is in standard format (more than just standard map) */ 1 26 3 gate bit(1) unaligned, /* on if segment is a gate */ 1 27 3 separate_static bit(1) unaligned, /* on if static not in linkage */ 1 28 3 links_in_text bit(1) unaligned, /* on if there are threaded links in text */ 1 29 3 perprocess_static bit (1) unaligned, /* on if static is not to be per run unit */ 1 30 3 pad bit(27) unaligned, 1 31 2 entry_bound fixed bin, /* entry bound if segment is a gate */ 1 32 2 textlinkp pointer, /* ptr to first link in text */ 1 33 1 34 /* LIMIT OF BRIEF STRUCTURE */ 1 35 1 36 2 compiler char(8) aligned, /* name of processor which generated segment */ 1 37 2 compile_time fixed bin(71), /* clock reading of date/time object was generated */ 1 38 2 userid char(32) aligned, /* standard Multics id of creator of object segment */ 1 39 2 cvers aligned, /* generator version name in printable char string form */ 1 40 3 offset bit(18) unaligned, /* offset of name in words relative to base of symbol section */ 1 41 3 length bit(18) unaligned, /* length of name in characters */ 1 42 2 comment aligned, /* printable comment concerning generator or generation of segment */ 1 43 3 offset bit(18) unaligned, /* offset of comment in words relative to base of symbol section */ 1 44 3 length bit(18) unaligned, /* length of comment in characters */ 1 45 2 source_map fixed bin, /* offset, relative to base of symbol section, of source map structure */ 1 46 1 47 /* LIMIT OF DISPLAY STRUCTURE */ 1 48 1 49 2 rel_text pointer, /* pointer to text section relocation info */ 1 50 2 rel_def pointer, /* pointer to definition section relocation info */ 1 51 2 rel_link pointer, /* pointer to linkage section relocation info */ 1 52 2 rel_static pointer, /* pointer to static section relocation info */ 1 53 2 rel_symbol pointer, /* pointer to symbol section relocation info */ 1 54 2 text_boundary fixed bin, /* specifies mod of text section base boundary */ 1 55 2 static_boundary fixed bin, /* specifies mod of internal static base boundary */ 1 56 /* currently not used by system */ 1 57 2 default_truncate fixed bin, /* offset rel to symbp for binder to automatically trunc. symb sect. */ 1 58 2 optional_truncate fixed bin; /* offset rel to symbp for binder to optionally trunc. symb sect. */ 1 59 1 60 declare object_info_version_2 fixed bin int static init(2); 1 61 1 62 /* END INCLUDE FILE ... object_info.incl.pl1 */ 27 28 29 dcl object_info_$long entry (ptr, fixed bin(24), ptr, fixed bin(35)); 30 31 dcl decimal_use_code fixed bin; 32 dcl decimal_use_record char(256) varying; 33 34 dcl 1 info like object_info; 35 36 dcl bit_count fixed bin(24); 37 dcl code fixed bin(35); 38 39 info.version_number=2; 40 call object_info_$long (seg_ptr, bit_count, addr(info), code); 41 if code^=0 42 then return; 43 44 if info.compiler^="PL/I" & info.compiler^="v2pl1" 45 then return; 46 47 decimal_use_code=type_object_segment(); 48 total(decimal_use_code)=total(decimal_use_code)+1; 49 decimal_use_record=ltrim(archive_name || " " || segment_name); 50 if decimal_use_code^=1 51 then write file(prog_list(decimal_use_code)) from(decimal_use_record); 52 53 return; 54 55 56 /* type_object_segment - classify a PL/I segment according to its use of arithmetic decimal instructions */ 57 58 type_object_segment: 59 procedure returns(fixed bin); 60 61 dcl 1 pl1$op_mnemonic(0:1023) ext static aligned, 62 2 (opcode char(6), 63 dtype fixed bin(2), /* 0-desc9a, 1-descb, 2-decimal */ 64 num_desc fixed bin(5), 65 num_words fixed bin(8)) unaligned; 66 67 dcl 1 instruction based(text_ptr) aligned, 68 2 (base bit(3), 69 offset bit(15), 70 op_code bit(10), 71 unused bit(1), 72 ext_base bit(1), 73 tag bit(6)) unaligned; 74 75 dcl 1 mod_factor aligned, 76 2 (ext_base bit(1), 77 length_in_reg bit(1), 78 indirect_descriptor bit(1), 79 tag bit(4)) unaligned; 80 81 dcl mf(3) fixed bin(6) int static init(30,12,3); 82 83 dcl eis_modifier(0:15) char(3) aligned int static 84 init("n","au","qu","du","ic","al","ql","dl","x0","x1","x2","x3","x4","x5","x6","x7"); 85 86 dcl 1 descriptor based aligned, 87 2 (address bit(18), 88 char bit(3), 89 nsd_type bit(3), 90 scale_factor bit(6), 91 length bit(6)) unaligned; 92 93 dcl (text_offset,max_text_offset) fixed bin; 94 dcl dec_data bit(1); 95 dcl text_ptr pointer; 96 dcl mop fixed bin; 97 98 99 text_offset=0; 100 max_text_offset=info.tlng-1; 101 dec_data="0"b; 102 103 do while(text_offset<=max_text_offset); 104 text_ptr=addrel(info.textp,text_offset); 105 mop=bin(instruction.op_code); 106 if opcode(mop)^=" " 107 then do; 108 if num_words(mop)^=1 & dtype(mop)=2 & dec_arith(opcode(mop)) 109 then do; 110 dec_data="1"b; 111 if unaligned_data(text_ptr) 112 then return(3); /* unaligned decimal data found */ 113 end; 114 text_offset=text_offset+num_words(mop); 115 end; 116 else text_offset=text_offset+1; 117 end; 118 119 if dec_data 120 then return(2); /* only word aligned decimal data */ 121 122 return(1); /* no decimal data found */ 123 124 125 /* dec_arith - is opcode an arithmetic decimal opcode */ 126 127 dec_arith: 128 procedure(opcode) returns(bit(1) aligned); 129 130 dcl opcode char(6); 131 132 dcl dec_arith_ops(8) char(6) aligned int static 133 init("ad2d","ad3d","sb2d","sb3d","mp2d","mp3d","dv2d","dv3d"); 134 135 dcl i fixed bin; 136 137 138 do i=1 to hbound(dec_arith_ops,1); 139 if opcode=dec_arith_ops(i) 140 then do; 141 do i=1 to num_desc(mop); 142 if addrel(text_ptr,i)->nsd_type ^= "001"b & addrel(text_ptr,i)->nsd_type ^= "000"b 143 then return("0"b); 144 end; 145 return("1"b); 146 end; 147 end; 148 149 return("0"b); 150 151 end dec_arith; 152 153 /* unaligned_data - determines whether or not the EIS instruction identified by inst_ptr accesses unaligned data */ 154 155 unaligned_data: 156 procedure(inst_ptr) returns(bit(1) aligned); 157 158 dcl inst_ptr ptr; 159 dcl i fixed bin; 160 161 162 do i=1 to num_desc(mop); 163 if addrel(inst_ptr,i)->descriptor.char^="000"b 164 then return("1"b); /* unaligned - nonzero digit offset */ 165 string(mod_factor)=substr(string(inst_ptr->instruction),mf(i),7); 166 if eis_modifier(bin(mod_factor.tag))^="n" & eis_modifier(bin(mod_factor.tag))^="ic" 167 then return("1"b); /* unaligned - address modification */ 168 end; 169 170 return("0"b); /* all data aligned - zero digit offsets and no address modification */ 171 172 end unaligned_data; 173 174 end type_object_segment; 175 176 end examine_object_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1506.3 examine_object_.pl1 >dumps>old>recomp>examine_object_.pl1 27 1 08/05/77 1022.5 object_info.incl.pl1 >ldd>include>object_info.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 24 ref 40 40 archive_name parameter char unaligned dcl 20 ref 12 49 bin builtin function dcl 24 ref 105 166 166 bit_count parameter fixed bin(24,0) dcl 36 set ref 12 40* char 0(18) based bit(3) level 2 packed unaligned dcl 86 ref 163 code 000270 automatic fixed bin(35,0) dcl 37 set ref 40* 41 compiler 30 000202 automatic char(8) level 2 dcl 34 set ref 44 44 dec_arith_ops 000000 constant char(6) initial array dcl 132 ref 138 139 dec_data 000363 automatic bit(1) unaligned dcl 94 set ref 101* 110* 119 decimal_use_code 000100 automatic fixed bin(17,0) dcl 31 set ref 47* 48 48 50 50 decimal_use_record 000101 automatic varying char(256) dcl 32 set ref 49* 50 descriptor based structure level 1 dcl 86 dtype 1(18) 000012 external static fixed bin(2,0) array level 2 packed unaligned dcl 61 ref 108 eis_modifier 000020 constant char(3) initial array dcl 83 ref 166 166 hbound builtin function dcl 24 ref 138 i 000376 automatic fixed bin(17,0) dcl 135 in procedure "dec_arith" set ref 138* 139 141* 142 142* i 000414 automatic fixed bin(17,0) dcl 159 in procedure "unaligned_data" set ref 162* 163 165* info 000202 automatic structure level 1 unaligned dcl 34 set ref 40 40 inst_ptr parameter pointer dcl 158 ref 155 163 165 instruction based structure level 1 dcl 67 ref 165 ltrim builtin function dcl 24 ref 49 max_text_offset 000362 automatic fixed bin(17,0) dcl 93 set ref 100* 103 mf 000040 constant fixed bin(6,0) initial array dcl 81 ref 165 mod_factor 000360 automatic structure level 1 dcl 75 set ref 165* mop 000366 automatic fixed bin(17,0) dcl 96 set ref 105* 106 108 108 108 114 141 162 nsd_type 0(21) based bit(3) level 2 packed unaligned dcl 86 ref 142 142 num_desc 1(21) 000012 external static fixed bin(5,0) array level 2 packed unaligned dcl 61 ref 141 162 num_words 1(27) 000012 external static fixed bin(8,0) array level 2 packed unaligned dcl 61 ref 108 114 object_info based structure level 1 dcl 1-6 object_info_$long 000010 constant entry external dcl 29 ref 40 op_code 0(18) based bit(10) level 2 packed unaligned dcl 67 ref 105 opcode 000012 external static char(6) array level 2 in structure "pl1$op_mnemonic" packed unaligned dcl 61 in procedure "type_object_segment" set ref 106 108* opcode parameter char(6) unaligned dcl 130 in procedure "dec_arith" ref 127 139 pl1$op_mnemonic 000012 external static structure array level 1 dcl 61 prog_list parameter file variable array dcl 21 ref 12 50 seg_ptr parameter pointer dcl 19 set ref 12 40* segment_name parameter char unaligned dcl 20 ref 12 49 string builtin function dcl 24 set ref 165* 165 substr builtin function dcl 24 ref 165 tag 0(03) 000360 automatic bit(4) level 2 packed unaligned dcl 75 set ref 166 166 text_offset 000361 automatic fixed bin(17,0) dcl 93 set ref 99* 103 104 114* 114 116* 116 text_ptr 000364 automatic pointer dcl 95 set ref 104* 105 111* 142 142 textp 2 000202 automatic pointer level 2 dcl 34 set ref 104 tlng 16 000202 automatic fixed bin(17,0) level 2 dcl 34 set ref 100 total parameter fixed bin(17,0) array dcl 22 set ref 12 48* 48 version_number 000202 automatic fixed bin(17,0) level 2 dcl 34 set ref 39* NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. object_info_version_2 internal static fixed bin(17,0) initial dcl 1-60 NAMES DECLARED BY EXPLICIT CONTEXT. dec_arith 000404 constant entry internal dcl 127 ref 108 examine_object_ 000074 constant entry external dcl 12 type_object_segment 000250 constant entry internal dcl 58 ref 47 unaligned_data 000470 constant entry internal dcl 155 ref 111 NAME DECLARED BY CONTEXT OR IMPLICATION. addrel builtin function ref 104 142 142 163 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 640 654 573 650 Length 1044 573 14 153 45 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME examine_object_ 308 external procedure is an external procedure. type_object_segment internal procedure shares stack frame of external procedure examine_object_. dec_arith internal procedure shares stack frame of external procedure examine_object_. unaligned_data internal procedure shares stack frame of external procedure examine_object_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME examine_object_ 000100 decimal_use_code examine_object_ 000101 decimal_use_record examine_object_ 000202 info examine_object_ 000270 code examine_object_ 000360 mod_factor type_object_segment 000361 text_offset type_object_segment 000362 max_text_offset type_object_segment 000363 dec_data type_object_segment 000364 text_ptr type_object_segment 000366 mop type_object_segment 000376 i dec_arith 000414 i unaligned_data THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as alloc_cs cat_realloc_cs call_ext_out return shorten_stack ext_entry_desc record_io THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. object_info_$long THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. pl1$op_mnemonic LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 12 000066 39 000117 40 000121 41 000140 44 000142 47 000153 48 000155 49 000161 50 000231 53 000247 58 000250 99 000252 100 000253 101 000256 103 000257 104 000262 105 000265 106 000271 108 000307 110 000344 111 000346 114 000357 115 000367 116 000370 117 000371 119 000372 122 000400 127 000404 138 000406 139 000413 141 000423 142 000440 144 000455 145 000457 147 000463 149 000465 155 000470 162 000472 163 000507 165 000521 166 000530 168 000552 170 000554 ----------------------------------------------------------- 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