COMPILATION LISTING OF SEGMENT list_arg_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1823.5 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 11 list_arg_: proc(argno,atype,ap); 12 13 dcl argno fixed bin (18), 14 atype char (1) aligned; 15 16 17 dcl argp ptr, 18 decode_descriptor_ entry(ptr,fixed bin(18),fixed bin(18),bit(1) aligned, 19 fixed bin(18),fixed bin(18),fixed bin(18)), 20 ioa_$ioa_stream ext entry options(variable), 21 (i,min_arg,max_arg,type) fixed bin (18), 22 c72 char (72) aligned, 23 bit17 bit (17) unaligned based (argp), 24 fword fixed bin (18) based (argp), 25 flword float bin based (argp), 26 dblword float bin(63) based (argp), 27 (no_args,no_desc,j,strl,ndims,scale) fixed bin (18), 28 packed bit(1) aligned, 29 bit_string bit (strl) based (argp), 30 char_string char(strl) based (argp); 31 1 1 /* BEGIN INCLUDE FILE . . . db_ext_stat_.incl.pl1 1 2* * 1 3* * This include file is used to reference the common data that is passed from the 1 4* * main debug procedure "debug" to other debug procedures. This data is in db_ext_stat_.alm 1 5* * 1 6* * modified 7/75 by S.E. Barr for the break instructions 1 7**/ 1 8 1 9 dcl 1 db_ext_stat_$db_ext_stat_ ext static aligned, 1 10 1 11 2 debug_input char (32) aligned, /* Input switch name. Initially "user_input" */ 1 12 2 debug_output char (32) aligned, /* output switch name. Initially "user_output" */ 1 13 2 return_label label, /* The label used to do a non local goto out of debug when 1 14* it was entered via a fault. It will go to debug in 1 15* another frame. */ 1 16 1 17 2 debug_io_ptr (2) ptr, /* pointers to iocb for i/o 1 18* 1 = input switch iocb ptr 1 19* 2 = output switch iocb ptr */ 1 20 2 flags aligned, 1 21 3 debug_io_attach (2) bit (1) unaligned, /* 1= debug made the attachment */ 1 22 3 debug_io_open (2) bit (1) unaligned, /* 1 = debug opened the switch */ 1 23 3 in_debug bit (1) unaligned, /* Switch for the any_other condition. 0 = send the 1 24* condition on; 1 = use the debug condition handler */ 1 25 3 static_handler_call bit (1) unal, /* ON if mme2 call from static handler */ 1 26 3 pad bit (30) unaligned; /* Reserved for future use */ 1 27 dcl db_ext_stat_$break_instructions (9) bit (36) ext static aligned; 1 28 1 29 /* END OF INCLUDE FILE ... db_ext_stat_.incl.pl1 */ 32 33 34 dcl based_p ptr based; 35 36 37 dcl 1 lv based, 38 2 ptr ptr, 39 2 stack ptr; 40 2 1 /* BEGIN INCLUDE FILE its.incl.pl1 2 2* modified 27 July 79 by JRDavis to add its_unsigned 2 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 2 4 2 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 2 6 2 pad1 bit (3) unaligned, 2 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 2 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 2 9 2 pad2 bit (9) unaligned, 2 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 2 11 2 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 2 13 2 pad3 bit (3) unaligned, 2 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 2 15 2 pad4 bit (3) unaligned, 2 16 2 mod bit (6) unaligned; /* further modification */ 2 17 2 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 2 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 2 20 2 pad1 bit (27) unaligned, 2 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 2 22 2 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 2 24 2 pad2 bit (3) unaligned, 2 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 2 26 2 pad3 bit (3) unaligned, 2 27 2 mod bit (6) unaligned; /* further modification */ 2 28 2 29 2 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 2 31 2 pad1 bit (3) unaligned, 2 32 2 segno fixed bin (15) unsigned unaligned, 2 33 2 ringno fixed bin (3) unsigned unaligned, 2 34 2 pad2 bit (9) unaligned, 2 35 2 its_mod bit (6) unaligned, 2 36 2 37 2 offset fixed bin (18) unsigned unaligned, 2 38 2 pad3 bit (3) unaligned, 2 39 2 bit_offset fixed bin (6) unsigned unaligned, 2 40 2 pad4 bit (3) unaligned, 2 41 2 mod bit (6) unaligned; 2 42 2 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 2 44 2 pr_no fixed bin (3) unsigned unaligned, 2 45 2 pad1 bit (27) unaligned, 2 46 2 itp_mod bit (6) unaligned, 2 47 2 48 2 offset fixed bin (18) unsigned unaligned, 2 49 2 pad2 bit (3) unaligned, 2 50 2 bit_offset fixed bin (6) unsigned unaligned, 2 51 2 pad3 bit (3) unaligned, 2 52 2 mod bit (6) unaligned; 2 53 2 54 2 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 2 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 2 57 2 58 /* END INCLUDE FILE its.incl.pl1 */ 41 42 3 1 /* BEGIN INCLUDE FILE ... db_arg_list.incl.pl1 ... last modified Dec. 1972 - WSS */ 3 2 3 3 dcl ap ptr; 3 4 3 5 dcl 1 arg_list based (ap) aligned, 3 6 3 7 2 num_args fixed bin(16) unaligned, 3 8 2 code bit (19) unaligned, 3 9 3 10 2 num_desc fixed bin(16) unaligned, 3 11 2 fill bit (19) unaligned, 3 12 3 13 2 args (25) ptr aligned; 3 14 3 15 /* END INCLUDE FILE ... db_arg_list.incl.pl1 */ 43 44 45 no_args = arg_list.num_args; /* get the number of arguments */ 46 if no_args = 0 then do; /* check for no arguments */ 47 call ioa_$ioa_stream (debug_output, "No arguments."); 48 return; 49 end; 50 no_desc = arg_list.num_desc; /* and the number of descriptors */ 51 if argno <= 0 then do; 52 min_arg = 1; /* print out all arguments */ 53 max_arg = no_args; 54 end; 55 else min_arg, max_arg = argno; /* just print out the one argument */ 56 57 if argno > no_args then do; /* check for argument number too large */ 58 call ioa_$ioa_stream (debug_output, "Arg no. ^d too large. Only ^d arguments.",argno,no_args); 59 return; 60 end; 61 62 do j = min_arg to max_arg; /* loop through the desired number of args */ 63 argp = ap -> arg_list.args(j); /* get pointer to the argument */ 64 if atype = "?" then do; /* must find out argument type */ 65 if no_desc ^= 0 then do; /* if we have descitpros, look at them */ 66 call decode_descriptor_(ap,j,type,packed,ndims,strl,scale); 67 end; 68 else do; /* try to find out what type by heuristics */ 69 if argp -> its.its_mod = "100011"b then type = 13; /* assume pointer */ 70 else do; 71 do strl = 0 to 31 while(substr(char_string,strl+1,1) >= "" /* bell */ 72 & 73 substr(char_string,strl+1,1) <= "~"); 74 end; 75 if strl >= 2 then type = 21; 76 else type = -1; /* full word octal */ 77 end; 78 end; 79 end; /* of checking for type */ 80 81 else if atype = "l" then type = -2; /* location of arg */ 82 else if atype = "o" then type = -1; /* full word octal */ 83 else if atype = "p" then type = 13; 84 else if atype = "d" then type = 1; /* real fixed */ 85 else if atype = "a" then /* ascii */ 86 do; 87 call decode_descriptor_(ap,j,type,packed,ndims,strl,scale); /* see if ascii descriptor */ 88 89 if type = 22 then strl = max(0,addrel(argp,-1)->fword); 90 else if type = 21 then; 91 else do; 92 type = 21; 93 strl = 32; /* he asked for characters, and cannot get length */ 94 end; 95 end; 96 else if atype = "e" then type = 3; /* floating point */ 97 else if atype = "f" then type = 1003; /* floating point (f-format) */ 98 else if atype = "b" then do; /* bit string */ 99 type = 19; 100 strl = 72; /* only allow 72 bits or less */ 101 end; 102 else do; /* invalid type */ 103 call ioa_$ioa_stream (debug_output, "Invalid output type specified."); 104 type = -1; 105 end; 106 107 if type = 21 then goto cs; /* we have char string */ 108 if type = 19 then goto bs; /* we have bit strinng */ 109 if type = 14 then goto fw; /* we have offset */ 110 111 if type = 13 then do; /* pointer */ 112 if argp -> its.its_mod = "100011"b then call ioa_$ioa_stream (debug_output, "ARG ^2d: ^p",j,argp->based_p); 113 else call ioa_$ioa_stream (debug_output, "ARG ^2d: ^w ^w",j,argp->fword,addrel(argp,1)->fword); 114 end; 115 else if type = 1 then /* real fixed bin single */ 116 call ioa_$ioa_stream (debug_output, "ARG ^2d: ^d",j,argp -> fword); 117 else if type = 3 then 118 call ioa_$ioa_stream (debug_output, "ARG ^2d: ^e",j,argp -> flword); 119 else if type = 1003 then 120 call ioa_$ioa_stream (debug_output, "ARG ^2d: ^16.6f",j,argp -> flword); 121 else if type = 4 then 122 call ioa_$ioa_stream (debug_output, "ARG ^2d: ^e", j, argp->dblword); /* long precision */ 123 else if type = 20 then do; /* var and non-var bit string */ 124 strl = addrel(argp,-1) -> fword; 125 bs: c72 = ""; /* set to blanks */ 126 do i = 1 to min(strl,72); 127 if substr(bit_string,i,1) = "1"b then substr(c72,i,1) = "1"; else substr(c72,i,1) = "0"; 128 end; 129 call ioa_$ioa_stream (debug_output, "ARG ^2d: ""^a""b",j,c72); 130 end; 131 else if type = 22 then /* var char string */ 132 do; 133 strl = min(32,addrel(argp,-1) -> fword); 134 cs: call ioa_$ioa_stream (debug_output, "ARG ^2d: ""^va""",j,strl,char_string); 135 end; 136 else if type = -1 then /* */ 137 fw: call ioa_$ioa_stream (debug_output, "ARG ^2d: ^w",j,argp -> fword); /* full word octal */ 138 else if type = 15 | type = 16 then 139 call ioa_$ioa_stream (debug_output, "ARG ^2d: ^p, ^p",j,argp -> lv.ptr,argp -> lv.stack); 140 else if type = -2 then call ioa_$ioa_stream (debug_output, "ARG ^2d -> ^p",j,argp); /* location of arg */ 141 else end_loop: call ioa_$ioa_stream (debug_output, "ARG ^2d: Type ^d not handled.",j,type); 142 143 end; 144 return; 145 146 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1609.4 list_arg_.pl1 >dumps>old>recomp>list_arg_.pl1 32 1 08/12/76 1010.2 db_ext_stat_.incl.pl1 >ldd>include>db_ext_stat_.incl.pl1 41 2 11/26/79 1320.6 its.incl.pl1 >ldd>include>its.incl.pl1 43 3 05/06/74 1741.1 db_arg_list.incl.pl1 >ldd>include>db_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. ap parameter pointer dcl 3-3 set ref 11 45 50 63 66* 87* arg_list based structure level 1 dcl 3-5 argno parameter fixed bin(18,0) dcl 13 set ref 11 51 55 57 58* argp 000100 automatic pointer dcl 17 set ref 63* 69 71 71 89 112 112 113 113 115 117 119 121 124 127 133 134 136 138 138 140* args 2 based pointer array level 2 dcl 3-5 ref 63 atype parameter char(1) dcl 13 ref 11 64 81 82 83 84 85 96 97 98 based_p based pointer dcl 34 set ref 112* bit_string based bit unaligned dcl 17 ref 127 c72 000106 automatic char(72) dcl 17 set ref 125* 127* 127* 129* char_string based char unaligned dcl 17 set ref 71 71 134* db_ext_stat_$db_ext_stat_ 000014 external static structure level 1 dcl 1-9 dblword based float bin(63) dcl 17 set ref 121* debug_output 10 000014 external static char(32) level 2 dcl 1-9 set ref 47* 58* 103* 112* 113* 115* 117* 119* 121* 129* 134* 136* 138* 140* 141* decode_descriptor_ 000010 constant entry external dcl 17 ref 66 87 flword based float bin(27) dcl 17 set ref 117* 119* fword based fixed bin(18,0) dcl 17 set ref 89 113* 113* 115* 124 133 136* i 000102 automatic fixed bin(18,0) dcl 17 set ref 126* 127 127 127* ioa_$ioa_stream 000012 constant entry external dcl 17 ref 47 58 103 112 113 115 117 119 121 129 134 136 138 140 141 its based structure level 1 dcl 2-5 its_mod 0(30) based bit(6) level 2 packed unaligned dcl 2-5 ref 69 112 j 000132 automatic fixed bin(18,0) dcl 17 set ref 62* 63 66* 87* 112* 113* 115* 117* 119* 121* 129* 134* 136* 138* 140* 141* lv based structure level 1 unaligned dcl 37 max_arg 000104 automatic fixed bin(18,0) dcl 17 set ref 53* 55* 62 min_arg 000103 automatic fixed bin(18,0) dcl 17 set ref 52* 55* 62 ndims 000134 automatic fixed bin(18,0) dcl 17 set ref 66* 87* no_args 000130 automatic fixed bin(18,0) dcl 17 set ref 45* 46 53 57 58* no_desc 000131 automatic fixed bin(18,0) dcl 17 set ref 50* 65 num_args based fixed bin(16,0) level 2 packed unaligned dcl 3-5 ref 45 num_desc 1 based fixed bin(16,0) level 2 packed unaligned dcl 3-5 ref 50 packed 000136 automatic bit(1) dcl 17 set ref 66* 87* ptr based pointer level 2 dcl 37 set ref 138* scale 000135 automatic fixed bin(18,0) dcl 17 set ref 66* 87* stack 2 based pointer level 2 dcl 37 set ref 138* strl 000133 automatic fixed bin(18,0) dcl 17 set ref 66* 71* 71 71 71 71* 75 87* 89* 93* 100* 124* 126 127 133* 134* 134 134 type 000105 automatic fixed bin(18,0) dcl 17 set ref 66* 69* 75* 76* 81* 82* 83* 84* 87* 89 90 92* 96* 97* 99* 104* 107 108 109 111 115 117 119 121 123 131 136 138 138 140 141* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ITP_MODIFIER internal static bit(6) initial unaligned dcl 2-56 ITS_MODIFIER internal static bit(6) initial unaligned dcl 2-55 bit17 based bit(17) unaligned dcl 17 db_ext_stat_$break_instructions external static bit(36) array dcl 1-27 itp based structure level 1 dcl 2-18 itp_unsigned based structure level 1 dcl 2-43 its_unsigned based structure level 1 dcl 2-30 NAMES DECLARED BY EXPLICIT CONTEXT. bs 001003 constant label dcl 125 ref 108 cs 001102 constant label dcl 134 ref 107 end_loop 001277 constant label dcl 141 fw 001145 constant label dcl 136 ref 109 list_arg_ 000124 constant entry external dcl 11 NAMES DECLARED BY CONTEXT OR IMPLICATION. addrel builtin function ref 89 113 124 133 max builtin function ref 89 min builtin function ref 126 133 substr builtin function set ref 71 71 127 127* 127* STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1410 1426 1335 1420 Length 1660 1335 16 215 53 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME list_arg_ 156 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME list_arg_ 000100 argp list_arg_ 000102 i list_arg_ 000103 min_arg list_arg_ 000104 max_arg list_arg_ 000105 type list_arg_ 000106 c72 list_arg_ 000130 no_args list_arg_ 000131 no_desc list_arg_ 000132 j list_arg_ 000133 strl list_arg_ 000134 ndims list_arg_ 000135 scale list_arg_ 000136 packed list_arg_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. decode_descriptor_ ioa_$ioa_stream THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. db_ext_stat_$db_ext_stat_ LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000120 45 000131 46 000136 47 000137 48 000160 50 000161 51 000165 52 000167 53 000171 54 000173 55 000174 57 000176 58 000201 59 000230 62 000231 63 000240 64 000246 65 000253 66 000255 67 000300 69 000301 71 000310 74 000326 75 000330 76 000335 79 000337 81 000340 82 000345 83 000352 84 000357 85 000364 87 000366 89 000411 90 000424 92 000427 93 000431 95 000433 96 000434 97 000441 98 000446 99 000450 100 000452 101 000454 103 000455 104 000475 107 000477 108 000502 109 000504 111 000506 112 000510 113 000550 114 000607 115 000610 117 000644 119 000702 121 000737 123 000775 124 000777 125 001003 126 001006 127 001020 127 001031 128 001034 129 001036 130 001070 131 001071 133 001073 134 001102 135 001142 136 001143 138 001177 140 001242 141 001277 143 001327 144 001331 ----------------------------------------------------------- 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