COMPILATION LISTING OF SEGMENT rank Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 02/07/84 1051.1 mst Tue 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 /* format: style2 */ 12 rank: 13 procedure; 14 15 /* ********************************************************************** 16* * Active function/command to implement the PL/I builtin functions * 17* * rank and byte. * 18* * * 19* * Written August 1981 by Warren Johnson. * 20* * Modified as per MCR for installation, November 1981, Benson I. * 21* * Margulies * 22* * Modified to fix NNo and other problems, BIM, 10/82 * 23* * Modified to fix "byte 32" and "byte 34" (i.e. to use requote_ * 24* * before calling ioa_), June 1983, Chris Jones * 25* * Modified to fix arg processing errors, 1 Nov 1983 C Spitzer * 26* ********************************************************************** */ 27 28 dcl active_fnc_err_ entry options (variable); 29 dcl com_err_ entry options (variable); 30 dcl cu_$af_return_arg entry (fixed, ptr, fixed (21), fixed (35)); 31 dcl cu_$arg_ptr entry (fixed, ptr, fixed (21), fixed (35)); 32 dcl cv_dec_check_ entry (char (*), fixed (35)) returns (fixed (35)); 33 dcl cv_oct_check_ entry (char (*), fixed (35)) returns (fixed (35)); 34 dcl ioa_ entry options (variable); 35 dcl ioa_$rsnnl entry options (variable); 36 dcl requote_string_ entry (char (*)) returns (char (*)); 37 38 dcl (rank, byte, rtrim, substr, length, before, index) 39 builtin; 40 41 dcl error_table_$badopt fixed (35) external; 42 dcl error_table_$bigarg fixed (35) external; 43 dcl error_table_$noarg fixed (35) external; 44 dcl error_table_$not_act_fnc 45 fixed (35) external; 46 dcl error_table_$too_many_args 47 fixed (35) external; 48 49 dcl error_table_$smallarg fixed bin (35) ext static; 50 dcl error_table_$bad_conversion 51 fixed bin (35) ext static; 52 53 dcl gripe entry variable options (variable); 54 55 dcl (nargs, i) fixed; 56 dcl (rsl, argl) fixed (21); 57 dcl (rv, code) fixed (35); 58 59 dcl (argp, rsp) ptr; 60 61 dcl rs char (rsl) varying based (rsp); 62 dcl arg char (argl) based (argp); 63 dcl cname char (4); 64 dcl have_main_arg bit (1) aligned; 65 dcl main_arg char (32); 66 67 dcl (command, octal_sw) bit (1); 68 69 cname = "rank"; 70 go to JOIN; 71 72 byte: 73 entry; 74 75 cname = "byte"; 76 77 JOIN: 78 octal_sw = "0"b; 79 call cu_$af_return_arg (nargs, rsp, rsl, code); 80 if code = error_table_$not_act_fnc 81 then do; /* called as a command */ 82 command = "1"b; 83 gripe = com_err_; 84 end; 85 else if code = 0 86 then do; /* active function */ 87 command = "0"b; 88 gripe = active_fnc_err_; 89 end; 90 else do; 91 call com_err_ (code, cname); 92 return; 93 end; 94 95 if nargs = 0 96 then do; /* one input arg required, one optional */ 97 USAGE: 98 call gripe (error_table_$noarg, cname, "^/Usage is: ^[[^]^a ^[CHAR^;NO^] {-control_args}^[]^]", 99 ^command, cname, cname = "rank", ^command); 100 return; 101 end; 102 103 have_main_arg = "0"b; 104 105 do i = 1 to nargs; 106 call cu_$arg_ptr (i, argp, argl, (0)); 107 108 if ^(length (arg) > 1 & char (arg, 1) = "-") 109 then do; 110 if have_main_arg 111 then do; 112 call com_err_ (error_table_$too_many_args, cname, 113 "Only one character may be specified. ^a is the second.", arg); 114 return; 115 end; 116 have_main_arg = "1"b; 117 main_arg = arg; /* so, it can be truncated */ 118 end; 119 120 else if (arg = "-octal" | arg = "-oc") & cname = "rank" 121 /* not on byte */ 122 then octal_sw = "1"b; 123 else if (arg = "-decimal" | arg = "-dec") & cname = "rank" 124 then octal_sw = "0"b; /* allow defaulting */ 125 else do; 126 call gripe (error_table_$badopt, cname, arg); 127 return; 128 end; 129 end; 130 131 if ^have_main_arg 132 then go to USAGE; 133 134 if cname = "rank" /* RANK */ 135 then do; 136 if length (rtrim (main_arg)) > 1 137 then do; 138 call gripe (error_table_$bigarg, cname, 139 "Only one character may be given. ""^a"" is too long.", main_arg); 140 return; 141 end; 142 143 144 rv = rank (char (main_arg, 1)); 145 if octal_sw 146 then if command 147 then call ioa_ ("^o", rv); 148 else call ioa_$rsnnl ("^o", rs, (rsl), rv); 149 else if command 150 then call ioa_ ("^d", rv); 151 else call ioa_$rsnnl ("^d", rs, (rsl), rv); 152 end; 153 154 else do; /* BYTE */ 155 if character (reverse (rtrim (main_arg)), 1) = "o" 156 then rv = cv_oct_check_ (before (main_arg, "o"), code); 157 else rv = cv_dec_check_ (main_arg, code); 158 if code ^= 0 159 then do; 160 call gripe (error_table_$bad_conversion, cname, "Invalid number: ^a.", main_arg); 161 return; 162 end; 163 else if rv < 0 | rv > 511 164 then do; 165 call gripe (0, cname, "Number out of range: ^a.", main_arg); 166 return; 167 end; 168 else if command 169 then call ioa_ ("^a", requote_string_ (byte (rv))); 170 else rs = byte (rv); 171 end; 172 173 if ^command 174 then rs = requote_string_ ((rs)); 175 176 return; 177 178 end rank; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 02/07/84 1050.5 rank.pl1 >spec>on>full_cp>rank.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. active_fnc_err_ 000010 constant entry external dcl 28 ref 88 arg based char unaligned dcl 62 set ref 108 108 112* 117 120 120 123 123 126* argl 000107 automatic fixed bin(21,0) dcl 56 set ref 106* 108 108 112 112 117 120 120 123 123 126 126 argp 000112 automatic pointer dcl 59 set ref 106* 108 108 112 117 120 120 123 123 126 before builtin function dcl 38 ref 155 155 byte builtin function dcl 38 ref 168 168 170 cname 000116 automatic char(4) unaligned dcl 63 set ref 69* 75* 91* 97* 97* 97 112* 120 123 126* 134 138* 160* 165* code 000111 automatic fixed bin(35,0) dcl 57 set ref 79* 80 85 91* 155* 157* 158 com_err_ 000012 constant entry external dcl 29 ref 83 91 112 command 000130 automatic bit(1) unaligned dcl 67 set ref 82* 87* 97 97 145 149 168 173 cu_$af_return_arg 000014 constant entry external dcl 30 ref 79 cu_$arg_ptr 000016 constant entry external dcl 31 ref 106 cv_dec_check_ 000020 constant entry external dcl 32 ref 157 cv_oct_check_ 000022 constant entry external dcl 33 ref 155 error_table_$bad_conversion 000044 external static fixed bin(35,0) dcl 50 set ref 160* error_table_$badopt 000032 external static fixed bin(35,0) dcl 41 set ref 126* error_table_$bigarg 000034 external static fixed bin(35,0) dcl 42 set ref 138* error_table_$noarg 000036 external static fixed bin(35,0) dcl 43 set ref 97* error_table_$not_act_fnc 000040 external static fixed bin(35,0) dcl 44 ref 80 error_table_$too_many_args 000042 external static fixed bin(35,0) dcl 46 set ref 112* gripe 000100 automatic entry variable dcl 53 set ref 83* 88* 97 126 138 160 165 have_main_arg 000117 automatic bit(1) dcl 64 set ref 103* 110 116* 131 i 000105 automatic fixed bin(17,0) dcl 55 set ref 105* 106* ioa_ 000024 constant entry external dcl 34 ref 145 149 168 ioa_$rsnnl 000026 constant entry external dcl 35 ref 148 151 length builtin function dcl 38 ref 108 136 main_arg 000120 automatic char(32) unaligned dcl 65 set ref 117* 136 138* 144 155 155 155 157* 160* 165* nargs 000104 automatic fixed bin(17,0) dcl 55 set ref 79* 95 105 octal_sw 000131 automatic bit(1) unaligned dcl 67 set ref 77* 120* 123* 145 rank builtin function dcl 38 ref 144 requote_string_ 000030 constant entry external dcl 36 ref 168 173 rs based varying char dcl 61 set ref 148* 151* 170* 173* 173 rsl 000106 automatic fixed bin(21,0) dcl 56 set ref 79* 148 148 151 151 170 173 rsp 000114 automatic pointer dcl 59 set ref 79* 148 151 170 173 173 rtrim builtin function dcl 38 ref 136 155 rv 000110 automatic fixed bin(35,0) dcl 57 set ref 144* 145* 148* 149* 151* 155* 157* 163 163 168 168 170 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. error_table_$smallarg external static fixed bin(35,0) dcl 49 index builtin function dcl 38 substr builtin function dcl 38 NAMES DECLARED BY EXPLICIT CONTEXT. JOIN 000135 constant label dcl 77 ref 70 USAGE 000215 constant label dcl 97 ref 131 byte 000126 constant entry external dcl 72 rank 000115 constant entry external dcl 12 NAMES DECLARED BY CONTEXT OR IMPLICATION. char builtin function ref 108 144 character builtin function ref 155 reverse builtin function ref 155 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1412 1460 1222 1422 Length 1646 1222 46 152 170 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME rank 154 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME rank 000100 gripe rank 000104 nargs rank 000105 i rank 000106 rsl rank 000107 argl rank 000110 rv rank 000111 code rank 000112 argp rank 000114 rsp rank 000116 cname rank 000117 have_main_arg rank 000120 main_arg rank 000130 command rank 000131 octal_sw rank THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_cs call_var_desc call_ext_out_desc call_ext_out return shorten_stack ext_entry reverse_cs set_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ cu_$af_return_arg cu_$arg_ptr cv_dec_check_ cv_oct_check_ ioa_ ioa_$rsnnl requote_string_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_conversion error_table_$badopt error_table_$bigarg error_table_$noarg error_table_$not_act_fnc error_table_$too_many_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 12 000114 69 000122 70 000124 72 000125 75 000133 77 000135 79 000136 80 000153 82 000157 83 000161 84 000165 85 000166 87 000170 88 000171 89 000175 91 000176 92 000212 95 000213 97 000215 100 000270 103 000271 105 000272 106 000301 108 000317 110 000332 112 000334 114 000366 116 000367 117 000371 118 000375 120 000376 123 000416 126 000432 127 000455 129 000456 131 000460 134 000462 136 000465 138 000500 140 000530 144 000531 145 000534 148 000560 149 000616 151 000640 152 000675 155 000676 157 000760 158 001001 160 001003 161 001036 163 001037 165 001043 166 001073 168 001074 170 001135 173 001151 176 001216 ----------------------------------------------------------- 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