COMPILATION LISTING OF SEGMENT delete_record 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 0940.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 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 14 delete_record: 15 proc (p_journal_control_block_ptr, p_code); 16 17 /* Deletes the current key, after recording it and its descriptor. 18* 19* Written by Lindsey Spratt 08/06/79 20* Modified by Chris Jones 02/15/85 to clean up. 21**/ 22 23 /* Parameter */ 24 25 26 dcl p_journal_control_block_ptr 27 ptr; 28 dcl p_code fixed bin (35); 29 30 /* Automatic */ 31 32 dcl privileges_string bit (36) aligned; 33 dcl scratch_area_ptr ptr; 34 35 /* Based */ 36 37 dcl scratch_area area (4096) based (scratch_area_ptr); 38 39 /* Builtin */ 40 41 dcl null builtin; 42 43 /* Condition */ 44 45 dcl cleanup condition; 46 47 /* Entry */ 48 49 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); 50 dcl get_system_free_area_ entry returns (ptr); 51 dcl rcprm_registry_util_$turn_off_privs 52 entry (bit (36) aligned); 53 dcl rcprm_registry_util_$turn_on_privs 54 entry (bit (36) aligned); 55 56 /* External */ 57 58 dcl error_table_$locked_by_this_process 59 fixed bin (35) ext; 60 61 journal_control_block_ptr = p_journal_control_block_ptr; 62 gk_info_ptr, rs_info_ptr = null (); 63 privileges_string = ""b; 64 on cleanup call clean_up; 65 66 scratch_area_ptr = get_system_free_area_ (); 67 call rcprm_registry_util_$turn_on_privs (privileges_string); 68 gk_key_len = 256; 69 alloc gk_info in (scratch_area); 70 71 gk_info.input_desc = "0"b; 72 gk_info.input_key = "0"b; 73 gk_info.desc_code = 0; 74 gk_info.current = "1"b; 75 gk_info.version = gk_info_version_0; 76 77 call iox_$control (journal_control_block.vfile_iocb_ptr, "get_key", gk_info_ptr, p_code); 78 if p_code ^= 0 & p_code ^= error_table_$locked_by_this_process then do; 79 call clean_up; 80 return; 81 end; 82 83 alloc rs_info in (scratch_area); 84 rs_info.version = rs_info_version_2; 85 rs_info.locate_sw = "0"b; 86 rs_info.inc_ref_count = "1"b; 87 call iox_$control (journal_control_block.vfile_iocb_ptr, "record_status", rs_info_ptr, p_code); 88 if p_code ^= 0 & p_code ^= error_table_$locked_by_this_process then do; 89 call clean_up; 90 return; 91 end; 92 call iox_$control (journal_control_block.vfile_iocb_ptr, "delete_key", null, p_code); 93 if p_code ^= 0 & p_code ^= error_table_$locked_by_this_process then do; 94 call clean_up; 95 return; 96 end; 97 98 a_key_len = gk_info.key_len; 99 a_rec_len = 0; 100 alloc journal_entry in (journal_area); 101 journal_entry.inc_ref_count = "0"b; 102 journal_entry.dec_ref_count = "0"b; 103 journal_entry.key_str = gk_info.key; 104 journal_entry.type = DELETE_RECORD; 105 journal_entry.descriptor = gk_info.descrip; 106 journal_entry.next_ptr = null; 107 journal_entry.prev_ptr = journal_control_block.latest_entry_ptr; 108 if journal_control_block.latest_entry_ptr ^= null then 109 journal_control_block.latest_entry_ptr -> journal_entry.next_ptr = journal_entry_ptr; 110 journal_control_block.latest_entry_ptr = journal_entry_ptr; 111 call clean_up; 112 return; 113 114 clean_up: 115 proc; 116 117 if gk_info_ptr ^= null () then 118 free gk_info; 119 if rs_info_ptr ^= null () then 120 free rs_info; 121 call rcprm_registry_util_$turn_off_privs (privileges_string); 122 123 end clean_up; 124 1 1 /* BEGIN INCLUDE FILE journal_control_block.incl.pl1 */ 1 2 1 3 dcl sys_info$max_seg_size fixed bin (24) ext; 1 4 1 5 dcl journal_control_block_ptr 1 6 ptr; 1 7 dcl 1 journal_control_block 1 8 aligned based (journal_control_block_ptr), 1 9 2 attach char (128) var, 1 10 2 open_desc char (128) var, 1 11 2 vfile_iocb_ptr ptr, 1 12 2 latest_entry_ptr ptr, 1 13 2 journal_area_ptr ptr; 1 14 1 15 dcl journal_area area (sys_info$max_seg_size) based (journal_control_block.journal_area_ptr) aligned; 1 16 1 17 1 18 /* END INCLUDE FILE journal_control_block.incl.pl1 */ 125 2 1 /* BEGIN INCLUDE FILE journal_entry.incl.pl1 */ 2 2 2 3 dcl journal_entry_ptr ptr; 2 4 dcl a_rec_len fixed bin (21); 2 5 dcl a_key_len fixed bin; 2 6 dcl 1 journal_entry based (journal_entry_ptr) aligned, 2 7 2 head, 2 8 3 prev_ptr ptr, 2 9 3 next_ptr ptr, 2 10 3 type fixed bin, 2 11 2 descriptor fixed bin (35), 2 12 2 inc_ref_count bit (1) init ("0"b), 2 13 2 dec_ref_count bit (1) init ("0"b), 2 14 2 key_len fixed bin , 2 15 2 rec_len fixed bin (21) , 2 16 2 key_str char (a_key_len refer (journal_entry.key_len)), 2 17 2 rec_str char (a_rec_len refer (journal_entry.rec_len)); 2 18 2 19 dcl RS_LOCK fixed bin init(1) options(constant) internal static; 2 20 dcl WRITE_RECORD fixed bin init(2) options(constant) internal static; 2 21 dcl DELETE_RECORD fixed bin init(3) options(constant) internal static; 2 22 dcl ADD_KEY fixed bin init(4) options(constant) internal static; 2 23 dcl DELETE_KEY fixed bin init(5) options(constant) internal static; 2 24 dcl RS_COUNT fixed bin init(6) options(constant) internal static; 2 25 dcl RS_LOCK_COUNT fixed bin init(7) options(constant) internal static; 2 26 dcl RS_LOCK_CREATE fixed bin init(8) options(constant) internal static; 2 27 2 28 /* END INCLUDE FILE journal_entry.incl.pl1 */ 126 127 3 1 /* ak_info -- include file for info structures used by the following vfile_ 3 2* control orders: "add_key", "delete_key", "get_key", and "reassign_key". 3 3* Created by M. Asherman 3/23/76 3 4* Modified 5/13/77 to add separate gk_info structure */ 3 5 3 6 dcl 1 ak_info based (ak_info_ptr), 3 7 2 header like ak_header, 3 8 2 key char (ak_key_len refer (ak_info.header.key_len)); 3 9 3 10 dcl 1 ak_header based (ak_info_ptr), 3 11 2 flags aligned, 3 12 3 input_key bit (1) unal, /* set if key is input arg */ 3 13 3 input_desc bit (1) unal, /* set if descriptor is an input arg */ 3 14 3 mbz bit (34) unal, /* not used for the present */ 3 15 2 descrip fixed (35), /* record designator */ 3 16 2 key_len fixed; 3 17 3 18 dcl ak_info_ptr ptr; 3 19 dcl ak_key_len fixed; 3 20 3 21 3 22 dcl 1 rk_info based (rk_info_ptr), 3 23 2 header like rk_header, 3 24 2 key char (rk_key_len refer (rk_info.header.key_len)); 3 25 3 26 dcl 1 rk_header based (rk_info_ptr), 3 27 2 flags aligned, 3 28 3 input_key bit (1) unal, /* same as above */ 3 29 3 input_old_desc bit (1) unal, /* set if specified entry has initial descrip 3 30* given by old_descrip */ 3 31 3 input_new_desc bit (1) unal, /* set if new val for descrip is input in this struc */ 3 32 3 mbz bit (33) unal, 3 33 2 old_descrip fixed (35), /* used if first flag is set */ 3 34 2 new_descrip fixed (35), /* used only if second flag is set */ 3 35 2 key_len fixed; 3 36 3 37 dcl rk_info_ptr ptr; 3 38 dcl rk_key_len fixed; 3 39 3 40 3 41 dcl 1 gk_info based (gk_info_ptr), /* structure for get_key order */ 3 42 2 header like gk_header, 3 43 2 key char (gk_key_len refer (gk_info.header.key_len)); 3 44 /* may be Input as well as Output */ 3 45 3 46 dcl 1 gk_header based (gk_info_ptr), 3 47 2 flags aligned, 3 48 3 input_key bit (1) unal, /* if set, use key in this structure */ 3 49 3 input_desc bit (1) unal, /* if set, descriptor given in this structure */ 3 50 3 desc_code fixed (2) unal, /* 0=any, 1=current -- applies when input_desc="0"b */ 3 51 3 position_specification 3 52 unal, 3 53 4 current bit (1) unal, /* otherwise next */ 3 54 4 rel_type fixed (2) unal, /* as in seek_head, if input_key = "1"b */ 3 55 4 head_size fixed bin (9) unsigned unaligned, 3 56 /* size of head for initial seek */ 3 57 3 reset_pos bit (1) unal, /* if set, final position unchanged by this operation */ 3 58 3 pad bit (8) unal, 3 59 3 version fixed (8) unal, 3 60 2 descrip fixed (35), /* Output, except when input_desc="1"b */ 3 61 2 key_len fixed; /* Input when input_key="1"b, also Output in all cases */ 3 62 3 63 dcl gk_info_ptr ptr; 3 64 dcl gk_key_len fixed; 3 65 3 66 dcl gk_info_version_0 internal static fixed options (constant) init (0); 3 67 3 68 /* end ak_info.incl.pl1 */ 128 4 1 /* include file for info structure used with record_status control order 4 2* created by M. Asherman 1/6/76 */ 4 3 /* modified 6/15/77 to support stationary type records */ 4 4 4 5 dcl rs_info_ptr ptr; 4 6 dcl 1 rs_info based (rs_info_ptr) aligned, 4 7 2 version fixed, /* must be set to 1 or 2 (Input) */ 4 8 2 flags aligned, 4 9 3 lock_sw bit (1) unal, /* Input -- if ="1"b try to lock record */ 4 10 3 unlock_sw bit (1) unal, /* Input -- if ="1"b try to unlock record */ 4 11 3 create_sw bit (1) unal, /* Input--if set creat new record */ 4 12 3 locate_sw bit (1) unal, /* Input--if set causes current rec to be 4 13* located outside the index by descrip, or created without key */ 4 14 3 inc_ref_count bit (1) unal, /* Input--bump reference count of record, if stationary */ 4 15 3 dec_ref_count bit (1) unal, /* Input--decrement ref count if this flag set and record stationary */ 4 16 3 locate_pos_sw bit (1) unal, /* Input--if set the record_length is taken 4 17* as an input argument specifying the absolute logical record positioni to which both the current and next positions will be set */ 4 18 3 mbz1 bit (29) unal, /* must be set to "0"b, reserved for future use */ 4 19 2 record_length fixed (21), /* length in bytes, Input if create_sw set */ 4 20 2 max_rec_len fixed (21), /* max length of contained record 4 21* Input if create_sw is set--overrides min_block_size in effect */ 4 22 2 record_ptr ptr, /* points to first byte of record--will be word aligned */ 4 23 2 descriptor fixed (35), /* Input if locate_sw set and create_sw="0"b */ 4 24 2 ref_count fixed (34), /* Output--should match number of keys on this record-- = -1 if non-stationary record */ 4 25 2 time_last_modified fixed (71), /* Output */ 4 26 2 modifier fixed (35), /* Output--also Input when locking */ 4 27 2 block_ptr ptr unal, /* Output */ 4 28 2 last_image_modifier 4 29 fixed (35), 4 30 2 mbz2 fixed; 4 31 4 32 dcl 1 rs_desc based (addr (rs_info.descriptor)), 4 33 /* record block descriptor structure */ 4 34 2 comp_num fixed (17) unal, /* msf component number */ 4 35 2 offset bit (18) unal; /* word offset of record block */ 4 36 4 37 dcl 1 seq_desc based (addr (rs_info.descriptor)), 4 38 /* for sequential files */ 4 39 2 bitno bit (6) unal, 4 40 2 comp_num fixed (11) unal, /* msf component number */ 4 41 2 wordno bit (18) unal; /* word offset */ 4 42 4 43 dcl rs_info_version_1 static internal fixed init (1); 4 44 dcl rs_info_version_2 static internal fixed init (2); 4 45 129 130 131 end delete_record; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0808.5 delete_record.pl1 >spec>install>1111>delete_record.pl1 125 1 02/11/80 1426.1 journal_control_block.incl.pl1 >ldd>include>journal_control_block.incl.pl1 126 2 02/11/80 1426.1 journal_entry.incl.pl1 >ldd>include>journal_entry.incl.pl1 128 3 07/19/79 1547.0 ak_info.incl.pl1 >ldd>include>ak_info.incl.pl1 129 4 07/19/79 1547.0 rs_info.incl.pl1 >ldd>include>rs_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. DELETE_RECORD constant fixed bin(17,0) initial dcl 2-21 ref 104 a_key_len 000117 automatic fixed bin(17,0) dcl 2-5 set ref 98* 100 100 a_rec_len 000116 automatic fixed bin(21,0) dcl 2-4 set ref 99* 100 100 ak_header based structure level 1 unaligned dcl 3-10 cleanup 000104 stack reference condition dcl 45 ref 64 current 0(05) based bit(1) level 5 packed packed unaligned dcl 3-41 set ref 74* dec_ref_count 7 based bit(1) initial level 2 dcl 2-6 set ref 100* 102* desc_code 0(02) based fixed bin(2,0) level 4 packed packed unaligned dcl 3-41 set ref 73* descrip 1 based fixed bin(35,0) level 3 dcl 3-41 ref 105 descriptor 5 based fixed bin(35,0) level 2 dcl 2-6 set ref 105* error_table_$locked_by_this_process 000020 external static fixed bin(35,0) dcl 58 ref 78 88 93 flags 1 based structure level 2 in structure "rs_info" dcl 4-6 in procedure "delete_record" flags based structure level 3 in structure "gk_info" dcl 3-41 in procedure "delete_record" get_system_free_area_ 000012 constant entry external dcl 50 ref 66 gk_header based structure level 1 unaligned dcl 3-46 gk_info based structure level 1 unaligned dcl 3-41 set ref 69 117 gk_info_ptr 000120 automatic pointer dcl 3-63 set ref 62* 69* 71 72 73 74 75 77* 98 103 105 117 117 gk_info_version_0 constant fixed bin(17,0) initial dcl 3-66 ref 75 gk_key_len 000122 automatic fixed bin(17,0) dcl 3-64 set ref 68* 69 69 head based structure level 2 dcl 2-6 header based structure level 2 unaligned dcl 3-41 inc_ref_count 6 based bit(1) initial level 2 in structure "journal_entry" dcl 2-6 in procedure "delete_record" set ref 100* 101* inc_ref_count 1(04) based bit(1) level 3 in structure "rs_info" packed packed unaligned dcl 4-6 in procedure "delete_record" set ref 86* input_desc 0(01) based bit(1) level 4 packed packed unaligned dcl 3-41 set ref 71* input_key based bit(1) level 4 packed packed unaligned dcl 3-41 set ref 72* iox_$control 000010 constant entry external dcl 49 ref 77 87 92 journal_area based area dcl 1-15 ref 100 journal_area_ptr 106 based pointer level 2 dcl 1-7 ref 100 journal_control_block based structure level 1 dcl 1-7 journal_control_block_ptr 000112 automatic pointer dcl 1-5 set ref 61* 77 87 92 100 107 108 108 110 journal_entry based structure level 1 dcl 2-6 set ref 100 journal_entry_ptr 000114 automatic pointer dcl 2-3 set ref 100* 101 102 103 104 105 106 107 108 110 key 3 based char level 2 packed packed unaligned dcl 3-41 ref 103 key_len 10 based fixed bin(17,0) level 2 in structure "journal_entry" dcl 2-6 in procedure "delete_record" set ref 100* 103 key_len 2 based fixed bin(17,0) level 3 in structure "gk_info" dcl 3-41 in procedure "delete_record" set ref 69* 98 103 117 key_str 12 based char level 2 dcl 2-6 set ref 103* latest_entry_ptr 104 based pointer level 2 dcl 1-7 set ref 107 108 108 110* locate_sw 1(03) based bit(1) level 3 packed packed unaligned dcl 4-6 set ref 85* next_ptr 2 based pointer level 3 dcl 2-6 set ref 106* 108* null builtin function dcl 41 ref 62 92 92 106 108 117 119 p_code parameter fixed bin(35,0) dcl 28 set ref 14 77* 78 78 87* 88 88 92* 93 93 p_journal_control_block_ptr parameter pointer dcl 26 ref 14 61 position_specification 0(05) based structure level 4 packed packed unaligned dcl 3-41 prev_ptr based pointer level 3 dcl 2-6 set ref 107* privileges_string 000100 automatic bit(36) dcl 32 set ref 63* 67* 121* rcprm_registry_util_$turn_off_privs 000014 constant entry external dcl 51 ref 121 rcprm_registry_util_$turn_on_privs 000016 constant entry external dcl 53 ref 67 rec_len 11 based fixed bin(21,0) level 2 dcl 2-6 set ref 100* rk_header based structure level 1 unaligned dcl 3-26 rs_info based structure level 1 dcl 4-6 set ref 83 119 rs_info_ptr 000124 automatic pointer dcl 4-5 set ref 62* 83* 84 85 86 87* 119 119 rs_info_version_2 constant fixed bin(17,0) initial dcl 4-44 ref 84 scratch_area based area(4096) dcl 37 ref 69 83 scratch_area_ptr 000102 automatic pointer dcl 33 set ref 66* 69 83 type 4 based fixed bin(17,0) level 3 dcl 2-6 set ref 104* version 0(27) based fixed bin(8,0) level 4 in structure "gk_info" packed packed unaligned dcl 3-41 in procedure "delete_record" set ref 75* version based fixed bin(17,0) level 2 in structure "rs_info" dcl 4-6 in procedure "delete_record" set ref 84* vfile_iocb_ptr 102 based pointer level 2 dcl 1-7 set ref 77* 87* 92* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ADD_KEY internal static fixed bin(17,0) initial dcl 2-22 DELETE_KEY internal static fixed bin(17,0) initial dcl 2-23 RS_COUNT internal static fixed bin(17,0) initial dcl 2-24 RS_LOCK internal static fixed bin(17,0) initial dcl 2-19 RS_LOCK_COUNT internal static fixed bin(17,0) initial dcl 2-25 RS_LOCK_CREATE internal static fixed bin(17,0) initial dcl 2-26 WRITE_RECORD internal static fixed bin(17,0) initial dcl 2-20 ak_info based structure level 1 unaligned dcl 3-6 ak_info_ptr automatic pointer dcl 3-18 ak_key_len automatic fixed bin(17,0) dcl 3-19 rk_info based structure level 1 unaligned dcl 3-22 rk_info_ptr automatic pointer dcl 3-37 rk_key_len automatic fixed bin(17,0) dcl 3-38 rs_desc based structure level 1 packed packed unaligned dcl 4-32 rs_info_version_1 internal static fixed bin(17,0) initial dcl 4-43 seq_desc based structure level 1 packed packed unaligned dcl 4-37 sys_info$max_seg_size external static fixed bin(24,0) dcl 1-3 NAMES DECLARED BY EXPLICIT CONTEXT. clean_up 000415 constant entry internal dcl 114 ref 64 79 89 94 111 delete_record 000027 constant entry external dcl 14 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 604 626 461 614 Length 1070 461 22 226 122 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME delete_record 111 external procedure is an external procedure. on unit on line 64 64 on unit clean_up 68 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME delete_record 000100 privileges_string delete_record 000102 scratch_area_ptr delete_record 000112 journal_control_block_ptr delete_record 000114 journal_entry_ptr delete_record 000116 a_rec_len delete_record 000117 a_key_len delete_record 000120 gk_info_ptr delete_record 000122 gk_key_len delete_record 000124 rs_info_ptr delete_record THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this call_int_other return_mac enable_op ext_entry int_entry op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. get_system_free_area_ iox_$control rcprm_registry_util_$turn_off_privs rcprm_registry_util_$turn_on_privs THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$locked_by_this_process LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 14 000023 61 000034 62 000040 63 000043 64 000044 66 000066 67 000075 68 000104 69 000106 71 000120 72 000122 73 000124 74 000130 75 000132 77 000134 78 000164 79 000172 80 000176 83 000177 84 000204 85 000206 86 000210 87 000212 88 000246 89 000254 90 000260 92 000261 93 000314 94 000322 95 000326 98 000327 99 000332 100 000333 101 000357 102 000360 103 000361 104 000367 105 000371 106 000373 107 000375 108 000400 110 000406 111 000407 112 000413 114 000414 117 000422 119 000436 121 000445 123 000455 ----------------------------------------------------------- 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