COMPILATION LISTING OF SEGMENT decode_descriptor_ Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 1006.8 mst Sat Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 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 /* */ 16 /* Name: decode_descriptor_ */ 17 /* */ 18 /* This subroutine decodes an argument descriptor, returning from the descriptor */ 19 /* the argument type, a packing indicator, the number of dimensions in the argument, */ 20 /* and the size and scale of the argument. */ 21 /* */ 22 /* Status */ 23 /* */ 24 /* 1) Modified on: September 16, 1975 by Gary C. Dixon */ 25 /* a) bug fixed in decoding of new area descriptors; they had been treated as having */ 26 /* both size and scale; they now have only size. */ 27 /* */ 28 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 29 30 /* Last modified (date and reason): 31* Aug 9, 1977 by S. Webber to make better use of static storage 32* Modified 771026 by PG to handle packed-decimal and unsigned descriptor types 33* Modified 780407 by PG to delete packed-ptr descriptor code */ 34 /* Changed for extended data types, removed V1 support 10/20/83 M. Weaver */ 35 /* Modified Dec.14, 1983 by M. Weaver to make size arg fixed bin (24) */ 36 37 decode_descriptor_: 38 proc (P_arg_list_ptr, P_num, P_type, P_packed, P_ndims, P_size, P_scale); 39 40 41 /* Parameters */ 42 43 dcl P_arg_list_ptr ptr; /* Points to either arg_list or descriptor (Input) */ 44 dcl P_num fixed bin; /* index of arg, 0 => P_arg_list_ptr points to descrip */ 45 dcl P_type fixed bin; /* data type (Output) */ 46 dcl P_packed bit (1) aligned; /* "1"b if P_packed (Output) */ 47 dcl P_ndims fixed bin; /* number of array dims (Output) */ 48 dcl P_size fixed bin (24); /* string size or arithmetic precision (Output) */ 49 dcl P_scale fixed bin; /* arithmetic scale (Output) */ 50 51 /* Automatic */ 52 53 dcl arg_count fixed bin; 54 55 /* Constants */ 56 57 dcl new_type (518:528) fixed bin int static options (constant) 58 /* Conversion table for old-style to new-style */ 59 init (18, /* 518 -> Area */ 60 19, /* 519 -> BS */ 61 21, /* 520 -> CS */ 62 20, /* 521 -> VBS */ 63 22, /* 522 -> VCS */ 64 17, /* 523 -> A-structure */ 65 18, /* 524 -> A-area */ 66 19, /* 525 -> ABS */ 67 21, /* 526 -> ACS */ 68 20, /* 527 -> AVBS */ 69 22); /* 528 -> AVCS */ 70 71 dcl (AREA_TYPE init (18), 72 REAL_FIXED_DEC_LS_OVER_TYPE init (29), 73 EXTENSION_TYPE init (58)) fixed bin int static options (constant); 74 75 /* Based */ 76 1 1 /* BEGIN INCLUDE FILE ... arg_descriptor.incl.pl1 1 2* 1 3* James R. Davis 1 Mar 79 */ 1 4 /* Modified June 83 JMAthane for extended arg descriptor format */ 1 5 1 6 dcl 1 arg_descriptor based (arg_descriptor_ptr) aligned, 1 7 2 flag bit (1) unal, 1 8 2 type fixed bin (6) unsigned unal, 1 9 2 packed bit (1) unal, 1 10 2 number_dims fixed bin (4) unsigned unal, 1 11 2 size fixed bin (24) unsigned unal; 1 12 1 13 dcl 1 fixed_arg_descriptor based (arg_descriptor_ptr) aligned, 1 14 2 flag bit (1) unal, 1 15 2 type fixed bin (6) unsigned unal, 1 16 2 packed bit (1) unal, 1 17 2 number_dims fixed bin (4) unsigned unal, 1 18 2 scale fixed bin (11) unal, 1 19 2 precision fixed bin (12) unsigned unal; 1 20 1 21 dcl 1 extended_arg_descriptor based (arg_descriptor_ptr) aligned, 1 22 2 flag bit (1) unal, /* = "1"b */ 1 23 2 type fixed bin (6) unsigned unal, /* = 58 */ 1 24 2 packed bit (1) unal, /* significant if number_dims ^= 0 */ 1 25 2 number_dims fixed (4) unsigned unal,/* number of variable dimensions */ 1 26 2 size bit (24) unal, 1 27 2 dims (0 refer (extended_arg_descriptor.number_dims)), /* part referenced by called generated code */ 1 28 3 low fixed bin (35), 1 29 3 high fixed bin (35), 1 30 3 multiplier fixed bin (35), /* in bits if packed, in words if not */ 1 31 2 real_type fixed bin (18) unsigned unal, 1 32 2 type_offset fixed bin (18) unsigned unal; /* offset rel to symbol tree to symbol node for type, if any */ 1 33 1 34 dcl arg_descriptor_ptr ptr; 1 35 1 36 dcl extended_arg_type fixed bin init (58); 1 37 1 38 /* END INCLUDE file .... arg_descriptor.incl.pl1 */ 77 2 1 /* BEGIN INCLUDE FILE ... arg_list.incl.pl1 2 2* 2 3* James R. Davis 10 May 79 */ 2 4 2 5 2 6 2 7 /****^ HISTORY COMMENTS: 2 8* 1) change(86-05-15,DGHowe), approve(86-05-15,MCR7375), 2 9* audit(86-07-15,Schroth): 2 10* added command_name_arglist declaration to allow the storage of the 2 11* command name given to the command processor 2 12* END HISTORY COMMENTS */ 2 13 2 14 dcl 1 arg_list aligned based, 2 15 2 header, 2 16 3 arg_count fixed bin (17) unsigned unal, 2 17 3 pad1 bit (1) unal, 2 18 3 call_type fixed bin (18) unsigned unal, 2 19 3 desc_count fixed bin (17) unsigned unal, 2 20 3 pad2 bit (19) unal, 2 21 2 arg_ptrs (arg_list_arg_count refer (arg_list.arg_count)) ptr, 2 22 2 desc_ptrs (arg_list_arg_count refer (arg_list.arg_count)) ptr; 2 23 2 24 2 25 dcl 1 command_name_arglist aligned based, 2 26 2 header, 2 27 3 arg_count fixed bin (17) unsigned unal, 2 28 3 pad1 bit (1) unal, 2 29 3 call_type fixed bin (18) unsigned unal, 2 30 3 desc_count fixed bin (17) unsigned unal, 2 31 3 mbz bit(1) unal, 2 32 3 has_command_name bit(1) unal, 2 33 3 pad2 bit (17) unal, 2 34 2 arg_ptrs (arg_list_arg_count refer (command_name_arglist.arg_count)) ptr, 2 35 2 desc_ptrs (arg_list_arg_count refer (command_name_arglist.arg_count)) ptr, 2 36 2 name, 2 37 3 command_name_ptr pointer, 2 38 3 command_name_length fixed bin (21); 2 39 2 40 2 41 2 42 dcl 1 arg_list_with_envptr aligned based, /* used with non-quick int and entry-var calls */ 2 43 2 header, 2 44 3 arg_count fixed bin (17) unsigned unal, 2 45 3 pad1 bit (1) unal, 2 46 3 call_type fixed bin (18) unsigned unal, 2 47 3 desc_count fixed bin (17) unsigned unal, 2 48 3 pad2 bit (19) unal, 2 49 2 arg_ptrs (arg_list_arg_count refer (arg_list_with_envptr.arg_count)) ptr, 2 50 2 envptr ptr, 2 51 2 desc_ptrs (arg_list_arg_count refer (arg_list_with_envptr.arg_count)) ptr; 2 52 2 53 2 54 dcl ( 2 55 Quick_call_type init (0), 2 56 Interseg_call_type init (4), 2 57 Envptr_supplied_call_type 2 58 init (8) 2 59 ) fixed bin (18) unsigned unal int static options (constant); 2 60 2 61 /* The user must declare arg_list_arg_count - if an adjustable automatic structure 2 62* is being "liked" then arg_list_arg_count may be a parameter, in order to allocate 2 63* an argument list of the proper size in the user's stack 2 64* 2 65**/ 2 66 /* END INCLUDE FILE ... arg_list.incl.pl1 */ 78 79 80 if P_num = 0 then do; 81 82 arg_descriptor_ptr = P_arg_list_ptr; /* points directly at the descriptor */ 83 go to CHECK; 84 end; 85 86 arg_count = P_arg_list_ptr -> arg_list.header.arg_count; 87 88 if P_num > arg_count then do; 89 BAD_DESCRIPTOR: 90 P_type = -1; 91 return; 92 end; 93 94 if P_arg_list_ptr -> arg_list.header.desc_count = 0 then go to BAD_DESCRIPTOR; 95 96 if P_arg_list_ptr -> arg_list.header.call_type = Envptr_supplied_call_type then 97 arg_descriptor_ptr = P_arg_list_ptr -> arg_list_with_envptr.desc_ptrs (P_num); 98 else arg_descriptor_ptr = P_arg_list_ptr -> arg_list.desc_ptrs (P_num); 99 CHECK: 100 if ^arg_descriptor.flag then go to BAD_DESCRIPTOR; /* Version 1 or invalid */ 101 102 P_type = arg_descriptor.type; 103 P_packed = arg_descriptor.packed; 104 P_ndims = arg_descriptor.number_dims; 105 106 if P_type = EXTENSION_TYPE | 107 (P_type >= AREA_TYPE & P_type < REAL_FIXED_DEC_LS_OVER_TYPE) then do; 108 109 P_size = arg_descriptor.size; 110 P_scale = 0; 111 end; 112 else do; 113 P_size = fixed_arg_descriptor.precision; 114 P_scale = fixed_arg_descriptor.scale; 115 end; 116 117 if P_type = EXTENSION_TYPE then P_type = extended_arg_descriptor.real_type; 118 119 return; 120 121 end decode_descriptor_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0803.9 decode_descriptor_.pl1 >spec>install>1110>decode_descriptor_.pl1 77 1 11/02/83 1845.0 arg_descriptor.incl.pl1 >ldd>include>arg_descriptor.incl.pl1 78 2 08/05/86 0856.8 arg_list.incl.pl1 >ldd>include>arg_list.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. AREA_TYPE constant fixed bin(17,0) initial dcl 71 ref 106 EXTENSION_TYPE constant fixed bin(17,0) initial dcl 71 ref 106 117 Envptr_supplied_call_type constant fixed bin(18,0) initial packed unsigned unaligned dcl 2-54 ref 96 P_arg_list_ptr parameter pointer dcl 43 ref 37 82 86 94 96 96 98 P_ndims parameter fixed bin(17,0) dcl 47 set ref 37 104* P_num parameter fixed bin(17,0) dcl 44 ref 37 80 88 96 98 P_packed parameter bit(1) dcl 46 set ref 37 103* P_scale parameter fixed bin(17,0) dcl 49 set ref 37 110* 114* P_size parameter fixed bin(24,0) dcl 48 set ref 37 109* 113* P_type parameter fixed bin(17,0) dcl 45 set ref 37 89* 102* 106 106 106 117 117* REAL_FIXED_DEC_LS_OVER_TYPE constant fixed bin(17,0) initial dcl 71 ref 106 arg_count based fixed bin(17,0) level 3 in structure "arg_list_with_envptr" packed packed unsigned unaligned dcl 2-42 in procedure "decode_descriptor_" ref 96 arg_count based fixed bin(17,0) level 3 in structure "arg_list" packed packed unsigned unaligned dcl 2-14 in procedure "decode_descriptor_" ref 86 98 arg_count 000100 automatic fixed bin(17,0) dcl 53 in procedure "decode_descriptor_" set ref 86* 88 arg_descriptor based structure level 1 dcl 1-6 arg_descriptor_ptr 000102 automatic pointer dcl 1-34 set ref 82* 96* 98* 99 102 103 104 109 113 114 117 arg_list based structure level 1 dcl 2-14 arg_list_with_envptr based structure level 1 dcl 2-42 call_type 0(18) based fixed bin(18,0) level 3 packed packed unsigned unaligned dcl 2-14 ref 96 desc_count 1 based fixed bin(17,0) level 3 packed packed unsigned unaligned dcl 2-14 ref 94 desc_ptrs based pointer array level 2 in structure "arg_list_with_envptr" dcl 2-42 in procedure "decode_descriptor_" ref 96 desc_ptrs based pointer array level 2 in structure "arg_list" dcl 2-14 in procedure "decode_descriptor_" ref 98 extended_arg_descriptor based structure level 1 dcl 1-21 extended_arg_type 000104 automatic fixed bin(17,0) initial dcl 1-36 set ref 1-36* fixed_arg_descriptor based structure level 1 dcl 1-13 flag based bit(1) level 2 packed packed unaligned dcl 1-6 ref 99 header based structure level 2 in structure "arg_list_with_envptr" dcl 2-42 in procedure "decode_descriptor_" header based structure level 2 in structure "arg_list" dcl 2-14 in procedure "decode_descriptor_" number_dims 0(08) based fixed bin(4,0) level 2 in structure "arg_descriptor" packed packed unsigned unaligned dcl 1-6 in procedure "decode_descriptor_" ref 104 number_dims 0(08) based fixed bin(4,0) level 2 in structure "extended_arg_descriptor" packed packed unsigned unaligned dcl 1-21 in procedure "decode_descriptor_" ref 117 packed 0(07) based bit(1) level 2 packed packed unaligned dcl 1-6 ref 103 precision 0(24) based fixed bin(12,0) level 2 packed packed unsigned unaligned dcl 1-13 ref 113 real_type based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1-21 ref 117 scale 0(12) based fixed bin(11,0) level 2 packed packed unaligned dcl 1-13 ref 114 size 0(12) based fixed bin(24,0) level 2 packed packed unsigned unaligned dcl 1-6 ref 109 type 0(01) based fixed bin(6,0) level 2 packed packed unsigned unaligned dcl 1-6 ref 102 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Interseg_call_type internal static fixed bin(18,0) initial packed unsigned unaligned dcl 2-54 Quick_call_type internal static fixed bin(18,0) initial packed unsigned unaligned dcl 2-54 command_name_arglist based structure level 1 dcl 2-25 new_type internal static fixed bin(17,0) initial array dcl 57 NAMES DECLARED BY EXPLICIT CONTEXT. BAD_DESCRIPTOR 000037 constant label dcl 89 ref 94 99 CHECK 000102 constant label dcl 99 ref 83 decode_descriptor_ 000012 constant entry external dcl 37 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 206 216 160 216 Length 412 160 10 160 26 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME decode_descriptor_ 71 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME decode_descriptor_ 000100 arg_count decode_descriptor_ 000102 arg_descriptor_ptr decode_descriptor_ 000104 extended_arg_type decode_descriptor_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return_mac 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 37 000004 1 36 000017 80 000021 82 000024 83 000027 86 000030 88 000034 89 000037 91 000042 94 000043 96 000047 98 000071 99 000102 102 000105 103 000111 104 000115 106 000121 109 000130 110 000133 111 000134 113 000135 114 000140 117 000144 119 000157 ----------------------------------------------------------- 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