COMPILATION LISTING OF SEGMENT xmail_delete_msgs_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 11/15/83 1426.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 xmail_delete_msgs_: proc (P_mailbox_ptr, P_curr_msgsp, P_pos_line, P_file_name); 12 13 /* Author unknown. 14* 15* 83-06-27 DJ Schimke: Modified to use new mail_system calls and version 2 16* mailboxes. 17* 18* 83-09-14 DJ Schimke: Modified the handling of the error code from 19* mail_system_$mark_message_for_deletion to recognize and report an access 20* problem rather than reporting it as an "internal error." TR11955 21**/ 22 23 /* Parameter */ 24 25 dcl (P_mailbox_ptr, P_curr_msgsp) ptr; 26 dcl P_file_name char (*); 27 dcl P_pos_line char (*); 28 29 /* Automatic */ 30 31 dcl add_more_msg bit (1) aligned; 32 dcl code fixed bin (35); 33 dcl i fixed bin; 34 dcl message_no_string char (200) var; 35 dcl message_number fixed bin; 36 dcl message_ptr ptr; 37 38 /* Constant */ 39 40 dcl ME_CHAR char (18) int static options (constant) init ("xmail_delete_msgs_"); 41 dcl MORE_MSG char (12) int static options (constant) init (" ... "); 42 dcl SP char (1) int static options (constant) init (" "); 43 44 /* Builtin */ 45 46 dcl (char, length, ltrim, maxlength, null) 47 builtin; 48 49 /* Entries */ 50 51 dcl ioa_ entry () options (variable); 52 dcl mail_system_$mark_message_for_deletion entry (ptr, fixed bin (35)); 53 dcl mail_system_$read_message entry (ptr, fixed bin, fixed bin (35)); 54 dcl xmail_error_$code_first entry () options (variable); 55 dcl xmail_error_$no_code entry () options (variable); 56 dcl xmail_select_msgs_$next entry (ptr, ptr, char (*)); 57 dcl xmail_validate_$curr_msgs entry (ptr, fixed bin (35)); 58 dcl xmail_validate_$mbx entry (ptr, fixed bin (35)); 59 60 /* External Static */ 61 62 dcl mlsys_et_$cant_be_deleted fixed bin (35) ext; 63 dcl xmail_err_$no_curr_msgs fixed bin (35) ext; 64 65 call xmail_validate_$mbx (P_mailbox_ptr, code); 66 if code ^= 0 67 then call xmail_error_$no_code (code, ME_CHAR, "q", "Invalid mailbox structure. This is an internal programming error."); 68 69 if P_curr_msgsp = null 70 then call xmail_error_$code_first (xmail_err_$no_curr_msgs, ME_CHAR, "i"); 71 else do; 72 call xmail_validate_$curr_msgs (P_curr_msgsp, code); 73 if code ^= 0 74 then call xmail_error_$no_code (code, ME_CHAR, "q", "Invalid message structure. This is an internal programming error."); 75 end; 76 77 mailbox_ptr = P_mailbox_ptr; 78 curr_msgsp = P_curr_msgsp; 79 80 message_no_string = ""; 81 do i = 1 to curr_msgs.count; 82 message_number = curr_msgs.numbers (i); 83 if mailbox.messages (message_number).message_ptr = null 84 then do; 85 call mail_system_$read_message (mailbox_ptr, message_number, code); 86 if code ^= 0 87 then call xmail_error_$no_code (code, ME_CHAR, "l", "Unable to read message ^d. This is an internal programming error.", message_number); 88 end; 89 message_ptr = mailbox.messages (message_number).message_ptr; 90 call mail_system_$mark_message_for_deletion (message_ptr, code); 91 if code = mlsys_et_$cant_be_deleted 92 then do; 93 call print_msg; 94 call xmail_error_$no_code (code, ME_CHAR, "q", "Sorry, unable to discard message ^d.^/You don't have permisson to delete messages in this mail file.", message_number); 95 end; 96 else if code ^= 0 97 then do; 98 call print_msg; 99 call xmail_error_$no_code (code, ME_CHAR, "q", "Sorry, unable to discard message ^d. This is an internal programming error.", message_number); 100 end; 101 102 if length (message_no_string) + length (ltrim (char (message_number))) + length (SP) > maxlength (message_no_string) 103 then add_more_msg = "1"b; 104 else message_no_string = message_no_string || ltrim (char (message_number)) || SP; 105 end; 106 107 call print_msg; 108 call xmail_select_msgs_$next (P_mailbox_ptr, P_curr_msgsp, P_pos_line); 109 110 EXIT: 111 return; 112 113 print_msg: proc (); 114 call ioa_ ("Message^[s^;^] ^a ^[^a^;^s^] discarded from ""^a"".", (curr_msgs.count > 1), message_no_string, add_more_msg, MORE_MSG, P_file_name); 115 end print_msg; 116 1 1 /* BEGIN INCLUDE FILE ... mlsys_mailbox.incl.pl1 */ 1 2 /* Created: April 1983 by G. Palter */ 1 3 1 4 /* Definition of a mailbox as used by the Multics Mail System */ 1 5 1 6 dcl 1 mailbox aligned based (mailbox_ptr), 1 7 2 version character (8) unaligned, 1 8 2 reserved bit (144), /* for exclusive use of the mail system */ 1 9 2 mailbox_address pointer, /* mail system address of this mailbox */ 1 10 2 mailbox_dirname character (168) unaligned, /* directory containing this mailbox */ 1 11 2 mailbox_ename character (32) unaligned, /* entry name of this mailbox (includes ".mbx") */ 1 12 2 mailbox_type fixed binary, /* type of mailbox (see below) */ 1 13 2 mode bit (36), /* user's effective extended access to this mailbox */ 1 14 2 flags, 1 15 3 salvaged bit (1) unaligned, /* ON => this mailbox has been salvaged since last open */ 1 16 3 reserved bit (35) unaligned, /* for exclusive use of the mail system */ 1 17 2 message_selection_mode fixed binary, /* types of messages read: all/ordinary/interactive */ 1 18 2 sender_selection_mode fixed binary, /* whose messages were read: all/own/not-own */ 1 19 2 message_reading_level fixed binary, /* how much of each message read: keys/messages */ 1 20 2 n_messages fixed binary, /* total # of messages in this mailbox structure */ 1 21 2 n_ordinary_messages fixed binary, /* ... # of ordinary messages here */ 1 22 2 n_interactive_messages fixed binary, /* ... # of interactive messages here */ 1 23 2 n_deleted_messages fixed binary, /* ... # of messages here marked for later deletion */ 1 24 2 messages (mailbox_n_messages refer (mailbox.n_messages)), 1 25 3 key bit (72), /* unique key to read this message if not already read */ 1 26 3 message_ptr pointer; /* -> the message structure */ 1 27 1 28 dcl MAILBOX_VERSION_2 character (8) static options (constant) initial ("mlsmbx02"); 1 29 1 30 dcl mailbox_ptr pointer; 1 31 1 32 dcl mailbox_n_messages fixed binary; /* for exclusive use of the mail system */ 1 33 1 34 1 35 /* Types of mailboxes distinguished by the mail system */ 1 36 1 37 dcl (USER_DEFAULT_MAILBOX initial (1), /* the user's default mailbox for receiving mail */ 1 38 USER_LOGBOX initial (2), /* the user's logbox */ 1 39 SAVEBOX initial (3), /* a savebox */ 1 40 OTHER_MAILBOX initial (4)) /* any other type of mailbox */ 1 41 fixed binary static options (constant); 1 42 1 43 /* END INCLUDE FILE ... mlsys_mailbox.incl.pl1 */ 117 118 2 1 /* Created 06/17/81 by Suzanne Krupp */ 2 2 2 3 dcl n_messages fixed bin; 2 4 dcl MSG_STRUCT_VERSION_1 fixed bin int static options(constant) init(1); 2 5 2 6 dcl curr_msgsp ptr; 2 7 2 8 dcl 1 curr_msgs based(curr_msgsp), 2 9 2 version fixed bin, 2 10 2 count fixed bin, 2 11 2 numbers (n_messages refer(curr_msgs.count)) fixed bin; 2 12 2 13 dcl nonexist_msgsp ptr; 2 14 2 15 dcl 1 nonexist_msgs based(nonexist_msgsp), 2 16 2 version fixed bin, 2 17 2 count fixed bin, 2 18 2 numbers (n_messages refer(nonexist_msgs.count)) fixed bin; 2 19 2 20 dcl msg_structp ptr; 2 21 2 22 dcl 1 msg_struct based(msg_structp), 2 23 2 version fixed bin, 2 24 2 count fixed bin, 2 25 2 numbers(n_messages refer(msg_struct.count)) fixed bin; 120 121 end xmail_delete_msgs_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/83 1400.2 xmail_delete_msgs_.pl1 >spec>on>xmail3>xmail_delete_msgs_.pl1 117 1 10/27/83 2104.2 mlsys_mailbox.incl.pl1 >ldd>include>mlsys_mailbox.incl.pl1 119 2 06/08/82 1329.4 xmail_curr_msg_info.incl.pl1 >ldd>include>xmail_curr_msg_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. ME_CHAR 000003 constant char(18) initial unaligned dcl 40 set ref 66* 69* 73* 86* 94* 99* MORE_MSG 000000 constant char(12) initial unaligned dcl 41 set ref 114* P_curr_msgsp parameter pointer dcl 25 set ref 11 69 72* 78 108* P_file_name parameter char unaligned dcl 26 set ref 11 114* P_mailbox_ptr parameter pointer dcl 25 set ref 11 65* 77 108* P_pos_line parameter char unaligned dcl 27 set ref 11 108* SP 001010 constant char(1) initial unaligned dcl 42 ref 102 104 add_more_msg 000100 automatic bit(1) dcl 31 set ref 102* 114* char builtin function dcl 46 ref 102 104 code 000101 automatic fixed bin(35,0) dcl 32 set ref 65* 66 66* 72* 73 73* 85* 86 86* 90* 91 94* 96 99* count 1 based fixed bin(17,0) level 2 dcl 2-8 ref 81 114 curr_msgs based structure level 1 unaligned dcl 2-8 curr_msgsp 000174 automatic pointer dcl 2-6 set ref 78* 81 82 114 i 000102 automatic fixed bin(17,0) dcl 33 set ref 81* 82* ioa_ 000010 constant entry external dcl 51 ref 114 length builtin function dcl 46 ref 102 102 102 ltrim builtin function dcl 46 ref 102 104 mail_system_$mark_message_for_deletion 000012 constant entry external dcl 52 ref 90 mail_system_$read_message 000014 constant entry external dcl 53 ref 85 mailbox based structure level 1 dcl 1-6 mailbox_ptr 000172 automatic pointer dcl 1-30 set ref 77* 83 85* 89 maxlength builtin function dcl 46 ref 102 message_no_string 000103 automatic varying char(200) dcl 34 set ref 80* 102 102 104* 104 114* message_number 000166 automatic fixed bin(17,0) dcl 35 set ref 82* 83 85* 86* 89 94* 99* 102 104 message_ptr 106 based pointer array level 3 in structure "mailbox" dcl 1-6 in procedure "xmail_delete_msgs_" ref 83 89 message_ptr 000170 automatic pointer dcl 36 in procedure "xmail_delete_msgs_" set ref 89* 90* messages 104 based structure array level 2 dcl 1-6 mlsys_et_$cant_be_deleted 000030 external static fixed bin(35,0) dcl 62 ref 91 null builtin function dcl 46 ref 69 83 numbers 2 based fixed bin(17,0) array level 2 dcl 2-8 ref 82 xmail_err_$no_curr_msgs 000032 external static fixed bin(35,0) dcl 63 set ref 69* xmail_error_$code_first 000016 constant entry external dcl 54 ref 69 xmail_error_$no_code 000020 constant entry external dcl 55 ref 66 73 86 94 99 xmail_select_msgs_$next 000022 constant entry external dcl 56 ref 108 xmail_validate_$curr_msgs 000024 constant entry external dcl 57 ref 72 xmail_validate_$mbx 000026 constant entry external dcl 58 ref 65 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. MAILBOX_VERSION_2 internal static char(8) initial unaligned dcl 1-28 MSG_STRUCT_VERSION_1 internal static fixed bin(17,0) initial dcl 2-4 OTHER_MAILBOX internal static fixed bin(17,0) initial dcl 1-37 SAVEBOX internal static fixed bin(17,0) initial dcl 1-37 USER_DEFAULT_MAILBOX internal static fixed bin(17,0) initial dcl 1-37 USER_LOGBOX internal static fixed bin(17,0) initial dcl 1-37 mailbox_n_messages automatic fixed bin(17,0) dcl 1-32 msg_struct based structure level 1 unaligned dcl 2-22 msg_structp automatic pointer dcl 2-20 n_messages automatic fixed bin(17,0) dcl 2-3 nonexist_msgs based structure level 1 unaligned dcl 2-15 nonexist_msgsp automatic pointer dcl 2-13 NAMES DECLARED BY EXPLICIT CONTEXT. EXIT 000734 constant label dcl 110 print_msg 000735 constant entry internal dcl 113 ref 93 98 107 xmail_delete_msgs_ 000211 constant entry external dcl 11 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1164 1220 1011 1174 Length 1442 1011 34 205 153 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME xmail_delete_msgs_ 270 external procedure is an external procedure. print_msg internal procedure shares stack frame of external procedure xmail_delete_msgs_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME xmail_delete_msgs_ 000100 add_more_msg xmail_delete_msgs_ 000101 code xmail_delete_msgs_ 000102 i xmail_delete_msgs_ 000103 message_no_string xmail_delete_msgs_ 000166 message_number xmail_delete_msgs_ 000170 message_ptr xmail_delete_msgs_ 000172 mailbox_ptr xmail_delete_msgs_ 000174 curr_msgsp xmail_delete_msgs_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_ mail_system_$mark_message_for_deletion mail_system_$read_message xmail_error_$code_first xmail_error_$no_code xmail_select_msgs_$next xmail_validate_$curr_msgs xmail_validate_$mbx THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. mlsys_et_$cant_be_deleted xmail_err_$no_curr_msgs LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000204 65 000231 66 000242 69 000276 72 000327 73 000340 77 000374 78 000400 80 000403 81 000404 82 000413 83 000416 85 000424 86 000437 89 000477 90 000504 91 000515 93 000521 94 000522 95 000560 96 000561 98 000563 99 000564 102 000622 104 000654 105 000706 107 000711 108 000712 110 000734 113 000735 114 000736 115 001004 ----------------------------------------------------------- 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