COMPILATION LISTING OF SEGMENT send_mail_ Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 06/30/86 1353.5 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 13 /****^ HISTORY COMMENTS: 14* 1) change(86-06-02,Herbst), approve(86-06-02,MCR7432), audit(86-06-30,Wong), 15* install(86-06-30,MR12.0-1080): 16* Changed to initialize unused portions of mail_format to zero. 17* END HISTORY COMMENTS */ 18 19 20 send_mail_: proc (destination, message, send_info_ptr, code); 21 22 /* This subroutine sends one message to a specified 23* Person.Project destination and optionally accompanies 24* it with a wakeup. Control information is input via 25* the structure send_mail_info. */ 26 27 /* Steve Herbst 7/1/75 */ 28 /* Arguments declared char (*) 05/12/80 S. Herbst */ 29 1 1 /* BEGIN Mailbox Message Include File (mail_format.incl.pl1) */ 1 2 1 3 1 4 /****^ HISTORY COMMENTS: 1 5* 1) change(86-01-09,Herbst), approve(86-03-25,MCR7367), 1 6* audit(86-04-28,Margolin), install(86-05-22,MR12.0-1059): 1 7* Added "seen" switch. 1 8* 2) change(86-06-02,Herbst), approve(86-06-02,MCR7367), audit(86-06-30,Wong), 1 9* install(86-06-30,MR12.0-1080): 1 10* Updated to version 4 for seen switch. 1 11* END HISTORY COMMENTS */ 1 12 1 13 /* Last modified by K. T. Pogran, 3/6/75 */ 1 14 /* Modified by D. M. Wells, August 10, 1977 for v4 message segments. */ 1 15 /* Modified: 3 June 1981 by G. Palter for mail system subroutine interface */ 1 16 1 17 declare mail_format_ptr pointer aligned; 1 18 1 19 declare MAIL_FORMAT_VERSION_4 initial (4) 1 20 fixed bin internal static options (constant); 1 21 1 22 declare text_length fixed bin (21); 1 23 1 24 declare 1 mail_format aligned based (mail_format_ptr), 1 25 2 header, 1 26 3 version fixed bin (17), 1 27 3 sent_from char (32) aligned, 1 28 3 lines fixed bin (17), 1 29 3 text_len fixed bin (21), 1 30 3 switches aligned, 1 31 4 wakeup bit (1) unaligned, 1 32 4 urgent bit (1) unaligned, 1 33 4 notify bit (1) unaligned, 1 34 4 acknowledge bit (1) unaligned, 1 35 4 obsolete bit (1) unaligned, 1 36 4 canonical bit (1) unaligned, 1 37 4 seen bit (1) unaligned, 1 38 4 others bit (65) unaligned, 1 39 2 text char(text_length refer (mail_format.header.text_len)) aligned; 1 40 1 41 /* END Mailbox Message Include File (mail_format.incl.pl1) */ 30 2 1 /* BEGIN send_mail_info include file */ 2 2 2 3 dcl send_mail_info_version_2 fixed bin init(2); 2 4 2 5 dcl 1 send_mail_info aligned, 2 6 2 version fixed bin, /* = 2 */ 2 7 2 sent_from char(32) aligned, 2 8 2 switches, 2 9 3 wakeup bit(1) unal, 2 10 3 mbz1 bit(1) unal, 2 11 3 always_add bit(1) unal, 2 12 3 never_add bit(1) unal, 2 13 3 notify bit(1) unal, 2 14 3 acknowledge bit(1) unal, 2 15 3 mbz bit(30) unal; 2 16 2 17 /* END send_mail_info include file */ 31 32 dcl 1 send_info like send_mail_info based(send_info_ptr); 33 34 dcl (destination, message) char(*); 35 dcl (a_dn, a_en) char (*); 36 dcl dn char (168); 37 dcl en char (32); 38 dcl newline char(1) aligned init(" 39 "); 40 dcl switch bit(36) init("0"b); 41 dcl (a_access_class, access_class, id) bit(72) aligned; 42 dcl aim_add bit(1) aligned; 43 dcl retried bit(1) aligned; /* retried once already after $bad_segment */ 44 45 dcl send_info_ptr ptr; 46 47 dcl (count, i, j) fixed bin; 48 dcl mbx_index fixed bin init(0); /* index of recipient's mailbox */ 49 dcl msg_bitcnt fixed bin; /* bitcnt of message added */ 50 51 dcl code fixed bin(35); 52 dcl error_table_$bad_segment fixed bin(35) ext; 53 dcl error_table_$noentry fixed bin(35) ext; 54 dcl error_table_$rqover fixed bin(35) ext; 55 56 dcl mailbox_$close entry(fixed bin,fixed bin(35)); 57 dcl mailbox_$open entry(char(*),char(*),fixed bin,fixed bin(35)); 58 dcl mailbox_$wakeup_add_index entry(fixed bin,ptr,fixed bin,bit(36),bit(72)aligned,fixed bin(35)); 59 dcl mailbox_$wakeup_aim_add_index entry(fixed bin,ptr,fixed bin,bit(36),bit(72)aligned,bit(72)aligned,fixed bin(35)); 60 61 dcl (addr, index, length, reverse, size, substr, verify) builtin; 62 63 dcl (cleanup, record_quota_overflow) condition; 64 /* */ 65 aim_add = "0"b; 66 go to COMMON; 67 68 access_class: entry (destination, message, send_info_ptr, a_access_class, code); 69 70 aim_add = "1"b; 71 access_class = a_access_class; 72 73 /* locate recipient's mailbox */ 74 75 COMMON: i = index(destination,"."); 76 j = length(destination) + 1 - verify(reverse(destination)," "); 77 if i=0 then do; /* invalid destination */ 78 code = error_table_$noentry; /* no such mailbox */ 79 return; 80 end; 81 else do; 82 dn = ">udd>" || substr(destination,i+1,j-i) || ">" || substr(destination,1,i-1); 83 en = substr(destination,1,i-1) || ".mbx"; 84 end; 85 go to OPEN; 86 87 path: entry (a_dn, a_en, message, send_info_ptr, code); 88 89 aim_add = "0"b; 90 go to COMMON2; 91 92 path_access_class: entry (a_dn, a_en, message, send_info_ptr, a_access_class, code); 93 94 aim_add = "1"b; 95 access_class = a_access_class; 96 97 COMMON2: dn = a_dn; 98 en = a_en; 99 i = length (rtrim (en)); 100 if i < 5 then do; 101 ADD_SUFFIX: substr (en, i + 1, 4) = ".mbx"; 102 end; 103 else if substr (en, i - 3, 4) ^= ".mbx" then go to ADD_SUFFIX; 104 105 OPEN: on condition (cleanup) begin; 106 if mbx_index ^= 0 then call mailbox_$close (mbx_index, 0); 107 end; 108 109 call mailbox_$open(dn,en,mbx_index,code); 110 if code^=0 then return; 111 112 /* build message */ 113 114 if message="" then text_length = 0; 115 else text_length = length(message)-verify(reverse(message)," ")+1; 116 msg_bitcnt = size(mail_format)*36; 117 118 allocate_message: begin; 119 120 dcl mf_space bit(msg_bitcnt) aligned; 121 122 dcl 1 mf aligned like mail_format based(addr(mf_space)); 123 124 mf.version = MAIL_FORMAT_VERSION_4; 125 mf.text_len = text_length; 126 mf.sent_from = send_info.sent_from; 127 mf.wakeup = send_info.wakeup; 128 mf.notify = send_info.notify; 129 mf.acknowledge = send_info.acknowledge; 130 mf.urgent, mf.seen, mf.others = "0"b; 131 mf.text = message; 132 133 /* count lines */ 134 135 mf.lines = 0; 136 count = 1; 137 i = 1; 138 do while(i^=0 & text_length^=0); 139 i = index(substr(message,count,text_length),newline); 140 count = count+i; 141 text_length = text_length-i; 142 mf.lines = mf.lines+1; 143 end; 144 145 /* send */ 146 147 on condition(record_quota_overflow) begin; 148 code = error_table_$rqover; 149 go to RETURN; 150 end; 151 152 switch = mf.wakeup || mf.urgent || send_info.always_add || send_info.never_add; 153 retried = "0"b; 154 RETRY: if aim_add then call mailbox_$wakeup_aim_add_index 155 (mbx_index,addr(mf),msg_bitcnt,switch,access_class,id,code); 156 else call mailbox_$wakeup_add_index(mbx_index,addr(mf),msg_bitcnt,switch,id,code); 157 if code=error_table_$bad_segment & ^retried then do; 158 retried = "1"b; 159 go to RETRY; 160 end; 161 call mailbox_$close(mbx_index,0); 162 163 end allocate_message; 164 165 RETURN: return; 166 167 end send_mail_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/30/86 1342.1 send_mail_.pl1 >spec>install>1080>send_mail_.pl1 30 1 06/30/86 1338.8 mail_format.incl.pl1 >spec>install>1080>mail_format.incl.pl1 31 2 04/27/78 1504.4 send_mail_info.incl.pl1 >ldd>include>send_mail_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. MAIL_FORMAT_VERSION_4 constant fixed bin(17,0) initial dcl 1-19 ref 124 a_access_class parameter bit(72) dcl 41 ref 68 71 92 95 a_dn parameter char unaligned dcl 35 ref 87 92 97 a_en parameter char unaligned dcl 35 ref 87 92 98 access_class 000200 automatic bit(72) dcl 41 set ref 71* 95* 154* acknowledge 11(05) based bit(1) level 3 in structure "send_info" packed unaligned dcl 32 in procedure "send_mail_" ref 129 acknowledge 13(03) based bit(1) level 4 in structure "mf" packed unaligned dcl 122 in begin block on line 118 set ref 129* addr builtin function dcl 61 ref 124 125 126 127 128 129 130 130 130 131 135 142 142 152 152 154 154 154 154 156 156 156 156 aim_add 000204 automatic bit(1) dcl 42 set ref 65* 70* 89* 94* 154 always_add 11(02) based bit(1) level 3 packed unaligned dcl 32 ref 152 cleanup 000214 stack reference condition dcl 63 ref 105 code parameter fixed bin(35,0) dcl 51 set ref 20 68 78* 87 92 109* 110 148* 154* 156* 157 count 000206 automatic fixed bin(17,0) dcl 47 set ref 136* 139 140* 140 destination parameter char unaligned dcl 34 ref 20 68 75 76 76 82 82 83 dn 000114 automatic char(168) unaligned dcl 36 set ref 82* 97* 109* en 000166 automatic char(32) unaligned dcl 37 set ref 83* 98* 99 101* 103 109* error_table_$bad_segment 000010 external static fixed bin(35,0) dcl 52 ref 157 error_table_$noentry 000012 external static fixed bin(35,0) dcl 53 ref 78 error_table_$rqover 000014 external static fixed bin(35,0) dcl 54 ref 148 header based structure level 2 in structure "mail_format" dcl 1-24 in procedure "send_mail_" header based structure level 2 in structure "mf" dcl 122 in begin block on line 118 i 000207 automatic fixed bin(17,0) dcl 47 set ref 75* 77 82 82 82 83 99* 100 101 103 137* 138 139* 140 141 id 000202 automatic bit(72) dcl 41 set ref 154* 156* index builtin function dcl 61 ref 75 139 j 000210 automatic fixed bin(17,0) dcl 47 set ref 76* 82 length builtin function dcl 61 ref 76 99 115 lines 11 based fixed bin(17,0) level 3 dcl 122 set ref 135* 142* 142 mail_format based structure level 1 dcl 1-24 ref 116 mail_format_ptr automatic pointer dcl 1-17 ref 116 mailbox_$close 000016 constant entry external dcl 56 ref 106 161 mailbox_$open 000020 constant entry external dcl 57 ref 109 mailbox_$wakeup_add_index 000022 constant entry external dcl 58 ref 156 mailbox_$wakeup_aim_add_index 000024 constant entry external dcl 59 ref 154 mbx_index 000211 automatic fixed bin(17,0) initial dcl 48 set ref 48* 106 106* 109* 154* 156* 161* message parameter char unaligned dcl 34 ref 20 68 87 92 114 115 115 131 139 mf based structure level 1 dcl 122 set ref 154 154 156 156 mf_space 000100 automatic bit dcl 120 set ref 124 125 126 127 128 129 130 130 130 131 135 142 142 152 152 154 154 156 156 msg_bitcnt 000212 automatic fixed bin(17,0) dcl 49 set ref 116* 120 154* 156* never_add 11(03) based bit(1) level 3 packed unaligned dcl 32 ref 152 newline 000176 automatic char(1) initial dcl 38 set ref 38* 139 notify 11(04) based bit(1) level 3 in structure "send_info" packed unaligned dcl 32 in procedure "send_mail_" ref 128 notify 13(02) based bit(1) level 4 in structure "mf" packed unaligned dcl 122 in begin block on line 118 set ref 128* others 13(07) based bit(65) level 4 packed unaligned dcl 122 set ref 130* record_quota_overflow 000000 stack reference condition dcl 63 ref 147 retried 000205 automatic bit(1) dcl 43 set ref 153* 157 158* reverse builtin function dcl 61 ref 76 115 seen 13(06) based bit(1) level 4 packed unaligned dcl 122 set ref 130* send_info based structure level 1 unaligned dcl 32 send_info_ptr parameter pointer dcl 45 ref 20 68 87 92 126 127 128 129 152 152 send_mail_info 000102 automatic structure level 1 dcl 2-5 send_mail_info_version_2 000101 automatic fixed bin(17,0) initial dcl 2-3 set ref 2-3* sent_from 1 based char(32) level 3 in structure "mf" dcl 122 in begin block on line 118 set ref 126* sent_from 1 based char(32) level 2 in structure "send_info" dcl 32 in procedure "send_mail_" ref 126 size builtin function dcl 61 ref 116 substr builtin function dcl 61 set ref 82 82 83 101* 103 139 switch 000177 automatic bit(36) initial unaligned dcl 40 set ref 40* 152* 154* 156* switches 13 based structure level 3 in structure "mf" dcl 122 in begin block on line 118 switches 11 based structure level 2 in structure "send_info" packed unaligned dcl 32 in procedure "send_mail_" text 15 based char level 2 dcl 122 set ref 131* text_len 12 based fixed bin(21,0) level 3 in structure "mail_format" dcl 1-24 in procedure "send_mail_" ref 131 text_len 12 based fixed bin(21,0) level 3 in structure "mf" dcl 122 in begin block on line 118 set ref 125* text_length 000100 automatic fixed bin(21,0) dcl 1-22 set ref 114* 115* 116 125 138 139 141* 141 urgent 13(01) based bit(1) level 4 packed unaligned dcl 122 set ref 130* 152 verify builtin function dcl 61 ref 76 115 version based fixed bin(17,0) level 3 dcl 122 set ref 124* wakeup 13 based bit(1) level 4 in structure "mf" packed unaligned dcl 122 in begin block on line 118 set ref 127* 152 wakeup 11 based bit(1) level 3 in structure "send_info" packed unaligned dcl 32 in procedure "send_mail_" ref 127 NAMES DECLARED BY EXPLICIT CONTEXT. ADD_SUFFIX 000416 constant label dcl 101 ref 103 COMMON 000133 constant label dcl 75 ref 66 COMMON2 000367 constant label dcl 97 ref 90 OPEN 000427 constant label dcl 105 ref 85 RETRY 000741 constant label dcl 154 ref 159 RETURN 001041 constant label dcl 165 ref 149 access_class 000076 constant entry external dcl 68 allocate_message 000547 constant label dcl 118 path 000263 constant entry external dcl 87 path_access_class 000325 constant entry external dcl 92 send_mail_ 000042 constant entry external dcl 20 NAME DECLARED BY CONTEXT OR IMPLICATION. rtrim builtin function ref 99 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1220 1246 1047 1230 Length 1466 1047 26 204 151 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME send_mail_ 180 external procedure is an external procedure. on unit on line 105 72 on unit begin block on line 118 94 begin block uses auto adjustable storage, and enables or reverts conditions. on unit on line 147 64 on unit STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 118 000100 mf_space begin block on line 118 send_mail_ 000100 text_length send_mail_ 000101 send_mail_info_version_2 send_mail_ 000102 send_mail_info send_mail_ 000114 dn send_mail_ 000166 en send_mail_ 000176 newline send_mail_ 000177 switch send_mail_ 000200 access_class send_mail_ 000202 id send_mail_ 000204 aim_add send_mail_ 000205 retried send_mail_ 000206 count send_mail_ 000207 i send_mail_ 000210 j send_mail_ 000211 mbx_index send_mail_ 000212 msg_bitcnt send_mail_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs enter_begin leave_begin call_ext_out_desc call_ext_out return tra_ext alloc_auto_adj enable shorten_stack ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. mailbox_$close mailbox_$open mailbox_$wakeup_add_index mailbox_$wakeup_aim_add_index THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_segment error_table_$noentry error_table_$rqover LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2 3 000025 38 000027 40 000031 48 000032 20 000035 65 000067 66 000070 68 000071 70 000125 71 000127 75 000133 76 000147 77 000165 78 000167 79 000172 82 000173 83 000237 84 000254 85 000255 87 000256 89 000315 90 000316 92 000317 94 000361 95 000363 97 000367 98 000375 99 000402 100 000414 101 000416 102 000422 103 000423 105 000427 106 000443 107 000457 109 000460 110 000505 114 000507 115 000523 116 000541 118 000547 120 000552 124 000562 125 000564 126 000566 127 000573 128 000577 129 000604 130 000611 131 000620 135 000631 136 000632 137 000634 138 000635 139 000643 140 000656 141 000657 142 000661 143 000663 147 000664 148 000700 149 000704 152 000707 153 000740 154 000741 156 000772 157 001015 158 001024 159 001026 161 001027 163 001040 165 001041 ----------------------------------------------------------- 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