COMPILATION LISTING OF SEGMENT write_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 0935.9 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 write_record: 15 proc (p_journal_control_block_ptr, p_buffer_ptr, p_buffer_len, p_code); 16 17 /* Write the given record at the current position. Use get_key to 18* get the current key and new descriptor, make an entry using this information. 19* 20* Written by Lindsey Spratt 08/06/79 21* Modified by Chris Jones 02/14/85 for setting and resetting privileges, and to 22* cleanup properly. 23**/ 24 /* Parameter */ 25 26 dcl p_journal_control_block_ptr 27 ptr; 28 dcl p_buffer_ptr ptr; 29 dcl p_buffer_len fixed bin (21); 30 dcl p_code fixed bin (35); 31 32 /* Automatic */ 33 34 dcl privileges_string bit (36) aligned; 35 dcl scratch_area_ptr ptr; 36 37 /* Based */ 38 39 dcl scratch_area area (4096) based (scratch_area_ptr); 40 41 /* Controlled */ 42 /* Builtin */ 43 44 dcl null builtin; 45 46 /* Condition */ 47 48 dcl cleanup condition; 49 50 /* Entry */ 51 52 dcl get_system_free_area_ entry returns (ptr); 53 dcl iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35)); 54 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); 55 dcl rcprm_registry_util_$turn_on_privs 56 entry (bit (36) aligned); 57 dcl rcprm_registry_util_$turn_off_privs 58 entry (bit (36) aligned); 59 60 /* External */ 61 62 dcl error_table_$locked_by_this_process 63 fixed bin (35) ext; 64 65 66 journal_control_block_ptr = p_journal_control_block_ptr; 67 privileges_string = ""b; 68 gk_info_ptr = null (); 69 on cleanup call clean_up; 70 71 call rcprm_registry_util_$turn_on_privs (privileges_string); 72 call iox_$write_record (journal_control_block.vfile_iocb_ptr, p_buffer_ptr, p_buffer_len, p_code); 73 74 if p_code ^= 0 & p_code ^= error_table_$locked_by_this_process then 75 return; 76 77 gk_key_len = 256; 78 scratch_area_ptr = get_system_free_area_ (); 79 alloc gk_info in (scratch_area); 80 gk_info.input_desc = "0"b; 81 gk_info.input_key = "0"b; 82 gk_info.current = "1"b; 83 gk_info.version = gk_info_version_0; 84 85 call iox_$control (journal_control_block.vfile_iocb_ptr, "get_key", gk_info_ptr, p_code); 86 if p_code ^= 0 & p_code ^= error_table_$locked_by_this_process then do; 87 call clean_up; 88 return; 89 end; 90 91 a_key_len = gk_info.key_len; 92 a_rec_len = 0; 93 alloc journal_entry in (journal_area); 94 journal_entry.type = WRITE_RECORD; 95 journal_entry.key_str = gk_info.key; 96 journal_entry.descriptor = gk_info.descrip; 97 journal_entry.inc_ref_count = "0"b; 98 journal_entry.dec_ref_count = "0"b; 99 journal_entry.next_ptr = null; 100 journal_entry.prev_ptr = journal_control_block.latest_entry_ptr; 101 if journal_control_block.latest_entry_ptr ^= null then 102 journal_control_block.latest_entry_ptr -> journal_entry.next_ptr = journal_entry_ptr; 103 journal_control_block.latest_entry_ptr = journal_entry_ptr; 104 call clean_up; 105 return; 106 107 clean_up: 108 proc; 109 110 call rcprm_registry_util_$turn_off_privs (privileges_string); 111 if gk_info_ptr ^= null () then 112 free gk_info; 113 114 end clean_up; 115 1 1 /* BEGIN INCLUDE FILE journal_entry.incl.pl1 */ 1 2 1 3 dcl journal_entry_ptr ptr; 1 4 dcl a_rec_len fixed bin (21); 1 5 dcl a_key_len fixed bin; 1 6 dcl 1 journal_entry based (journal_entry_ptr) aligned, 1 7 2 head, 1 8 3 prev_ptr ptr, 1 9 3 next_ptr ptr, 1 10 3 type fixed bin, 1 11 2 descriptor fixed bin (35), 1 12 2 inc_ref_count bit (1) init ("0"b), 1 13 2 dec_ref_count bit (1) init ("0"b), 1 14 2 key_len fixed bin , 1 15 2 rec_len fixed bin (21) , 1 16 2 key_str char (a_key_len refer (journal_entry.key_len)), 1 17 2 rec_str char (a_rec_len refer (journal_entry.rec_len)); 1 18 1 19 dcl RS_LOCK fixed bin init(1) options(constant) internal static; 1 20 dcl WRITE_RECORD fixed bin init(2) options(constant) internal static; 1 21 dcl DELETE_RECORD fixed bin init(3) options(constant) internal static; 1 22 dcl ADD_KEY fixed bin init(4) options(constant) internal static; 1 23 dcl DELETE_KEY fixed bin init(5) options(constant) internal static; 1 24 dcl RS_COUNT fixed bin init(6) options(constant) internal static; 1 25 dcl RS_LOCK_COUNT fixed bin init(7) options(constant) internal static; 1 26 dcl RS_LOCK_CREATE fixed bin init(8) options(constant) internal static; 1 27 1 28 /* END INCLUDE FILE journal_entry.incl.pl1 */ 116 2 1 /* BEGIN INCLUDE FILE journal_control_block.incl.pl1 */ 2 2 2 3 dcl sys_info$max_seg_size fixed bin (24) ext; 2 4 2 5 dcl journal_control_block_ptr 2 6 ptr; 2 7 dcl 1 journal_control_block 2 8 aligned based (journal_control_block_ptr), 2 9 2 attach char (128) var, 2 10 2 open_desc char (128) var, 2 11 2 vfile_iocb_ptr ptr, 2 12 2 latest_entry_ptr ptr, 2 13 2 journal_area_ptr ptr; 2 14 2 15 dcl journal_area area (sys_info$max_seg_size) based (journal_control_block.journal_area_ptr) aligned; 2 16 2 17 2 18 /* END INCLUDE FILE journal_control_block.incl.pl1 */ 117 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 */ 118 119 120 end; /* end write_record */ SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0809.2 write_record.pl1 >spec>install>1111>write_record.pl1 116 1 02/11/80 1426.1 journal_entry.incl.pl1 >ldd>include>journal_entry.incl.pl1 117 2 02/11/80 1426.1 journal_control_block.incl.pl1 >ldd>include>journal_control_block.incl.pl1 118 3 07/19/79 1547.0 ak_info.incl.pl1 >ldd>include>ak_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. WRITE_RECORD constant fixed bin(17,0) initial dcl 1-20 ref 94 a_key_len 000115 automatic fixed bin(17,0) dcl 1-5 set ref 91* 93 93 a_rec_len 000114 automatic fixed bin(21,0) dcl 1-4 set ref 92* 93 93 ak_header based structure level 1 unaligned dcl 3-10 cleanup 000104 stack reference condition dcl 48 ref 69 current 0(05) based bit(1) level 5 packed packed unaligned dcl 3-41 set ref 82* dec_ref_count 7 based bit(1) initial level 2 dcl 1-6 set ref 93* 98* descrip 1 based fixed bin(35,0) level 3 dcl 3-41 ref 96 descriptor 5 based fixed bin(35,0) level 2 dcl 1-6 set ref 96* error_table_$locked_by_this_process 000022 external static fixed bin(35,0) dcl 62 ref 74 86 flags based structure level 3 dcl 3-41 get_system_free_area_ 000010 constant entry external dcl 52 ref 78 gk_header based structure level 1 unaligned dcl 3-46 gk_info based structure level 1 unaligned dcl 3-41 set ref 79 111 gk_info_ptr 000120 automatic pointer dcl 3-63 set ref 68* 79* 80 81 82 83 85* 91 95 96 111 111 gk_info_version_0 constant fixed bin(17,0) initial dcl 3-66 ref 83 gk_key_len 000122 automatic fixed bin(17,0) dcl 3-64 set ref 77* 79 79 head based structure level 2 dcl 1-6 header based structure level 2 unaligned dcl 3-41 inc_ref_count 6 based bit(1) initial level 2 dcl 1-6 set ref 93* 97* input_desc 0(01) based bit(1) level 4 packed packed unaligned dcl 3-41 set ref 80* input_key based bit(1) level 4 packed packed unaligned dcl 3-41 set ref 81* iox_$control 000014 constant entry external dcl 54 ref 85 iox_$write_record 000012 constant entry external dcl 53 ref 72 journal_area based area dcl 2-15 ref 93 journal_area_ptr 106 based pointer level 2 dcl 2-7 ref 93 journal_control_block based structure level 1 dcl 2-7 journal_control_block_ptr 000116 automatic pointer dcl 2-5 set ref 66* 72 85 93 100 101 101 103 journal_entry based structure level 1 dcl 1-6 set ref 93 journal_entry_ptr 000112 automatic pointer dcl 1-3 set ref 93* 94 95 96 97 98 99 100 101 103 key 3 based char level 2 packed packed unaligned dcl 3-41 ref 95 key_len 10 based fixed bin(17,0) level 2 in structure "journal_entry" dcl 1-6 in procedure "write_record" set ref 93* 95 key_len 2 based fixed bin(17,0) level 3 in structure "gk_info" dcl 3-41 in procedure "write_record" set ref 79* 91 95 111 key_str 12 based char level 2 dcl 1-6 set ref 95* latest_entry_ptr 104 based pointer level 2 dcl 2-7 set ref 100 101 101 103* next_ptr 2 based pointer level 3 dcl 1-6 set ref 99* 101* null builtin function dcl 44 ref 68 99 101 111 p_buffer_len parameter fixed bin(21,0) dcl 29 set ref 14 72* p_buffer_ptr parameter pointer dcl 28 set ref 14 72* p_code parameter fixed bin(35,0) dcl 30 set ref 14 72* 74 74 85* 86 86 p_journal_control_block_ptr parameter pointer dcl 26 ref 14 66 position_specification 0(05) based structure level 4 packed packed unaligned dcl 3-41 prev_ptr based pointer level 3 dcl 1-6 set ref 100* privileges_string 000100 automatic bit(36) dcl 34 set ref 67* 71* 110* rcprm_registry_util_$turn_off_privs 000020 constant entry external dcl 57 ref 110 rcprm_registry_util_$turn_on_privs 000016 constant entry external dcl 55 ref 71 rec_len 11 based fixed bin(21,0) level 2 dcl 1-6 set ref 93* rk_header based structure level 1 unaligned dcl 3-26 scratch_area based area(4096) dcl 39 ref 79 scratch_area_ptr 000102 automatic pointer dcl 35 set ref 78* 79 type 4 based fixed bin(17,0) level 3 dcl 1-6 set ref 94* version 0(27) based fixed bin(8,0) level 4 packed packed unaligned dcl 3-41 set ref 83* vfile_iocb_ptr 102 based pointer level 2 dcl 2-7 set ref 72* 85* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ADD_KEY internal static fixed bin(17,0) initial dcl 1-22 DELETE_KEY internal static fixed bin(17,0) initial dcl 1-23 DELETE_RECORD internal static fixed bin(17,0) initial dcl 1-21 RS_COUNT internal static fixed bin(17,0) initial dcl 1-24 RS_LOCK internal static fixed bin(17,0) initial dcl 1-19 RS_LOCK_COUNT internal static fixed bin(17,0) initial dcl 1-25 RS_LOCK_CREATE internal static fixed bin(17,0) initial dcl 1-26 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 sys_info$max_seg_size external static fixed bin(24,0) dcl 2-3 NAMES DECLARED BY EXPLICIT CONTEXT. clean_up 000275 constant entry internal dcl 107 ref 69 87 104 write_record 000017 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 456 502 330 466 Length 730 330 24 211 125 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME write_record 118 external procedure is an external procedure. on unit on line 69 64 on unit clean_up 68 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME write_record 000100 privileges_string write_record 000102 scratch_area_ptr write_record 000112 journal_entry_ptr write_record 000114 a_rec_len write_record 000115 a_key_len write_record 000116 journal_control_block_ptr write_record 000120 gk_info_ptr write_record 000122 gk_key_len write_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 iox_$write_record 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 000012 66 000024 67 000030 68 000031 69 000033 71 000055 72 000064 74 000103 77 000111 78 000113 79 000122 80 000134 81 000136 82 000140 83 000142 85 000144 86 000174 87 000202 88 000206 91 000207 92 000212 93 000213 94 000237 95 000241 96 000247 97 000251 98 000252 99 000253 100 000255 101 000260 103 000266 104 000267 105 000273 107 000274 110 000302 111 000311 114 000325 ----------------------------------------------------------- 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