ms_salv_util_v2_.pl1 05/10/85 0856.6r w 05/06/85 1619.0 119205 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ %; /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ ms_salv_util_v2_: proc (a_forward, a_salv_ptr, a_new_alloc_ptr, a_nrec, a_alloc_len, a_saved_messages, a_saved_blocks, a_last_saved_ms_ptr, a_code); /* Adapted from original version 2 ms_salv_util_ by J.Stern, 11/4/74 */ dcl (a_saved_blocks, /* number of saved message blocks (argument) */ a_saved_messages, /* number of saved messages (argument) */ block_bit_count, /* bit count of message portion in block */ block_hdr_data, /* words in header */ block_trailer_data, /* words in trailer */ first_full_block_bit_count, /* bits allocated to first block message portion */ full_block_bit_count, /* bits allocated to message portion */ i, /* do loop index */ label_var, /* label variable */ max_message_blocks, /* maximum blocks in a message */ message_blocks, /* number of unchecked blocks in message */ mseg_data_v2_$block_hdr_data ext, /* words in header */ mseg_data_v2_$block_trailer_data ext, /* words in trailer */ saved_blocks init (0), /* number of saved message blocks (internal) */ saved_messages init (0), /* number of saved messages (internal) */ tsaved_blocks, /* blocks saved in message */ zero_words (8) init (0, 0, 0, 0, 0, 0, 0, 0) ) fixed bin; dcl (a_alloc_len, a_nrec, alloc_len, /* length of allocation bit string */ backward_offset, /* offset to backward threaded message */ bit_off, /* offset of allocation bit for block */ block_ms_words, /* allocated size for message portion */ block_offset, /* offset to message block */ block_size, /* size of message block in words */ first_block_ms_words, /* allocated size for first block message portion */ forward_offset, /* offset to forward threaded message */ max_message_size, /* maximum words in a message */ message_words, /* word count of message */ ms_offset, /* offset to first block of message */ mseg_data_v2_$block_size ext, /* default block size */ mseg_data_v2_$max_message_size ext, next_block_offset, /* offset to next message block in message */ nrec, previous_offset init (0), /* offset to previous message */ seg_size, /* maximum size of message segment */ tr_offset) /* offset from beginning of block to trailer */ fixed bin (18); dcl ( a_code, /* error code */ code init (0) ) fixed bin (35); dcl (a_forward, /* ON if salvage is forward (argument) */ first_block, /* ON if block is first block in message */ forward) /* ON if salvage is forward (internal) */ bit (1) aligned; dcl ( mseg_data_v2_$mseg_tr36 ext /* trailer recognition pattern */ ) bit (36) aligned; dcl (a_last_saved_ms_ptr, /* pointer to last saved message (argument) */ a_new_alloc_ptr, /* pointer to new allocation bits(argument) */ a_salv_ptr, /* pointer to where to begin salvaging */ check_ptr, /* pointer to be tested for validity */ last_saved_ms_ptr init (null), /* pointer to last saved message(internal) */ new_alloc_ptr, /* pointer to new allocation bits(argument) */ next_ms_ptr, /* pointer to next message */ test_block_ptr, /* pointer to message block being tested */ test_ms_ptr) /* pointer to message being tested */ ptr; dcl (addrel, divide, fixed, mod, null, ptr, rel) builtin; dcl bit_mask (alloc_len) based (new_alloc_ptr) bit (1) unaligned; /* mask for setting allocation bits */ dcl zeroes char (32) aligned based (addr (zero_words (1))); % include mseg_hdr_v2; % include ms_block_hdr_v2; % include ms_block_trailer_v2; dcl hcs_$get_max_length_seg ext entry (ptr, fixed bin (18), fixed bin (35)); dcl ptr_is_good_v2_$ms_salvager_entry ext entry (ptr, fixed bin (18)) returns (bit (1) aligned); /* */ max_message_size = mseg_data_v2_$max_message_size; mptr = ptr (a_salv_ptr, 0); /* make pointer to message segment */ block_size = fixed (mseg_hdr_v2.block_size, 18); call hcs_$get_max_length_seg (mptr, seg_size, code); if code ^= 0 then go to FIN; if block_size <= 0 /* check for reasonable value */ then SET_BLOCK_SIZE: block_size = fixed (mseg_data_v2_$block_size); /* take external one if bad */ else if mod (seg_size, block_size) ^= 0 then go to SET_BLOCK_SIZE; max_message_blocks = divide (max_message_size, block_size, 18, 0); /* compute max blocks in message */ block_hdr_data = mseg_data_v2_$block_hdr_data; block_trailer_data = mseg_data_v2_$block_trailer_data; forward = a_forward; /* copy argument */ next_ms_ptr = a_salv_ptr; /* where to begin salvaging */ nrec = a_nrec; alloc_len = a_alloc_len; ms_offset = fixed (rel (next_ms_ptr), 18); /* offset of where to begin salvaging */ new_alloc_ptr = a_new_alloc_ptr; /* copy argument */ last_saved_ms_ptr = null; /* initialize pointer to last saved message */ tr_offset = block_size - block_trailer_data; /* initialize trailer offset */ first_block_ms_words = /* intialize word count of full first block */ block_size - (block_hdr_data + block_trailer_data); first_full_block_bit_count = /* initialize bit count of full first block */ first_block_ms_words * 36; full_block_bit_count = /* initialize bit count of full block */ (block_size - block_hdr_data) * 36; block_ms_words = /* initialize word count of full block */ block_size - block_hdr_data; /* */ begin; dcl bit_offset (max_message_blocks) fixed bin (18); /* array of offsets into alloc bits */ LABEL (1): CHECK_MESSAGE: first_block = "1"b; /* remember this is a first block of a message */ tsaved_blocks = 0; /* initialize blocks saved in message */ test_ms_ptr = next_ms_ptr; /* set pointer to message to be tested */ ms_offset = fixed (rel (next_ms_ptr), 18); /* set offset of message to be tested */ tr_ptr = addrel (test_ms_ptr, tr_offset); /* make a pointer to the trailer */ if tr_ptr -> ms_block_trailer_v2.tr_pattern ^= mseg_data_v2_$mseg_tr36 /* no trailer pattern */ then go to FIN; forward_offset = /* get offset to next message */ fixed (tr_ptr -> ms_block_trailer_v2.f_offset, 18); if forward_offset ^= 0 then if forward_offset > nrec*1024 /* forward offset off end of segment */ then go to FIN; /* give up */ if forward_offset = 0 /* this should be last message in segment */ then if mseg_hdr_v2.last_ms_offset ^= rel (test_ms_ptr) /* header doesn't agree */ then go to FIN; /* give up */ backward_offset = /* get offset to previous message */ fixed (tr_ptr -> ms_block_trailer_v2.b_offset, 18); if backward_offset ^= 0 then if backward_offset > nrec*1024 /* previous offset off end of message */ then go to FIN; if backward_offset = 0 /* this should be first message */ then if mseg_hdr_v2.first_ms_offset ^= rel (test_ms_ptr) /* header doesn't agree */ then go to FIN; if ms_size = "0"b /* check for zeroing out */ | time = "0"b | sender_id = zeroes then go to FIN; if (forward) /* forward salvage */ then do; if previous_offset ^= 0 /* there was a previous message */ then if backward_offset ^= previous_offset /* this message doesn't point to it */ then go to FIN; /* give up */ check_ptr, /* create pointer to next message */ next_ms_ptr = ptr (test_ms_ptr, forward_offset); end; else /* backward salvage */ do; if previous_offset ^= 0 /* there was a previous message */ then if forward_offset ^= previous_offset /* this message doesn't point to it */ then go to FIN; /* give up */ check_ptr, /* create pointer to next message */ next_ms_ptr = ptr (test_ms_ptr, backward_offset); end; previous_offset = ms_offset; /* remember for next message check */ if fixed (rel (next_ms_ptr), 18) ^= 0 /* there is a next message */ then if (^ptr_is_good_v2_$ms_salvager_entry (next_ms_ptr, block_size)) /* bad offset to next message */ then go to FIN; /* give up */ message_words = /* calculate number of words in message */ divide (fixed (tr_ptr -> ms_block_trailer_v2.ms_size, 18)+35, 36, 18, 0); if message_words <= 0 /* bad word count */ then go to FIN; /* give up */ if message_words > max_message_size then go to FIN; if message_words <= first_block_ms_words /* calculate blocks in message */ then message_blocks = 1; else message_blocks = divide (message_words-first_block_ms_words+block_ms_words-1, block_ms_words, 17, 0)+1; block_offset = fixed (rel (test_ms_ptr), 18); test_block_ptr = test_ms_ptr; /* set pointer for testing rest of block */ /* */ /* check the block header */ LABEL (2): CHECK_BLOCK: /* check to see if the block has been allocated */ bit_off = divide (block_offset, block_size, 18, 0)+1; /* calculate bit offset in alloc bits */ do i = 1 to tsaved_blocks; /* check against other blocks in this message */ if bit_offset (i) = bit_off /* block is used */ then go to FIN; /* give up */ end; if new_alloc_ptr -> bit_mask (bit_off) = "1"b /* block is used */ then go to FIN; if test_block_ptr -> ms_block_hdr.first_block ^= first_block /* bad first block flag */ then go to FIN; block_bit_count = /* get size of message portion in block */ fixed (test_block_ptr -> ms_block_hdr.block_count, 17); if block_bit_count <= 0 /* bad block bit count */ then go to FIN; /* give up */ if (first_block) /* first block of a message */ then do; if message_blocks ^= 1 /* another block follows */ then do; if block_bit_count ^= first_full_block_bit_count /* error in block bit count */ then go to FIN; end; else /* no blocks follow */ if block_bit_count > first_full_block_bit_count /* error in block bit count */ then go to FIN; end; else /* not first block in message */ do; if message_blocks ^= 1 /* another block follows */ then do; if block_bit_count ^= full_block_bit_count /* error in block bit count */ then go to FIN; /* give up */ end; else /* last block in message */ if block_bit_count > full_block_bit_count /* bad block bit count */ then go to FIN; /* give up */ end; next_block_offset = /* get the offset to the next message block */ fixed (test_block_ptr -> ms_block_hdr.f_offset, 18); bit_offset (tsaved_blocks + 1) = bit_off; /* remember location of block */ if message_blocks = 1 /* last block in message */ then do; if next_block_offset ^= 0 /* block pointer bad */ then go to FIN; else /* legitimate end of message */ do; saved_blocks = /* add in saved blocks */ saved_blocks + tsaved_blocks +1; do i = 1 to tsaved_blocks + 1; /* turn on the appropriate allocation bits */ new_alloc_ptr -> bit_mask (bit_offset (i)) = "1"b; end; saved_messages = /* add in saved message */ saved_messages + 1; last_saved_ms_ptr = test_ms_ptr; /* set pointer to saved message */ check_ptr = next_ms_ptr; /* prepare to check pointer */ label_var = 1; /* prepare for next message check */ end; end; else /* not end of message */ do; first_block = "0"b; /* remember next block is not a first block */ message_blocks = message_blocks - 1; /* decrement blocks left to check */ tsaved_blocks = tsaved_blocks + 1; /* increment temporary saved block count */ block_offset = next_block_offset; /* reset for testing next block */ test_block_ptr, /* make a pointer to the next block */ check_ptr = /* prepare to check the pointer */ ptr (test_block_ptr, next_block_offset); label_var = 2; /* prepare for next block check */ end; if (ptr_is_good_v2_$ms_salvager_entry (check_ptr, block_size)) /* new pointer is ok */ then go to LABEL (label_var); /* check next block */ end; /* of BEGIN block */ /* */ FIN: a_saved_messages = saved_messages; /* return appropriate values */ a_saved_blocks = saved_blocks; a_last_saved_ms_ptr = last_saved_ms_ptr; a_code = code; return; end ms_salv_util_v2_;  ms_salv_util_v3_.pl1 05/10/85 0856.6r w 05/06/85 1619.0 127143 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ %; /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ ms_salv_util_v3_: proc (a_forward, a_salv_ptr, a_new_alloc_ptr, a_new_ht_ptr, a_block_size, a_seg_size, a_alloc_len, a_hdr_alloc_len, a_mseg_access_class, a_saved_messages, a_saved_blocks, a_last_saved_ms_ptr); /* Modified for version 3 message segments by J. Stern, 10/30/74 */ /* Modified by J. Stern, 11/14/75 */ /* Modified 3/77 by Charlie Davis for the installation of version 4 message segments */ dcl (a_saved_blocks, /* number of saved message blocks (argument) */ a_saved_messages, /* number of saved messages (argument) */ block_bit_count, /* bit count of message portion in block */ block_hdr_size, /* words in header */ block_trailer_size, /* words in trailer */ first_full_block_bit_count, /* bits allocated to first block message portion */ full_block_bit_count, /* bits allocated to message portion */ i, /* do loop index */ htx, /* hash table index */ max_message_blocks, /* maximum blocks in a message */ message_blocks, /* number of unchecked blocks in message */ saved_blocks init (0), /* number of saved message blocks (internal) */ saved_messages init (0), /* number of saved messages (internal) */ tsaved_blocks, /* blocks saved in message */ zero_words (8) init (0, 0, 0, 0, 0, 0, 0, 0) ) fixed bin; dcl (a_alloc_len, /* length of allocation bit string */ a_hdr_alloc_len, /* the part of alloc_len devoted to the header */ a_block_size, /* block size */ a_seg_size, /* max length of message seg */ alloc_len, /* length of allocation bit string */ hdr_alloc_len, backward_offset, /* offset to backward threaded message */ bit_off, /* offset of allocation bit for block */ block_ms_words, /* allocated size for message portion */ block_offset, /* offset to message block */ block_size, /* size of message block in words */ first_block_ms_words, /* allocated size for first block message portion */ forward_offset, /* offset to forward threaded message */ max_message_size, /* maximum words in a message */ message_words, /* word count of message */ ms_offset, /* offset to first block of message */ mseg_data_v3_$block_size ext, /* default block size */ mseg_data_v3_$max_message_size ext, next_block_offset, /* offset to next message block in message */ seg_size, previous_offset init (0), /* offset to previous message */ tr_offset) /* offset from beginning of block to trailer */ fixed bin (18); dcl (a_forward, /* ON if salvage is forward (argument) */ first_block, /* ON if block is first block in message */ forward) /* ON if salvage is forward (internal) */ bit (1) aligned; dcl (a_last_saved_ms_ptr, /* pointer to last saved message (argument) */ a_new_alloc_ptr, /* pointer to new allocation bits(argument) */ a_new_ht_ptr, /* pointer to new hash table (argument) */ a_salv_ptr, /* pointer to where to begin salvaging */ last_saved_ms_ptr init (null), /* pointer to last saved message(internal) */ new_alloc_ptr, /* pointer to new allocation bits(argument) */ new_ht_ptr, /* pointer to new hash table (internal) */ next_ms_ptr, /* pointer to next message */ test_block_ptr, /* pointer to message block being tested */ test_ms_ptr) /* pointer to message being tested */ ptr; dcl prev_ms_id bit (72) aligned; /* previous message id */ dcl (a_mseg_access_class, mseg_access_class) bit (72) aligned; /* message segment access class */ dcl 1 new_hash_table aligned based (new_ht_ptr), /* new hash table */ 2 last_in_bucket (0:511) bit (18) unaligned; dcl (addr, addrel, divide, fixed, mod, null, ptr, rel, size, substr) builtin; dcl bit_mask (alloc_len) based (new_alloc_ptr) bit (1) unaligned; /* mask for setting allocation bits */ dcl zeroes char (32) aligned based (addr (zero_words (1))); % include mseg_hdr_v3; % include ms_block_hdr_v3; % include ms_block_trailer_v3; dcl aim_check_$greater_or_equal ext entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); /* */ mptr = ptr (a_salv_ptr, 0); /* make pointer to message segment */ max_message_size = mseg_data_v3_$max_message_size; block_size = a_block_size; max_message_blocks = divide (max_message_size, block_size, 18, 0); /* compute max blocks in message */ block_hdr_size = size (ms_block_hdr); block_trailer_size = size (ms_block_trailer); forward = a_forward; /* copy argument */ next_ms_ptr = a_salv_ptr; /* where to begin salvaging */ seg_size = a_seg_size; alloc_len = a_alloc_len; hdr_alloc_len = a_hdr_alloc_len; ms_offset = fixed (rel (next_ms_ptr), 18); /* offset of where to begin salvaging */ call check_offset (ms_offset); new_alloc_ptr = a_new_alloc_ptr; /* copy argument */ new_ht_ptr = a_new_ht_ptr; mseg_access_class = a_mseg_access_class; tr_offset = block_size - block_trailer_size; /* initialize trailer offset */ first_block_ms_words = /* intialize word count of full first block */ block_size - (block_hdr_size + block_trailer_size); first_full_block_bit_count = /* initialize bit count of full first block */ first_block_ms_words * 36; full_block_bit_count = /* initialize bit count of full block */ (block_size - block_hdr_size) * 36; block_ms_words = /* initialize word count of full block */ block_size - block_hdr_size; if forward then prev_ms_id = (72) "0"b; else prev_ms_id = (72) "1"b; /* */ begin; dcl bit_offset (max_message_blocks) fixed bin (18); /* array of offsets into alloc bits */ CHECK_MESSAGE: first_block = "1"b; /* remember this is a first block of a message */ tsaved_blocks = 0; /* initialize blocks saved in message */ test_ms_ptr = next_ms_ptr; /* set pointer to message to be tested */ ms_offset = fixed (rel (next_ms_ptr), 18); /* set offset of message to be tested */ tr_ptr = addrel (test_ms_ptr, tr_offset); /* make a pointer to the trailer */ if tr_ptr -> ms_block_trailer.tr_pattern ^= trailer_pattern /* no trailer pattern */ then go to FIN; forward_offset = /* get offset to next message */ fixed (tr_ptr -> ms_block_trailer.f_offset, 18); if forward_offset ^= 0 then call check_offset (forward_offset); /* forward offset off end of segment */ else if mseg_hdr.last_ms_offset ^= rel (test_ms_ptr) /* header doesn't agree */ then go to FIN; /* give up */ backward_offset = /* get offset to previous message */ fixed (tr_ptr -> ms_block_trailer.b_offset, 18); if backward_offset ^= 0 then call check_offset (backward_offset); /* previous offset off end of message */ else if mseg_hdr.first_ms_offset ^= rel (test_ms_ptr) /* header doesn't agree */ then go to FIN; if ms_size = "0"b /* check for zeroing out */ | ms_id = "0"b | sender_id = zeroes then go to FIN; if ^aim_check_$greater_or_equal (mseg_access_class, access_class) then go to FIN; if ^aim_check_$greater_or_equal (access_class, sender_authorization) then go to FIN; htx = fixed (substr (ms_id, 64, 9)); /* get hash table index of message */ block_offset = fixed (tr_ptr -> ms_block_trailer.back_in_bucket); if block_offset ^= 0 /* not end of thread */ then call check_offset (block_offset); /* check the hash bucket offset */ if (forward) /* forward salvage */ then do; if previous_offset ^= 0 /* there was a previous message */ then if backward_offset ^= previous_offset /* this message doesn't point to it */ then go to FIN; /* give up */ next_ms_ptr = ptr (test_ms_ptr, forward_offset); if substr (prev_ms_id, 19, 54) >= substr (ms_id, 19, 54) then do; /* should be monotonically increasing */ ms_id = ""b; /* make ms_id look bad for backward salvage too!! */ go to FIN; end; end; else /* backward salvage */ do; if previous_offset ^= 0 /* there was a previous message */ then if forward_offset ^= previous_offset /* this message doesn't point to it */ then go to FIN; /* give up */ next_ms_ptr = ptr (test_ms_ptr, backward_offset); if substr (prev_ms_id, 19, 54) <= substr (ms_id, 19, 54) then go to FIN; /* should be monotonically decreasing */ end; previous_offset = ms_offset; /* remember for next message check */ prev_ms_id = ms_id; message_words = /* calculate number of words in message */ divide (fixed (tr_ptr -> ms_block_trailer.ms_size, 18)+35, 36, 18, 0); if message_words <= 0 /* bad word count */ then go to FIN; /* give up */ if message_words > max_message_size then go to FIN; if message_words <= first_block_ms_words /* calculate blocks in message */ then message_blocks = 1; else message_blocks = divide (message_words-first_block_ms_words+block_ms_words-1, block_ms_words, 17, 0)+1; block_offset = ms_offset; test_block_ptr = test_ms_ptr; /* set pointer for testing rest of block */ /* */ /* check the block header */ CHECK_BLOCK: /* check to see if the block has been allocated */ bit_off = divide (block_offset, block_size, 18, 0)+1; /* calculate bit offset in alloc bits */ do i = 1 to tsaved_blocks; /* check against other blocks in this message */ if bit_offset (i) = bit_off /* block is used */ then go to FIN; /* give up */ end; if new_alloc_ptr -> bit_mask (bit_off) = "1"b /* block is used */ then go to FIN; if test_block_ptr -> ms_block_hdr.first_block ^= first_block /* bad first block flag */ then go to FIN; block_bit_count = /* get size of message portion in block */ fixed (test_block_ptr -> ms_block_hdr.block_count, 17); if block_bit_count <= 0 /* bad block bit count */ then go to FIN; /* give up */ if (first_block) /* first block of a message */ then do; if message_blocks ^= 1 /* another block follows */ then do; if block_bit_count ^= first_full_block_bit_count /* error in block bit count */ then go to FIN; end; else /* no blocks follow */ if block_bit_count > first_full_block_bit_count /* error in block bit count */ then go to FIN; end; else /* not first block in message */ do; if message_blocks ^= 1 /* another block follows */ then do; if block_bit_count ^= full_block_bit_count /* error in block bit count */ then go to FIN; /* give up */ end; else /* last block in message */ if block_bit_count > full_block_bit_count /* bad block bit count */ then go to FIN; /* give up */ end; next_block_offset = /* get the offset to the next message block */ fixed (test_block_ptr -> ms_block_hdr.f_offset, 18); bit_offset (tsaved_blocks + 1) = bit_off; /* remember location of block */ if message_blocks = 1 /* last block in message */ then do; if next_block_offset ^= 0 /* block pointer bad */ then go to FIN; else /* legitimate end of message */ do; saved_blocks = /* add in saved blocks */ saved_blocks + tsaved_blocks +1; do i = 1 to tsaved_blocks + 1; /* turn on the appropriate allocation bits */ new_alloc_ptr -> bit_mask (bit_offset (i)) = "1"b; end; back_in_bucket = new_hash_table.last_in_bucket (htx); /* set back ptr to previous last */ new_hash_table.last_in_bucket (htx) = rel (test_ms_ptr); /* make this one the last in bucket */ saved_messages = /* add in saved message */ saved_messages + 1; last_saved_ms_ptr = test_ms_ptr; /* set pointer to saved message */ go to CHECK_MESSAGE; end; end; else /* not end of message */ do; call check_offset (next_block_offset); /* check offset to next block */ first_block = "0"b; /* remember next block is not a first block */ message_blocks = message_blocks - 1; /* decrement blocks left to check */ tsaved_blocks = tsaved_blocks + 1; /* increment temporary saved block count */ block_offset = next_block_offset; /* reset for testing next block */ test_block_ptr = /* make a pointer to the next block */ ptr (test_block_ptr, next_block_offset); go to CHECK_BLOCK; end; end; /* of BEGIN block */ /* */ FIN: a_saved_messages = saved_messages; /* return appropriate values */ a_saved_blocks = saved_blocks; a_last_saved_ms_ptr = last_saved_ms_ptr; return; check_offset: proc (a_relp); /* procedure to check validity of an offset */ dcl (a_relp, relp) fixed bin (18); relp = a_relp; if relp + block_size > seg_size then go to FIN; /* offset beyond max length of segment */ if mod (relp, block_size) ^= 0 then go to FIN; /* not offset of a block */ relp = divide (relp, block_size, 18, 0) +1; /* convert block offset to block number */ if relp <= hdr_alloc_len then go to FIN; /* offset within header blocks */ if relp > alloc_len then go to FIN; /* offset beyond last block */ end check_offset; end ms_salv_util_v3_;  ms_salv_util_v4_.pl1 05/09/85 1152.2r w 05/06/85 1619.0 131202 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ ms_salv_util_v4_: proc (a_forward, a_salv_ptr, a_new_alloc_ptr, a_new_ht_ptr, a_block_size, a_seg_size, a_alloc_len, a_hdr_alloc_len, a_mseg_access_class, a_saved_messages, a_saved_blocks, a_last_saved_ms_ptr); /* Modified for version 3 message segments by J. Stern, 10/30/74 */ /* Modified by J. Stern, 11/14/75 */ /* Modified 3/77 by Charlie Davis for the installation of version 4 message segments */ /* Modified 4/82 by E. N. Kittlitz to detect discrepancy 'twixt ms_size and total block_count */ /* Modified 1984-10-19 BIM to remove bogus access class check that deleted messages sent down. */ dcl (a_saved_blocks, /* number of saved message blocks (argument) */ a_saved_messages, /* number of saved messages (argument) */ block_bit_count, /* bit count of message portion in block */ block_hdr_size, /* words in header */ block_trailer_size, /* words in trailer */ first_full_block_bit_count, /* bits allocated to first block message portion */ full_block_bit_count, /* bits allocated to message portion */ i, /* do loop index */ htx, /* hash table index */ max_message_blocks, /* maximum blocks in a message */ message_blocks, /* number of unchecked blocks in message */ saved_blocks init (0), /* number of saved message blocks (internal) */ saved_messages init (0), /* number of saved messages (internal) */ tsaved_blocks, /* blocks saved in message */ zero_words (8) init (0, 0, 0, 0, 0, 0, 0, 0) ) fixed bin; dcl (a_alloc_len, /* length of allocation bit string */ a_hdr_alloc_len, /* the part of alloc_len devoted to the header */ a_block_size, /* block size */ a_seg_size, /* max length of message seg */ alloc_len, /* length of allocation bit string */ hdr_alloc_len, backward_offset, /* offset to backward threaded message */ bit_off, /* offset of allocation bit for block */ block_ms_words, /* allocated size for message portion */ block_offset, /* offset to message block */ block_size, /* size of message block in words */ first_block_ms_words, /* allocated size for first block message portion */ forward_offset, /* offset to forward threaded message */ max_message_size, /* maximum words in a message */ message_words, /* word count of message */ ms_offset, /* offset to first block of message */ mseg_data_v4_$block_size ext, /* default block size */ mseg_data_v4_$max_message_size ext, next_block_offset, /* offset to next message block in message */ seg_size, previous_offset init (0), /* offset to previous message */ tr_offset) /* offset from beginning of block to trailer */ fixed bin (18); dcl (a_forward, /* ON if salvage is forward (argument) */ first_block, /* ON if block is first block in message */ forward) /* ON if salvage is forward (internal) */ bit (1) aligned; dcl (a_last_saved_ms_ptr, /* pointer to last saved message (argument) */ a_new_alloc_ptr, /* pointer to new allocation bits(argument) */ a_new_ht_ptr, /* pointer to new hash table (argument) */ a_salv_ptr, /* pointer to where to begin salvaging */ last_saved_ms_ptr init (null), /* pointer to last saved message(internal) */ new_alloc_ptr, /* pointer to new allocation bits(argument) */ new_ht_ptr, /* pointer to new hash table (internal) */ next_ms_ptr, /* pointer to next message */ test_block_ptr, /* pointer to message block being tested */ test_ms_ptr) /* pointer to message being tested */ ptr; dcl ms_size fixed bin (24); /* used to check trailer.ms_size with hdr.block_count sum */ dcl prev_ms_id bit (72) aligned; /* previous message id */ dcl (a_mseg_access_class, mseg_access_class) bit (72) aligned; /* message segment access class */ dcl 1 new_hash_table aligned based (new_ht_ptr), /* new hash table */ 2 last_in_bucket (0:511) bit (18) unaligned; dcl (addr, addrel, divide, fixed, mod, null, ptr, rel, size, substr) builtin; dcl bit_mask (alloc_len) based (new_alloc_ptr) bit (1) unaligned; /* mask for setting allocation bits */ dcl zeroes char (32) aligned based (addr (zero_words (1))); %include mseg_hdr_v4; dcl mptr pointer; %include ms_block_hdr_v4; %include ms_block_trailer_v4; dcl aim_check_$greater_or_equal ext entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); /* */ mptr = ptr (a_salv_ptr, 0); /* make pointer to message segment */ max_message_size = mseg_data_v4_$max_message_size; block_size = a_block_size; max_message_blocks = divide (max_message_size, block_size, 18, 0); /* compute max blocks in message */ block_hdr_size = size (ms_block_hdr); block_trailer_size = size (ms_block_trailer); forward = a_forward; /* copy argument */ next_ms_ptr = a_salv_ptr; /* where to begin salvaging */ seg_size = a_seg_size; alloc_len = a_alloc_len; hdr_alloc_len = a_hdr_alloc_len; ms_offset = fixed (rel (next_ms_ptr), 18); /* offset of where to begin salvaging */ call check_offset (ms_offset); new_alloc_ptr = a_new_alloc_ptr; /* copy argument */ new_ht_ptr = a_new_ht_ptr; mseg_access_class = a_mseg_access_class; tr_offset = block_size - block_trailer_size; /* initialize trailer offset */ first_block_ms_words = /* intialize word count of full first block */ block_size - (block_hdr_size + block_trailer_size); first_full_block_bit_count = /* initialize bit count of full first block */ first_block_ms_words * 36; full_block_bit_count = /* initialize bit count of full block */ (block_size - block_hdr_size) * 36; block_ms_words = /* initialize word count of full block */ block_size - block_hdr_size; if forward then prev_ms_id = (72) "0"b; else prev_ms_id = (72) "1"b; /* */ begin; dcl bit_offset (max_message_blocks) fixed bin (18); /* array of offsets into alloc bits */ CHECK_MESSAGE: first_block = "1"b; /* remember this is a first block of a message */ tsaved_blocks = 0; /* initialize blocks saved in message */ test_ms_ptr = next_ms_ptr; /* set pointer to message to be tested */ ms_offset = fixed (rel (next_ms_ptr), 18); /* set offset of message to be tested */ tr_ptr = addrel (test_ms_ptr, tr_offset); /* make a pointer to the trailer */ if tr_ptr -> ms_block_trailer.tr_pattern ^= trailer_pattern /* no trailer pattern */ then call FIN; forward_offset = /* get offset to next message */ fixed (tr_ptr -> ms_block_trailer.f_offset, 18); if forward_offset ^= 0 then call check_offset (forward_offset); /* forward offset off end of segment */ else if mptr -> mseg_hdr_v4.last_ms_offset ^= rel (test_ms_ptr) /* header doesn't agree */ then call FIN; /* give up */ backward_offset = /* get offset to previous message */ fixed (tr_ptr -> ms_block_trailer.b_offset, 18); if backward_offset ^= 0 then call check_offset (backward_offset); /* previous offset off end of message */ else if mptr -> mseg_hdr_v4.first_ms_offset ^= rel (test_ms_ptr) /* header doesn't agree */ then call FIN; if ms_block_trailer.ms_size = "0"b /* check for zeroing out */ | ms_block_trailer.ms_id = "0"b | ms_block_trailer.sender_id = zeroes then call FIN; if ^aim_check_$greater_or_equal (mseg_access_class, ms_block_trailer.access_class) then call FIN; htx = fixed (substr (ms_block_trailer.ms_id, 64, 9)); /* get hash table index of message */ block_offset = fixed (tr_ptr -> ms_block_trailer.back_in_bucket); if block_offset ^= 0 /* not end of thread */ then call check_offset (block_offset); /* check the hash bucket offset */ if (forward) /* forward salvage */ then do; if previous_offset ^= 0 /* there was a previous message */ then if backward_offset ^= previous_offset /* this message doesn't point to it */ then call FIN; /* give up */ next_ms_ptr = ptr (test_ms_ptr, forward_offset); if substr (prev_ms_id, 19, 54) >= substr (ms_block_trailer.ms_id, 19, 54) then do; /* should be monotonically increasing */ ms_block_trailer.ms_id = ""b; /* make ms_id look bad for backward salvage too!! */ call FIN; end; end; else /* backward salvage */ do; if previous_offset ^= 0 /* there was a previous message */ then if forward_offset ^= previous_offset /* this message doesn't point to it */ then call FIN; /* give up */ next_ms_ptr = ptr (test_ms_ptr, backward_offset); if substr (prev_ms_id, 19, 54) <= substr (ms_block_trailer.ms_id, 19, 54) then call FIN; /* should be monotonically decreasing */ end; previous_offset = ms_offset; /* remember for next message check */ prev_ms_id = ms_block_trailer.ms_id; ms_size = fixed (tr_ptr -> ms_block_trailer.ms_size, 24); message_words = /* calculate number of words in message */ divide (ms_size + 35, 36, 18, 0); if message_words <= 0 /* bad word count */ then call FIN; /* give up */ if message_words > max_message_size then call FIN; if message_words <= first_block_ms_words /* calculate blocks in message */ then message_blocks = 1; else message_blocks = divide (message_words-first_block_ms_words+block_ms_words-1, block_ms_words, 17, 0)+1; block_offset = ms_offset; test_block_ptr = test_ms_ptr; /* set pointer for testing rest of block */ /* */ /* check the block header */ CHECK_BLOCK: /* check to see if the block has been allocated */ bit_off = divide (block_offset, block_size, 18, 0)+1; /* calculate bit offset in alloc bits */ do i = 1 to tsaved_blocks; /* check against other blocks in this message */ if bit_offset (i) = bit_off /* block is used */ then call FIN; /* give up */ end; if new_alloc_ptr -> bit_mask (bit_off) = "1"b /* block is used */ then call FIN; if test_block_ptr -> ms_block_hdr.first_block ^= first_block /* bad first block flag */ then call FIN; block_bit_count = /* get size of message portion in block */ fixed (test_block_ptr -> ms_block_hdr.block_count, 17); if block_bit_count <= 0 /* bad block bit count */ then call FIN; /* give up */ ms_size = ms_size - block_bit_count; /* decrement total size of message */ if ms_size < 0 then call FIN; /* disagreement between trailer and total of blocks */ if (first_block) /* first block of a message */ then do; if message_blocks ^= 1 /* another block follows */ then do; if block_bit_count ^= first_full_block_bit_count /* error in block bit count */ then call FIN; end; else /* no blocks follow */ if block_bit_count > first_full_block_bit_count /* error in block bit count */ then call FIN; end; else /* not first block in message */ do; if message_blocks ^= 1 /* another block follows */ then do; if block_bit_count ^= full_block_bit_count /* error in block bit count */ then call FIN; /* give up */ end; else /* last block in message */ if block_bit_count > full_block_bit_count /* bad block bit count */ then call FIN; /* give up */ end; next_block_offset = /* get the offset to the next message block */ fixed (test_block_ptr -> ms_block_hdr.f_offset, 18); bit_offset (tsaved_blocks + 1) = bit_off; /* remember location of block */ if message_blocks = 1 /* last block in message */ then do; if next_block_offset ^= 0 /* block pointer bad */ then call FIN; else if ms_size ^= 0 /* disagreement between trailer.ms_size and sum of blocks */ then call FIN; else /* legitimate end of message */ do; saved_blocks = /* add in saved blocks */ saved_blocks + tsaved_blocks +1; do i = 1 to tsaved_blocks + 1; /* turn on the appropriate allocation bits */ new_alloc_ptr -> bit_mask (bit_offset (i)) = "1"b; end; back_in_bucket = new_hash_table.last_in_bucket (htx); /* set back ptr to previous last */ new_hash_table.last_in_bucket (htx) = rel (test_ms_ptr); /* make this one the last in bucket */ saved_messages = /* add in saved message */ saved_messages + 1; last_saved_ms_ptr = test_ms_ptr; /* set pointer to saved message */ go to CHECK_MESSAGE; end; end; else /* not end of message */ do; call check_offset (next_block_offset); /* check offset to next block */ first_block = "0"b; /* remember next block is not a first block */ message_blocks = message_blocks - 1; /* decrement blocks left to check */ tsaved_blocks = tsaved_blocks + 1; /* increment temporary saved block count */ block_offset = next_block_offset; /* reset for testing next block */ test_block_ptr = /* make a pointer to the next block */ ptr (test_block_ptr, next_block_offset); go to CHECK_BLOCK; end; end; /* of BEGIN block */ /* */ FIN: procedure; go to GIVE_UP_AND_RETURN; end FIN; GIVE_UP_AND_RETURN: a_saved_messages = saved_messages; /* return appropriate values */ a_saved_blocks = saved_blocks; a_last_saved_ms_ptr = last_saved_ms_ptr; return; check_offset: proc (a_relp); /* procedure to check validity of an offset */ dcl (a_relp, relp) fixed bin (18); relp = a_relp; if relp + block_size > seg_size then call FIN; /* offset beyond max length of segment */ if mod (relp, block_size) ^= 0 then call FIN; /* not offset of a block */ relp = divide (relp, block_size, 18, 0) +1; /* convert block offset to block number */ if relp <= hdr_alloc_len then call FIN; /* offset within header blocks */ if relp > alloc_len then call FIN; /* offset beyond last block */ end check_offset; end ms_salv_util_v4_;  ms_salvager_v2_.pl1 05/10/85 0856.7r w 05/06/85 1619.0 116442 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ %; ms_salvager_v2_: proc (a_mptr, a_saved_messages, a_code); /* Adapted from original version 2 ms_salvager_ by J. Stern, 11/4/74 */ dcl establish_cleanup_proc_ entry (entry); dcl ( a_saved_messages, /* number of saved messages (argument) */ block_bits, /* number of bits in a message block */ dirl, /* length of dir portion of message seg pname */ i, /* do loop index */ mseg_data_v2_$block_trailer_data ext, /* word count of trailer size */ max_hdr_ms_len ext, /* maximum length of header message */ mseg_data_v2_$version_number ext, /* current version of message segment primitives */ saved_blocks init (0), /* number of saved message blocks */ saved_messages init (0), /* number of saved messages (internal) */ status_words (0: 9), /* storage for status information */ tsaved_blocks, /* number of saved blocks per pass */ tsaved_messages) /* number of saved messages per pass */ fixed bin; dcl (alloc_len, /* length of allocation bit string */ block_offset, /* offset to a message block */ block_size, /* size of message block */ hdr_alloc_len, /* number of allocation bits used for header */ mseg_data_v2_$block_size ext, nrec, /* number of records used by message segment */ seg_size, /* maximum size of a segment */ temp, /* calculation variable */ trailer_offset) fixed bin (18); dcl ( a_code, /* error code (argument) */ code /* error code (internal) */ ) fixed bin (35); dcl dir char (168) aligned; /* directory portion of message segment pathname */ dcl ent char (32) aligned; /* entry portion of message segment pathname */ dcl (forward init ("1"b), /* ON if salvage is forward */ set_block_size init ("0"b), /* ON if block size in hdr to be set */ total_success init ("0"b)) /* ON if salvage pass is totally successful */ bit (1) aligned; dcl mseg_data_v2_$mseg_b36 ext bit (36) aligned; /* header recognition pattern */ dcl (addr, addrel, bit, divide, fixed, mod, null, ptr, rel, substr) builtin; dcl (a_mptr, /* pointer to message segment (argument) */ block_ptr, /* pointer to a message block */ end_ptr, /* pointer to last message for salvage pass */ eptr, /* pointer to status information */ last_backward_ptr init (null), /* pointer to last saved message in backward salvage */ last_forward_ptr init (null), /* pointer to last saved message in forward salvage */ last_saved_ms_ptr, /* pointer to last message saved in a pass */ new_alloc_ptr, /* pointer to new allocation bit string */ old_first_ptr, /* pointer to old first message */ old_last_ptr, /* pointer to old last message */ salv_ptr) /* pointer to beginning point for salvage */ ptr; dcl block_mask bit (block_bits) aligned based; /* mask for zeroing out unused message blocks */ dcl hdr_ms_mask bit (36*max_hdr_ms_len) aligned based; /* for zeroing out header message */ dcl 1 status_dope based (eptr) aligned, /* mask for getting nrec from status info */ 2 pad (7) fixed bin aligned, 2 curlen bit (12) unaligned; dcl error_table_$bad_segment ext fixed bin (35); dcl error_table_$no_message ext fixed bin (35); /* */ % include mseg_hdr_v2; % include ms_block_trailer_v2; dcl hcs_$fs_get_path_name ext entry (ptr, char (*) aligned, fixed bin, char (*) aligned, fixed bin (35)); dcl hcs_$get_max_length_seg entry (ptr, fixed bin (18), fixed bin (35)); dcl hcs_$status_long ext entry (char (*) aligned, char (*) aligned, fixed bin (1), ptr, ptr, fixed bin (35)); dcl hcs_$truncate_seg ext entry (ptr, fixed bin, fixed bin (35)); dcl ptr_is_good_v2_$ms_salvager_entry ext entry (ptr, fixed bin (18)) returns (bit (1) aligned); dcl ms_salv_util_v2_ ext entry (bit (1) aligned, ptr, ptr, fixed bin (18), fixed bin (18), fixed bin, fixed bin, ptr, fixed bin (35)); /* */ eptr = addr (status_words); mptr = a_mptr; /* copy argument */ call establish_cleanup_proc_ (cleanup_handler); cleanup_handler: proc; call hcs_$truncate_seg (mptr, 1, code); /* throw everything away */ go to FIN; end; call hcs_$get_max_length_seg (mptr, seg_size, code); if code ^= 0 then go to FIN; block_size = fixed (mseg_hdr_v2.block_size, 18); /* fetch block size */ if block_size <= 0 then do; SET_BLOCK_SIZE: block_size = fixed (mseg_data_v2_$block_size, 18); /* take default and hope it's right */ set_block_size = "1"b; /* remember to set later */ end; else /* block size not <= 0 */ if mod (seg_size, block_size) ^= 0 /* bad block size */ then go to SET_BLOCK_SIZE; alloc_len = divide (seg_size, block_size, 18, 0); /* compute length of allocation bits */ temp = divide ((fixed (rel (addr (mptr -> mseg_hdr_v2.hdr_ms_end)), 18)+1)*36 + alloc_len+35, 36, 18, 0); hdr_alloc_len = divide (temp+block_size-1, block_size, 18, 0); /* compute alloc bits used by header */ max_hdr_ms_len = temp - fixed (rel (addr (mptr -> mseg_hdr_v2.hdr_ms)), 17); trailer_offset = fixed (block_size-mseg_data_v2_$block_trailer_data, 18); /* compute trailer offset */ call hcs_$fs_get_path_name (mptr, dir, dirl, ent, code); /* get dir and ent names of segment */ if code ^= 0 then go to FIN; call hcs_$status_long (dir, ent, 1, eptr, null, code); /* get number of records used by message segment */ if code ^= 0 then go to FIN; nrec = fixed (status_dope.curlen, 18); /* */ begin; dcl new_alloc_bits bit (alloc_len) init ("0"b) aligned; /* new allocation bit string */ new_alloc_ptr = addr (new_alloc_bits); /* set pointer to new bit string */ old_first_ptr, salv_ptr = /* set possible first message,salvage ptr */ ptr (mptr, fixed (mseg_hdr_v2.first_ms_offset, 18)); old_last_ptr, end_ptr = /* set possible last message,end salvage ptr */ ptr (mptr, fixed (mseg_hdr_v2.last_ms_offset, 18)); do i = 1 to hdr_alloc_len; /* turn on header allocation bits */ substr (new_alloc_bits, i, 1) = "1"b; end; /* salvage */ SALVAGE_LOOP: if (ptr_is_good_v2_$ms_salvager_entry (salv_ptr, block_size)) /* check validity of salvaging pointer */ then if (fixed (rel (salv_ptr), 18))+block_size <= nrec*1024 then do; /* pointer is valid, go */ tsaved_messages = 0; /* initialize number of saved messages per pass */ last_saved_ms_ptr = null; /* initialize pointer to last saver message */ call ms_salv_util_v2_ (forward, salv_ptr, new_alloc_ptr, nrec, alloc_len, tsaved_messages, tsaved_blocks, last_saved_ms_ptr, code); if code ^= 0 then go to FIN; saved_messages = /* add in number of saved messages */ saved_messages + tsaved_messages; saved_blocks = /* add in number of saved blocks */ saved_blocks + tsaved_blocks; if last_saved_ms_ptr = end_ptr /* total success? */ then total_success = "1"b; /* set a flag to remember */ if tsaved_messages ^= 0 /* partial success? */ then do; /* yes */ if (forward) /* forward salvage? */ then last_forward_ptr = /* yes, save pointer to last good message */ last_saved_ms_ptr; else /* backward salvage */ last_backward_ptr = /* save pointer to last good message */ last_saved_ms_ptr; end; if (total_success) /* if successful, don't need another pass */ then go to SET_HEADER_DATA; end; if (forward) /* first pass at salvaging? */ then do; /* yes, prepare for next pass */ forward = "0"b; /* set direction of salvage */ salv_ptr = old_last_ptr; /* set salvaging pointer */ end_ptr = old_first_ptr; /* set hopeful end of salvage ptr */ go to SALVAGE_LOOP; end; /* */ /* join message fragments */ if saved_messages ^= 0 /* any success in salvaging? */ then do; /* yes */ if set_block_size /* need to set block size in header */ then mseg_hdr_v2.block_size = block_size; /* do it */ if last_forward_ptr ^= null /* forward salvage partly successful */ then do; /* yes */ if last_backward_ptr ^= null /* backward salvage partly successful? */ then do; /* yes */ addrel (last_forward_ptr, trailer_offset) -> ms_block_trailer_v2.f_offset = bit (fixed (rel (last_backward_ptr), 18), 18); addrel (last_backward_ptr, trailer_offset) -> ms_block_trailer_v2.b_offset = bit (fixed (rel (last_forward_ptr), 18), 18); end; else /* backward salvage unsuccessful */ do; mseg_hdr_v2.last_ms_offset = /* reset last message offset in header */ bit (fixed (rel (last_forward_ptr), 18), 18); addrel (last_forward_ptr, trailer_offset) -> ms_block_trailer_v2.f_offset = "0"b; /* zero out next offset of new last message */ end; end; else /* forward salvage no good */ do; /* backward salvage must have been */ mseg_hdr_v2.first_ms_offset = /* reset first message offset */ bit (fixed (rel (last_backward_ptr), 18), 18); addrel (last_backward_ptr, trailer_offset) -> ms_block_trailer_v2.b_offset = "0"b; /* zero prev message offset of new 1st message */ end; /* reset other header data */ SET_HEADER_DATA: if (total_success) /* was salvaging totally successful? */ then do; /* yes */ if (forward) /* direction was forward */ then mseg_hdr_v2.last_ms_offset = /* reset last message offset */ bit (fixed (rel (last_forward_ptr), 18), 18); else /* direction was backward */ mseg_hdr_v2.first_ms_offset = /* reset first message offset */ bit (fixed (rel (last_backward_ptr), 18), 18); end; block_bits = fixed (block_size*36, 17); /* set length of block mask */ do i = 1 to alloc_len; /* zero out unused blocks */ if substr (new_alloc_bits, i, 1) = "0"b /* block is unused */ then do; block_offset = block_size * fixed (i-1, 18); if divide (block_offset+block_size, 1000, 18, 0) > nrec then go to FIN; /* block offset off end of records used, only 0s left */ block_ptr = ptr (salv_ptr, block_offset); block_ptr -> block_mask = "0"b; end; end; end; if mseg_hdr_v2.switches.ms_in_hdr /* there is a message in the header */ then do; if mseg_hdr_v2.hdr_ms_len <= 0 | /* check for a reasonable length */ mseg_hdr_v2.hdr_ms_len > max_hdr_ms_len then do; /* unreasonable length */ mseg_hdr_v2.switches.ms_in_hdr = "0"b; /* delete the message */ addr (mseg_hdr_v2.hdr_ms) -> hdr_ms_mask = "0"b; end; end; if saved_messages ^= 0 /* something was saved */ | mseg_hdr_v2.switches.ms_in_hdr then do; /* reset the header data */ mseg_hdr_v2.space_left = /* reset space left */ alloc_len- (hdr_alloc_len+saved_blocks); mseg_hdr_v2.alloc_bits = new_alloc_bits; /* reset allocation bit string */ mseg_hdr_v2.number_of_messages = saved_messages; /* set message count */ mseg_hdr_v2.alloc_len = alloc_len; /* set allocation bits length */ mseg_hdr_v2.mseg_pattern = mseg_data_v2_$mseg_b36; /* set header pattern */ mseg_hdr_v2.version_number = mseg_data_v2_$version_number; /* set version number */ end; if saved_messages = 0 /* no messages were saved */ then do; if mseg_hdr_v2.switches.ms_in_hdr /* a header message was saved */ then mseg_hdr_v2.first_ms_offset, /* zero out forward and backward offsets */ mseg_hdr_v2.last_ms_offset = "0"b; else /* no success salvaging */ do; call hcs_$truncate_seg (mptr, 1, code); /* throw everything away */ end; end; end; /* of BEGIN block */ FIN: if saved_messages ^= 0 | mseg_hdr_v2.switches.ms_in_hdr /* something was saved */ then do; mseg_hdr_v2.switches.aip = "0"b; /* turn of aip bit */ mseg_hdr_v2.switches.os = "1"b; /* message segment was salvaged */ end; a_saved_messages = saved_messages; /* return number of saved messages */ a_code = code; /* return code */ return; end ms_salvager_v2_;  ms_salvager_v3_.pl1 05/10/85 0856.7r w 05/06/85 1619.0 101034 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ ms_salvager_v3_: proc (a_mptr, a_code); /* Modified for version 3 message segments by J. Stern, 10/30/74 */ /* Modified to use mseg_error_ by J. Stern, 11/12/75 */ /* Modified 3/77 by Charlie Davis for the installation of version 4 message segments */ dcl ( mseg_dir, /* mseg directory name */ comp1) /* 1st component of directory name */ char (168) aligned; dcl ( mseg_name, /* mseg entryname */ comp2) /* 2nd component of directory name */ char (32) aligned; dcl ( i, /* do loop index */ dir_len, /* length of mseg directory */ saved_blocks init (0), /* number of saved message blocks */ saved_messages init (0), /* number of saved messages (internal) */ original_messages, /* number of messages before salvaging */ tsaved_blocks, /* number of saved blocks per pass */ tsaved_messages) /* number of saved messages per pass */ fixed bin; dcl (alloc_len, /* length of allocation bit string */ block_offset, /* offset to a message block */ block_size, /* size of message block */ hdr_alloc_len, /* number of allocation bits used for header */ mseg_data_v3_$block_size ext, seg_size, /* maximum size of a segment */ hdr_size, /* number of words in header before alloc_bits */ trailer_offset) fixed bin (18); dcl ( a_code, /* error code (argument) */ code, /* error code, (internal) */ error_table_$fatal_error ext ) fixed bin (35); dcl reason char (40); /* reason for salvager failure */ dcl forward bit (1) aligned; /* ON if salvage is forward */ dcl (addr, addrel, bit, divide, fixed, null, ptr, rel, size, substr) builtin; dcl (a_mptr, /* pointer to message segment (argument) */ end_ptr, /* pointer to last message for salvage pass */ last_backward_ptr init (null), /* pointer to last saved message in backward salvage */ last_forward_ptr init (null), /* pointer to last saved message in forward salvage */ last_saved_ms_ptr, /* pointer to last message saved in a pass */ salv_ptr) /* pointer to beginning point for salvage */ ptr; dcl mseg_access_class bit (72) aligned; /* message segment access class */ dcl hdr_ms_mask bit (36*max_hdr_ms_len) aligned based; /* for zeroing out header message */ dcl ring_brackets (3) fixed bin(3) init(1,4,4); /* for setting ring brackets of copy */ dcl 1 new_hash_table aligned, /* hash table regenerated by salvage */ 2 last_in_bucket (0:511) bit (18) unaligned init ((512) (18) "0"b); /* */ %include mseg_hdr_v3; %include ms_block_trailer_v3; dcl admin_gate_$guaranteed_eligibility_on ext entry; dcl expand_path_ ext entry (ptr, fixed bin, ptr, ptr, fixed bin (35)); dcl copy_seg_$no_message ext entry (char (*)aligned, char (*)aligned, char (*)aligned, char (*)aligned, char (*)aligned, bit (1)aligned, fixed bin (35)); dcl hcs_$get_max_length_seg entry (ptr, fixed bin (18), fixed bin (35)); dcl hcs_$set_ring_brackets ext entry (char (*)aligned, char (*)aligned, (3) fixed bin (3), fixed bin (35)); dcl hcs_$truncate_seg ext entry (ptr, fixed bin (18), fixed bin (35)); dcl read_allowed_ ext entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl hcs_$fs_get_path_name ext entry (ptr, char (*)aligned, fixed bin, char (*)aligned, fixed bin (35)); dcl hcs_$get_access_class_seg ext entry (ptr, bit (72) aligned, fixed bin (35)); dcl ms_salv_util_v3_ ext entry (bit (1) aligned, ptr, ptr, ptr, fixed bin (18), fixed bin (18), fixed bin (18), fixed bin (18), bit (72) aligned, fixed bin, fixed bin, ptr); dcl mseg_error_v3_ entry options (variable); dcl set_lock_$lock ext entry (bit (36)aligned, fixed bin, fixed bin (35)); /* */ mptr = a_mptr; /* copy argument */ call admin_gate_$guaranteed_eligibility_on (); /* lock the message segment in case */ call set_lock_$lock (mseg_hdr.lock, 20, code); /* it is not already locked */ call hcs_$get_access_class_seg (mptr, mseg_access_class, code); if code ^= 0 then do; reason = "Cannot get access class."; go to GRIPE; end; call hcs_$get_max_length_seg (mptr, seg_size, code); if code ^= 0 then do; reason = "Cannot get max length."; go to GRIPE; end; mseg_hdr.switches.sip = "1"b; /* turn on "salvage in progress" flag */ block_size = fixed (mseg_hdr.block_size, 18); /* fetch block size */ if block_size <= 0 | block_size > seg_size then block_size = fixed (mseg_data_v3_$block_size, 18); /* take default and hope it's right */ alloc_len = divide (seg_size, block_size, 18, 0); /* compute length of allocation bits */ hdr_size = divide ((fixed (rel (addr (mptr -> mseg_hdr.alloc_bits)), 18))*36 + alloc_len+35, 36, 18, 0); if hdr_size > seg_size then do; /* forget it */ code = error_table_$fatal_error; go to FIN; end; hdr_alloc_len = divide (hdr_size+block_size-1, block_size, 18, 0); /* compute alloc bits used by header */ trailer_offset = fixed (block_size-size (ms_block_trailer), 18); /* compute trailer offset */ original_messages = mseg_hdr.number_of_messages; /* */ begin; dcl new_alloc_bits bit (alloc_len) init (""b) aligned; /* new allocation bit string */ do i = 1 to hdr_alloc_len; /* turn on header allocation bits */ substr (new_alloc_bits, i, 1) = "1"b; end; if mseg_hdr.first_ms_offset ^= ""b /* non-zero first message offset */ then do; /* set up for forward salvage */ salv_ptr = ptr (mptr, fixed (mseg_hdr.first_ms_offset, 18)); end_ptr = ptr (mptr, fixed (mseg_hdr.last_ms_offset, 18)); forward = "1"b; /* first attempt forward salvage */ end; else go to BACKWARD; /* try backward salvage */ /* salvage */ SALVAGE_LOOP: tsaved_messages = 0; /* initialize number of saved messages per pass */ last_saved_ms_ptr = null; /* initialize pointer to last saved message */ call ms_salv_util_v3_ (forward, salv_ptr, addr (new_alloc_bits), addr (new_hash_table), block_size, seg_size, alloc_len, hdr_alloc_len, mseg_access_class, tsaved_messages, tsaved_blocks, last_saved_ms_ptr); saved_messages = /* add in number of saved messages */ saved_messages + tsaved_messages; saved_blocks = /* add in number of saved blocks */ saved_blocks + tsaved_blocks; if last_saved_ms_ptr = end_ptr /* total success? */ then go to REST_OF_HEADER; if tsaved_messages ^= 0 /* partial success? */ then do; /* yes */ if (forward) /* forward salvage? */ then last_forward_ptr = /* yes, save pointer to last good message */ last_saved_ms_ptr; else /* backward salvage */ last_backward_ptr = /* save pointer to last good message */ last_saved_ms_ptr; end; if (forward) /* first pass at salvaging? */ then BACKWARD: if mseg_hdr.last_ms_offset ^= ""b /* non-zero last message offset */ then do; /* yes, prepare for next pass */ forward = "0"b; /* set direction of salvage */ salv_ptr = ptr (mptr, fixed (mseg_hdr.last_ms_offset, 18)); /* set salvaging pointer */ end_ptr = ptr (mptr, fixed (mseg_hdr.first_ms_offset, 18)); /* set hopeful end of salvage ptr */ go to SALVAGE_LOOP; end; /* */ /* join message fragments */ if saved_messages ^= 0 /* any success in salvaging? */ then do; /* yes */ if last_forward_ptr ^= null /* forward salvage partly successful */ then do; /* yes */ if last_backward_ptr ^= null /* backward salvage partly successful? */ then do; /* yes */ addrel (last_forward_ptr, trailer_offset) -> ms_block_trailer.f_offset = bit (fixed (rel (last_backward_ptr), 18), 18); addrel (last_backward_ptr, trailer_offset) -> ms_block_trailer.b_offset = bit (fixed (rel (last_forward_ptr), 18), 18); end; else /* backward salvage unsuccessful */ do; mseg_hdr.last_ms_offset = /* reset last message offset in header */ bit (fixed (rel (last_forward_ptr), 18), 18); addrel (last_forward_ptr, trailer_offset) -> ms_block_trailer.f_offset = "0"b; /* zero out next offset of new last message */ end; end; else /* forward salvage no good */ do; /* backward salvage must have been */ mseg_hdr.first_ms_offset = /* reset first message offset */ bit (fixed (rel (last_backward_ptr), 18), 18); addrel (last_backward_ptr, trailer_offset) -> ms_block_trailer.b_offset = "0"b; /* zero prev message offset of new 1st message */ end; end; else /* no messages saved */ mseg_hdr.first_ms_offset, mseg_hdr.last_ms_offset = (18) "0"b; /* zero first and last offsets */ REST_OF_HEADER: i = alloc_len - index (reverse (new_alloc_bits), "1"b) +1; /* get last used block index */ block_offset = i * block_size; /* get offset of end of last block */ call hcs_$truncate_seg (mptr, block_offset, code); /* truncate to last used block */ mseg_hdr.block_size = block_size; /* reset block size */ mseg_hdr.space_left = /* reset space left */ alloc_len - hdr_alloc_len - saved_blocks; mseg_hdr.alloc_bits = new_alloc_bits; /* reset allocation bit string */ mseg_hdr.number_of_messages = saved_messages; /* set message count */ mseg_hdr.alloc_len = alloc_len; /* set allocation bits length */ mseg_hdr.mseg_pattern = header_pattern; /* set header pattern */ mseg_hdr.version_number = version_number; /* set version number */ mseg_hdr.hash_table = new_hash_table; /* copy new hash table */ if mseg_hdr.switches.ms_in_hdr /* header message exists */ then if ^read_allowed_ (mseg_access_class, mseg_hdr.hdr_ms_access_class) /* bad access class */ then do; /* wipe out header message */ mseg_hdr.switches.ms_in_hdr = "0"b; ZERO_HDR_MS: mseg_hdr.hdr_ms = ""b; mseg_hdr.hdr_ms_access_class = (72) "0"b; end; else; /* keep header message */ else go to ZERO_HDR_MS; /* just to be neat */ mseg_hdr.switches.mip = "0"b; /* turn off mip bit */ mseg_hdr.switches.os = "1"b; /* indicate salvage occurred */ mseg_hdr.switches.sip = "0"b; /* turn off salvage in progress bit */ end; /* of BEGIN block */ if original_messages > saved_messages then call mseg_error_v3_ (mptr, 0, "ms_salvager_v3_", "^d message(s) may be lost.", original_messages - saved_messages); FIN: a_code = code; /* return code */ return; GRIPE: call mseg_error_v3_ (mptr, code, "ms_salvager_v3_", reason); go to FIN; end ms_salvager_v3_;  ms_salvager_v4_.pl1 05/09/85 1152.2r w 05/06/85 1619.0 104004 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ ms_salvager_v4_: proc (a_mptr, a_code); /* Modified for version 3 message segments by J. Stern, 10/30/74 */ /* Modified to use mseg_error_ by J. Stern, 11/12/75 */ dcl ( mseg_dir, /* mseg directory name */ comp1) /* 1st component of directory name */ char (168); dcl ( mseg_name, /* mseg entryname */ comp2) /* 2nd component of directory name */ char (32); dcl ( i, /* do loop index */ dir_len, /* length of mseg directory */ saved_blocks init (0), /* number of saved message blocks */ saved_messages init (0), /* number of saved messages (internal) */ original_messages, /* number of messages before salvaging */ tsaved_blocks, /* number of saved blocks per pass */ tsaved_messages) /* number of saved messages per pass */ fixed bin; dcl (alloc_len, /* length of allocation bit string */ block_offset, /* offset to a message block */ block_size, /* size of message block */ hdr_alloc_len, /* number of allocation bits used for header */ mseg_data_v4_$block_size ext, seg_size, /* maximum size of a segment */ hdr_size, /* number of words in header before alloc_bits */ trailer_offset) fixed bin (18); dcl ( a_code, /* error code (argument) */ code, /* error code, (internal) */ error_table_$fatal_error ext ) fixed bin (35); dcl reason char (40); /* reason for salvager failure */ dcl forward bit (1) aligned; /* ON if salvage is forward */ dcl (addr, addrel, bit, divide, fixed, null, ptr, rel, size, substr) builtin; dcl (a_mptr, /* pointer to message segment (argument) */ end_ptr, /* pointer to last message for salvage pass */ last_backward_ptr init (null), /* pointer to last saved message in backward salvage */ last_forward_ptr init (null), /* pointer to last saved message in forward salvage */ last_saved_ms_ptr, /* pointer to last message saved in a pass */ salv_ptr) /* pointer to beginning point for salvage */ ptr; dcl mseg_access_class bit (72) aligned; /* message segment access class */ dcl hdr_ms_mask bit (36*max_hdr_ms_len) aligned based; /* for zeroing out header message */ dcl ring_brackets (3) fixed bin(3) init(1,4,4); /* for setting ring brackets of copy */ dcl 1 new_hash_table aligned, /* hash table regenerated by salvage */ 2 last_in_bucket (0:511) bit (18) unaligned init ((512) (18) "0"b); /* */ %include mseg_hdr_v4; declare version_number fixed bin init (4) int static options (constant); dcl header_pattern bit (36) aligned init ((18) "01"b); /* header identification pattern */ declare mptr pointer; %include ms_block_trailer_v4; dcl admin_gate_$guaranteed_eligibility_on ext entry; dcl expand_path_ ext entry (ptr, fixed bin, ptr, ptr, fixed bin (35)); dcl copy_seg_$no_message entry (char(*), char(*), char(*), char(*), char(*), bit(1) aligned, fixed bin(35)); dcl hcs_$get_max_length_seg entry (ptr, fixed bin (18), fixed bin (35)); dcl hcs_$set_ring_brackets ext entry (char (*), char (*), (3) fixed bin (3), fixed bin (35)); dcl hcs_$truncate_seg ext entry (ptr, fixed bin (18), fixed bin (35)); dcl read_allowed_ entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl hcs_$fs_get_path_name entry (ptr, char(*), fixed bin, char(*), fixed bin(35)); dcl hcs_$get_access_class_seg ext entry (ptr, bit (72) aligned, fixed bin (35)); dcl ms_salv_util_v4_ ext entry (bit (1) aligned, ptr, ptr, ptr, fixed bin (18), fixed bin (18), fixed bin (18), fixed bin (18), bit (72) aligned, fixed bin, fixed bin, ptr); dcl mseg_error_v4_ entry options (variable); dcl set_lock_$lock ext entry (bit (36)aligned, fixed bin, fixed bin (35)); /* */ mptr = a_mptr; /* copy argument */ call admin_gate_$guaranteed_eligibility_on (); /* lock the message segment in case */ call set_lock_$lock (mptr -> mseg_hdr_v4.lock, 20, code); /* it is not already locked */ call hcs_$get_access_class_seg (mptr, mseg_access_class, code); if code ^= 0 then do; reason = "Cannot get access class."; go to GRIPE; end; call hcs_$get_max_length_seg (mptr, seg_size, code); if code ^= 0 then do; reason = "Cannot get max length."; go to GRIPE; end; mptr -> mseg_hdr_v4.switches.sip = "1"b; /* turn on "salvage in progress" flag */ block_size = fixed (mptr -> mseg_hdr_v4.block_size, 18); /* fetch block size */ if block_size <= 0 | block_size > seg_size then block_size = fixed (mseg_data_v4_$block_size, 18); /* take default and hope it's right */ alloc_len = divide (seg_size, block_size, 18, 0); /* compute length of allocation bits */ hdr_size = divide ((fixed (rel (addr (mptr -> mseg_hdr_v4.alloc_bits)), 18))*36 + alloc_len+35, 36, 18, 0); if hdr_size > seg_size then do; /* forget it */ code = error_table_$fatal_error; go to FIN; end; hdr_alloc_len = divide (hdr_size+block_size-1, block_size, 18, 0); /* compute alloc bits used by header */ trailer_offset = fixed (block_size-size (ms_block_trailer), 18); /* compute trailer offset */ original_messages = mptr -> mseg_hdr_v4.number_of_messages; /* */ begin; dcl new_alloc_bits bit (alloc_len) init (""b) aligned; /* new allocation bit string */ do i = 1 to hdr_alloc_len; /* turn on header allocation bits */ substr (new_alloc_bits, i, 1) = "1"b; end; if mptr -> mseg_hdr_v4.first_ms_offset ^= ""b /* non-zero first message offset */ then do; /* set up for forward salvage */ salv_ptr = ptr (mptr, fixed (mptr -> mseg_hdr_v4.first_ms_offset, 18)); end_ptr = ptr (mptr, fixed (mptr -> mseg_hdr_v4.last_ms_offset, 18)); forward = "1"b; /* first attempt forward salvage */ end; else go to BACKWARD; /* try backward salvage */ /* salvage */ SALVAGE_LOOP: tsaved_messages = 0; /* initialize number of saved messages per pass */ last_saved_ms_ptr = null; /* initialize pointer to last saved message */ call ms_salv_util_v4_ (forward, salv_ptr, addr (new_alloc_bits), addr (new_hash_table), block_size, seg_size, alloc_len, hdr_alloc_len, mseg_access_class, tsaved_messages, tsaved_blocks, last_saved_ms_ptr); saved_messages = /* add in number of saved messages */ saved_messages + tsaved_messages; saved_blocks = /* add in number of saved blocks */ saved_blocks + tsaved_blocks; if last_saved_ms_ptr = end_ptr /* total success? */ then go to REST_OF_HEADER; if tsaved_messages ^= 0 /* partial success? */ then do; /* yes */ if (forward) /* forward salvage? */ then last_forward_ptr = /* yes, save pointer to last good message */ last_saved_ms_ptr; else /* backward salvage */ last_backward_ptr = /* save pointer to last good message */ last_saved_ms_ptr; end; if (forward) /* first pass at salvaging? */ then BACKWARD: if mptr -> mseg_hdr_v4.last_ms_offset ^= ""b /* non-zero last message offset */ then do; /* yes, prepare for next pass */ forward = "0"b; /* set direction of salvage */ salv_ptr = ptr (mptr, fixed (mptr -> mseg_hdr_v4.last_ms_offset, 18)); /* set salvaging pointer */ end_ptr = ptr (mptr, fixed (mptr -> mseg_hdr_v4.first_ms_offset, 18)); /* set hopeful end of salvage ptr */ go to SALVAGE_LOOP; end; /* */ /* join message fragments */ if saved_messages ^= 0 /* any success in salvaging? */ then do; /* yes */ if last_forward_ptr ^= null /* forward salvage partly successful */ then do; /* yes */ if last_backward_ptr ^= null /* backward salvage partly successful? */ then do; /* yes */ addrel (last_forward_ptr, trailer_offset) -> ms_block_trailer.f_offset = bit (fixed (rel (last_backward_ptr), 18), 18); addrel (last_backward_ptr, trailer_offset) -> ms_block_trailer.b_offset = bit (fixed (rel (last_forward_ptr), 18), 18); end; else /* backward salvage unsuccessful */ do; mptr -> mseg_hdr_v4.last_ms_offset = /* reset last message offset in header */ bit (fixed (rel (last_forward_ptr), 18), 18); addrel (last_forward_ptr, trailer_offset) -> ms_block_trailer.f_offset = "0"b; /* zero out next offset of new last message */ end; end; else /* forward salvage no good */ do; /* backward salvage must have been */ mptr -> mseg_hdr_v4.first_ms_offset = /* reset first message offset */ bit (fixed (rel (last_backward_ptr), 18), 18); addrel (last_backward_ptr, trailer_offset) -> ms_block_trailer.b_offset = "0"b; /* zero prev message offset of new 1st message */ end; end; else /* no messages saved */ mptr -> mseg_hdr_v4.first_ms_offset, mptr -> mseg_hdr_v4.last_ms_offset = (18) "0"b; /* zero first and last offsets */ REST_OF_HEADER: i = alloc_len - index (reverse (new_alloc_bits), "1"b) +1; /* get last used block index */ block_offset = i * block_size; /* get offset of end of last block */ call hcs_$truncate_seg (mptr, block_offset, code); /* truncate to last used block */ mptr -> mseg_hdr_v4.block_size = block_size; /* reset block size */ mptr -> mseg_hdr_v4.space_left = /* reset space left */ alloc_len - hdr_alloc_len - saved_blocks; mptr -> mseg_hdr_v4.alloc_bits = new_alloc_bits; /* reset allocation bit string */ mptr -> mseg_hdr_v4.number_of_messages = saved_messages; /* set message count */ mptr -> mseg_hdr_v4.alloc_len = alloc_len; /* set allocation bits length */ mptr -> mseg_hdr_v4.mseg_pattern = header_pattern; /* set header pattern */ mptr -> mseg_hdr_v4.version_number = version_number; /* set version number */ mptr -> mseg_hdr_v4.hash_table = new_hash_table; /* copy new hash table */ if mptr -> mseg_hdr_v4.switches.ms_in_hdr /* header message exists */ then if ^read_allowed_ (mseg_access_class, mptr -> mseg_hdr_v4.hdr_ms_access_class) /* bad access class */ then do; /* wipe out header message */ mptr -> mseg_hdr_v4.switches.ms_in_hdr = "0"b; ZERO_HDR_MS: mptr -> mseg_hdr_v4.hdr_ms = ""b; mptr -> mseg_hdr_v4.hdr_ms_access_class = (72) "0"b; end; else; /* keep header message */ else go to ZERO_HDR_MS; /* just to be neat */ mptr -> mseg_hdr_v4.switches.mip = "0"b; /* turn off mip bit */ mptr -> mseg_hdr_v4.switches.os = "1"b; /* indicate salvage occurred */ mptr -> mseg_hdr_v4.switches.sip = "0"b; /* turn off salvage in progress bit */ end; /* of BEGIN block */ if original_messages > saved_messages then call mseg_error_v4_ (mptr, 0, "ms_salvager_v4_", "^d message(s) may be lost.", original_messages - saved_messages); FIN: a_code = code; /* return code */ return; GRIPE: call mseg_error_v4_ (mptr, code, "ms_salvager_v4_", reason); go to FIN; end ms_salvager_v4_;  mseg_data_v2_.alm 05/10/85 0901.8r w 05/06/85 1619.0 7452 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** segdef max_message_size segdef block_size segdef version_number segdef block_hdr_data segdef block_trailer_data segdef mseg_b36 segdef mseg_tr36 max_message_size: dec 2048 block_size: dec 32 version_number: dec 2 block_hdr_data: dec 1 block_trailer_data: dec 13 mseg_b36: oct 252525252525 mseg_tr36: oct 777777777777 end  mseg_data_v3_.alm 05/10/85 0901.8r w 05/06/85 1619.0 10350 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1974 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " Modified for version 3 message segments by J. Stern, 10/18/74 " Modified to increase max_message_size essentially to " infinity by K. T. Pogran, 6/4/75 " Modified to temporarily limit max_message_size to " 2**18 bits (approximately) by Ken Pogran. " Modified 3/77 by Charlie Davis for the installation of version 4 message segments segdef max_message_size segdef block_size max_message_size: dec 7280 " A tad less than 2**18 bits block_size: dec 32 end  mseg_data_v4_.alm 05/09/85 1152.2r w 05/06/85 1619.0 10386 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1974 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " Modified for version 3 message segments by J. Stern, 10/18/74 " Modified to increase max_message_size essentially to " infinity by K. T. Pogran, 6/4/75 " Modified to temporarily limit max_message_size to " 2**18 bits (approximately) by Ken Pogran. " Remodified to increase max_message_size essentially to " infinity by Charlie Davis, 3/77 segdef max_message_size segdef block_size max_message_size: dec 261120 " Infinity, essentially block_size: dec 32 end  mseg_error_v3_.pl1 05/10/85 0856.7r w 05/06/85 1619.0 38709 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ mseg_error_v3_: proc (mptr, ecode, caller); /* This procedure formats error messages for the message segment facility and enters these error messages into the syserr log. An error message contains the following parts: 1. name of the calling procedure 2. message segment pathname 3. process group id 4. system error message 5. caller-supplied message */ /* Written by J. Stern, 11/11/75 */ /* Modified 3/77 by Charlie Davis for the installation of version 4 message segments */ dcl mptr ptr; /* message segment pointer */ dcl ecode fixed bin (35); /* error code (input!) */ dcl caller char (*); /* procedure name of caller */ dcl buffer char (512) aligned; /* buffer to construct error message */ dcl bi fixed bin; /* current length of buffer */ dcl dir char (168); /* directory name */ dcl dirlen fixed bin; /* length of dir */ dcl ent char (32); /* entry name */ dcl code fixed bin (35); /* error code */ dcl pgid char (32); /* process group id */ dcl short_mess char (8) aligned; /* short error message */ dcl long_mess char (100) aligned; /* long error message */ dcl nargs fixed bin; /* number of arguments */ dcl argp ptr; /* argument list ptr */ dcl ioa_string char (256); /* string returned by ioa_ */ dcl len fixed bin; /* length of ioa_string */ dcl (null, substr, length, reverse, verify) builtin; dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); dcl get_group_id_ entry returns (char (32)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl cu_$arg_count entry (fixed bin); dcl cu_$arg_list_ptr entry (ptr); dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin, bit (1) aligned, bit (1) aligned); dcl admin_gate_$syserr entry options (variable); /* */ bi = 0; /* set initial buffer length */ /* add caller name to buffer */ if caller ^= "" then do; call strip_add (caller); call add (":"); end; /* add message segment pathname to buffer */ if mptr ^= null then do; call hcs_$fs_get_path_name (mptr, dir, dirlen, ent, code); if code ^= 0 then call add (" Cannot get pathname."); else do; call add (" "); call add (substr (dir, 1, dirlen)); call add (">"); call strip_add (ent); end; end; /* add process group id to buffer */ call add (" for "); pgid = get_group_id_ (); call strip_add (pgid); /* add system error message to buffer */ if ecode ^= 0 then do; call add (" "); call convert_status_code_ (ecode, short_mess, long_mess); call strip_add ((long_mess)); end; /* add ioa_ message to buffer */ call cu_$arg_count (nargs); if nargs > 3 then do; call add (" "); call cu_$arg_list_ptr (argp); call ioa_$general_rs (argp, 4, 5, ioa_string, len, "0"b, "0"b); call strip_add (substr (ioa_string, 1, len)); end; /* now just spit it out */ finish: call admin_gate_$syserr (15, substr (buffer, 1, bi)); return; strip_add: proc (item); /* strips trailing blanks and adds item to buffer */ dcl item char (*); dcl (i, j) fixed bin; dcl strip_sw bit (1) aligned; strip_sw = "1"b; /* strip trailing blanks */ go to join; add: entry (item); /* adds item to buffer */ strip_sw = "0"b; join: i = length (item); if i = 0 then return; if strip_sw then do; j = verify (reverse (item), " "); if j = 0 then return; /* item was all blanks */ i = i -j + 1; end; if bi + i > length (buffer) then i = length (buffer) - bi; substr (buffer, bi+1, i) = substr (item, 1, i); bi = bi + i; if bi = length (buffer) then go to finish; end strip_add; end mseg_error_v3_;  mseg_error_v4_.pl1 05/09/85 1152.2r w 05/06/85 1619.0 37917 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ mseg_error_v4_: proc (mptr, ecode, caller); /* This procedure formats error messages for the message segment facility and enters these error messages into the syserr log. An error message contains the following parts: 1. name of the calling procedure 2. message segment pathname 3. process group id 4. system error message 5. caller-supplied message */ /* Written by J. Stern, 11/11/75 */ dcl mptr ptr; /* message segment pointer */ dcl ecode fixed bin (35); /* error code (input!) */ dcl caller char (*); /* procedure name of caller */ dcl buffer char (512) aligned; /* buffer to construct error message */ dcl bi fixed bin; /* current length of buffer */ dcl dir char (168); /* directory name */ dcl dirlen fixed bin; /* length of dir */ dcl ent char (32); /* entry name */ dcl code fixed bin (35); /* error code */ dcl pgid char (32); /* process group id */ dcl short_mess char (8) aligned; /* short error message */ dcl long_mess char (100) aligned; /* long error message */ dcl nargs fixed bin; /* number of arguments */ dcl argp ptr; /* argument list ptr */ dcl ioa_string char (256); /* string returned by ioa_ */ dcl len fixed bin; /* length of ioa_string */ dcl (null, substr, length, reverse, verify) builtin; dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); dcl get_group_id_ entry returns (char (32)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl cu_$arg_count entry (fixed bin); dcl cu_$arg_list_ptr entry (ptr); dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin, bit (1) aligned, bit (1) aligned); dcl admin_gate_$syserr entry options (variable); /* */ bi = 0; /* set initial buffer length */ /* add caller name to buffer */ if caller ^= "" then do; call strip_add (caller); call add (":"); end; /* add message segment pathname to buffer */ if mptr ^= null then do; call hcs_$fs_get_path_name (mptr, dir, dirlen, ent, code); if code ^= 0 then call add (" Cannot get pathname."); else do; call add (" "); call add (substr (dir, 1, dirlen)); call add (">"); call strip_add (ent); end; end; /* add process group id to buffer */ call add (" for "); pgid = get_group_id_ (); call strip_add (pgid); /* add system error message to buffer */ if ecode ^= 0 then do; call add (" "); call convert_status_code_ (ecode, short_mess, long_mess); call strip_add ((long_mess)); end; /* add ioa_ message to buffer */ call cu_$arg_count (nargs); if nargs > 3 then do; call add (" "); call cu_$arg_list_ptr (argp); call ioa_$general_rs (argp, 4, 5, ioa_string, len, "0"b, "0"b); call strip_add (substr (ioa_string, 1, len)); end; /* now just spit it out */ finish: call admin_gate_$syserr (15, substr (buffer, 1, bi)); return; strip_add: proc (item); /* strips trailing blanks and adds item to buffer */ dcl item char (*); dcl (i, j) fixed bin; dcl strip_sw bit (1) aligned; strip_sw = "1"b; /* strip trailing blanks */ go to join; add: entry (item); /* adds item to buffer */ strip_sw = "0"b; join: i = length (item); if i = 0 then return; if strip_sw then do; j = verify (reverse (item), " "); if j = 0 then return; /* item was all blanks */ i = i -j + 1; end; if bi + i > length (buffer) then i = length (buffer) - bi; substr (buffer, bi+1, i) = substr (item, 1, i); bi = bi + i; if bi = length (buffer) then go to finish; end strip_add; end mseg_error_v4_;  mseg_upgrade_from_v2_.pl1 05/10/85 0856.7r w 05/06/85 1619.0 59634 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* Support for upgrading version 2 message segments to the version supported by bound_mseg_ */ /* Created: May 1985 by G. Palter */ /* format: style3,linecom */ mseg_upgrade_from_v2_: procedure (); return; /* not an entrypoint */ /* Parameters */ dcl P_mseg_operation_ptr /* -> description of the operation forcing the upgrade (I) */ pointer parameter; dcl P_salvage_completed bit (1) aligned parameter; /* salvage: set ON => salvage succeeded (O) */ dcl P_callers_area_ptr pointer parameter; /* read_message: -> area in which to place the message (I) */ dcl P_code fixed binary (35) parameter; /* read_message: set to standard system status code (O) */ /* Local copies of parameters */ dcl callers_area_ptr pointer; dcl code fixed binary (35); /* Remaining declarations */ /* format: idind30 */ dcl 1 v2_wakeup_state aligned, 2 state, 3 switches aligned, 4 allow_normal bit (1) unaligned, 4 allow_urgent bit (1) unaligned, 4 pad bit (34) unaligned, 3 lock_id bit (36) aligned, 3 event_channel fixed bin (71), 3 process_id bit (36) aligned, 2 pad (64 - 5) bit (36) aligned; /* format: idind20 */ dcl msg_ptr pointer; dcl msg_sender_id character (32) aligned; dcl (msg_time, old_msg_time) fixed binary (54); dcl (msg_location, msg_len, old_msg_location) fixed binary (18); dcl msg_sender_level fixed binary; dcl error_table_$bad_subr_arg fixed binary (35) external; dcl ms_salvager_v2_ entry (pointer, fixed binary, fixed binary (35)); dcl mseg_util_v2_$incremental_read entry (pointer, bit (2) aligned, pointer, fixed binary (18), fixed binary (54), fixed binary, pointer, fixed binary (18), fixed binary (18), fixed binary (54), character (32) aligned, fixed binary, fixed binary (35)); dcl mseg_util_v2_$read entry (pointer, bit (2) aligned, pointer, fixed binary (18), fixed binary (54), fixed binary, pointer, fixed binary (18), character (32) aligned, fixed binary, fixed binary (35)); dcl (addr, bit, fixed, string, substr, unspec) builtin; %page; /* Salvage the version 2 message segment */ mseg_upgrade_from_v2_$salvage: entry (P_mseg_operation_ptr, P_salvage_completed); mseg_operation_ptr = P_mseg_operation_ptr; mseg_ptr = mseg_operation.mseg_ptr; call ms_salvager_v2_ (mseg_ptr, (0), code); /* it will report problems via admin_gate_ */ P_salvage_completed = (code = 0); return; %page; /* Get the wakeup acceptance state of a version 2 message segment -- In version 2 segments, the wakeup state is stored in the header "message". We will convert said "message" into the appropriate wakeup_state structure. */ mseg_upgrade_from_v2_$get_wakeup_state: entry (P_mseg_operation_ptr); mseg_operation_ptr = P_mseg_operation_ptr; mseg_ptr = mseg_operation.mseg_ptr; if mseg_ptr -> mseg_hdr_v2.ms_in_hdr then do; unspec (v2_wakeup_state) = unspec (mseg_ptr -> mseg_hdr_v2.hdr_ms); mseg_operation.wakeup_state.version = MSEG_WAKEUP_STATE_VERSION_1; string (mseg_operation.wakeup_state.flags) = string (v2_wakeup_state.switches); mseg_operation.wakeup_state.event_channel = v2_wakeup_state.event_channel; mseg_operation.wakeup_state.access_class = mseg_operation.access_info.access_class; mseg_operation.wakeup_state.process_id = v2_wakeup_state.process_id; mseg_operation.wakeup_state.lock_id = v2_wakeup_state.lock_id; mseg_operation.wakeup_state_valid = "1"b; end; else mseg_operation.wakeup_state_valid = "0"b; return; %page; /* Read the requested message from a version 2 message segment */ mseg_upgrade_from_v2_$read_message: entry (P_mseg_operation_ptr, P_callers_area_ptr, P_code); mseg_operation_ptr = P_mseg_operation_ptr; callers_area_ptr = P_callers_area_ptr; code = error_table_$bad_subr_arg; /* in case our caller's mseg_message_info is invalid */ mseg_ptr = mseg_operation.mseg_ptr; mseg_message_info_ptr = addr (mseg_operation.message_info); if mseg_message_info.message_code = MSEG_READ_FIRST then call mseg_util_v2_$read (mseg_ptr, "10"b, callers_area_ptr, msg_location, msg_time, 0, msg_ptr, msg_len, msg_sender_id, msg_sender_level, code); else if mseg_message_info.message_code = MSEG_READ_LAST then call mseg_util_v2_$read (mseg_ptr, "01"b, callers_area_ptr, msg_location, msg_time, 0, msg_ptr, msg_len, msg_sender_id, msg_sender_level, code); else do; old_msg_location = fixed (substr (mseg_message_info.ms_id, 1, 18), 18, 0); old_msg_time = fixed (substr (mseg_message_info.ms_id, 19, 54), 54, 0); if mseg_message_info.message_code = MSEG_READ_SPECIFIED then call mseg_util_v2_$incremental_read (mseg_ptr, "00"b, callers_area_ptr, old_msg_location, old_msg_time, 0, msg_ptr, msg_len, msg_location, msg_time, msg_sender_id, msg_sender_level, code); else if mseg_message_info.message_code = MSEG_READ_BEFORE_SPECIFIED then call mseg_util_v2_$incremental_read (mseg_ptr, "10"b, callers_area_ptr, old_msg_location, old_msg_time, 0, msg_ptr, msg_len, msg_location, msg_time, msg_sender_id, msg_sender_level, code); else if mseg_message_info.message_code = MSEG_READ_AFTER_SPECIFIED then call mseg_util_v2_$incremental_read (mseg_ptr, "01"b, callers_area_ptr, old_msg_location, old_msg_time, 0, msg_ptr, msg_len, msg_location, msg_time, msg_sender_id, msg_sender_level, code); end; if code = 0 then do; /*** Read succeeded -- Fill in the mseg_message_info appropriately */ mseg_message_info.ms_ptr = msg_ptr; mseg_message_info.ms_len = msg_len; mseg_message_info.ms_id = bit (msg_location, 18) || bit (msg_time, 54); mseg_message_info.ms_access_class = mseg_operation.access_info.access_class; mseg_message_info.sender_id = msg_sender_id; mseg_message_info.sender_process_id = ""b; mseg_message_info.sender_level = msg_sender_level; mseg_message_info.sender_authorization = mseg_operation.access_info.access_class; mseg_message_info.sender_max_authorization = mseg_operation.access_info.access_class; mseg_message_info.sender_audit = ""b; end; P_code = code; return; /* format: off */ %page; %include mseg_operation; %page; %include mseg_message_info; %page; %include mseg_wakeup_state; %page; %include entry_access_info; %page; %include mseg_hdr_v2; /* format: on */ end mseg_upgrade_from_v2_;  mseg_upgrade_from_v3_.pl1 05/10/85 0856.7r w 05/06/85 1619.0 51408 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* Support for upgrading version 3 message segments to the version supported by bound_mseg_ */ /* Created: May 1985 by G. Palter */ /* format: style3,linecom */ mseg_upgrade_from_v3_: procedure (); return; /* not an entrypoint */ /* Parameters */ dcl P_mseg_operation_ptr /* -> description of the operation forcing the upgrade (I) */ pointer parameter; dcl P_salvage_completed bit (1) aligned parameter; /* salvage: set ON => salvage succeeded (O) */ dcl P_callers_area_ptr pointer parameter; /* read_message: -> area in which to place the message (I) */ dcl P_code fixed binary (35) parameter; /* read_message: set to standard system status code (O) */ /* Local copies of parameters */ dcl callers_area_ptr pointer; dcl code fixed binary (35); /* Remaining declarations */ /* format: idind30 */ dcl 1 v3_wakeup_state aligned, 2 state, 3 switches aligned, 4 allow_normal bit (1) unaligned, 4 allow_urgent bit (1) unaligned, 4 pad bit (34) unaligned, 3 lock_id bit (36) aligned, 3 event_channel fixed bin (71), 3 process_id bit (36) aligned, 2 pad (64 - 5) bit (36) aligned; /* format: idind20 */ dcl 1 local_mra aligned like mseg_return_args; dcl error_table_$bad_subr_arg fixed binary (35) external; dcl ms_salvager_v3_ entry (pointer, fixed binary (35)); dcl mseg_util_v3_$incremental_read entry (pointer, pointer, bit (2) aligned, bit (72) aligned, pointer, bit (1) aligned, fixed binary (35)); dcl mseg_util_v3_$read entry (pointer, pointer, bit (1) aligned, pointer, bit (1) aligned, fixed binary (35)); dcl (addr, string, unspec) builtin; %page; /* Salvage the version 3 message segment */ mseg_upgrade_from_v3_$salvage: entry (P_mseg_operation_ptr, P_salvage_completed); mseg_operation_ptr = P_mseg_operation_ptr; mseg_ptr = mseg_operation.mseg_ptr; call ms_salvager_v3_ (mseg_ptr, code); /* it will report problems via admin_gate_ */ P_salvage_completed = (code = 0); return; %page; /* Get the wakeup acceptance state of a version 3 message segment -- In version 3 segments, the wakeup state is stored in the header "message". We will convert said "message" into the appropriate wakeup_state structure. */ mseg_upgrade_from_v3_$get_wakeup_state: entry (P_mseg_operation_ptr); mseg_operation_ptr = P_mseg_operation_ptr; mseg_ptr = mseg_operation.mseg_ptr; if mseg_ptr -> mseg_hdr.ms_in_hdr then do; unspec (v3_wakeup_state) = unspec (mseg_ptr -> mseg_hdr.hdr_ms); mseg_operation.wakeup_state.version = MSEG_WAKEUP_STATE_VERSION_1; string (mseg_operation.wakeup_state.flags) = string (v3_wakeup_state.switches); mseg_operation.wakeup_state.event_channel = v3_wakeup_state.event_channel; mseg_operation.wakeup_state.access_class = mseg_ptr -> mseg_hdr.hdr_ms_access_class; mseg_operation.wakeup_state.process_id = v3_wakeup_state.process_id; mseg_operation.wakeup_state.lock_id = v3_wakeup_state.lock_id; mseg_operation.wakeup_state_valid = "1"b; end; else mseg_operation.wakeup_state_valid = "0"b; return; %page; /* Read the requested message from a version 3 message segment */ mseg_upgrade_from_v3_$read_message: entry (P_mseg_operation_ptr, P_callers_area_ptr, P_code); mseg_operation_ptr = P_mseg_operation_ptr; callers_area_ptr = P_callers_area_ptr; code = error_table_$bad_subr_arg; /* in case our caller's mseg_message_info is invalid */ mseg_ptr = mseg_operation.mseg_ptr; mseg_message_info_ptr = addr (mseg_operation.message_info); if mseg_message_info.message_code = MSEG_READ_FIRST then call mseg_util_v3_$read (mseg_ptr, callers_area_ptr, "0"b, addr (local_mra), "0"b, code); else if mseg_message_info.message_code = MSEG_READ_LAST then call mseg_util_v3_$read (mseg_ptr, callers_area_ptr, "1"b, addr (local_mra), "0"b, code); else if mseg_message_info.message_code = MSEG_READ_SPECIFIED then call mseg_util_v3_$incremental_read (mseg_ptr, callers_area_ptr, "00"b, mseg_message_info.ms_id, addr (local_mra), "0"b, code); else if mseg_message_info.message_code = MSEG_READ_BEFORE_SPECIFIED then call mseg_util_v3_$incremental_read (mseg_ptr, callers_area_ptr, "10"b, mseg_message_info.ms_id, addr (local_mra), "0"b, code); else if mseg_message_info.message_code = MSEG_READ_AFTER_SPECIFIED then call mseg_util_v3_$incremental_read (mseg_ptr, callers_area_ptr, "01"b, mseg_message_info.ms_id, addr (local_mra), "0"b, code); if code = 0 then do; /*** Read succeeded -- Fill in the mseg_message_info appropriately */ mseg_message_info.ms_ptr = local_mra.ms_ptr; mseg_message_info.ms_len = local_mra.ms_len; mseg_message_info.ms_id = local_mra.ms_id; mseg_message_info.ms_access_class = local_mra.access_class; mseg_message_info.sender_id = local_mra.sender_id; mseg_message_info.sender_process_id = ""b; mseg_message_info.sender_level = local_mra.level; mseg_message_info.sender_authorization = local_mra.sender_authorization; mseg_message_info.sender_max_authorization = local_mra.sender_authorization; mseg_message_info.sender_audit = ""b; end; P_code = code; return; /* format: off */ %page; %include mseg_operation; %page; %include mseg_message_info; %page; %include mseg_wakeup_state; %page; %include entry_access_info; %page; %include mseg_hdr_v3; %page; %include mseg_return_args_v3; /* format: on */ end mseg_upgrade_from_v3_;  mseg_upgrade_from_v4_.pl1 05/10/85 0856.7r w 05/06/85 1619.0 51831 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* Support for upgrading version 4 message segments to the version supported by bound_mseg_ */ /* Created: May 1985 by G. Palter */ /* format: style3,linecom */ mseg_upgrade_from_v4_: procedure (); return; /* not an entrypoint */ /* Parameters */ dcl P_mseg_operation_ptr /* -> description of the operation forcing the upgrade (I) */ pointer parameter; dcl P_salvage_completed bit (1) aligned parameter; /* salvage: set ON => salvage succeeded (O) */ dcl P_callers_area_ptr pointer parameter; /* read_message: -> area in which to place the message (I) */ dcl P_code fixed binary (35) parameter; /* read_message: set to standard system status code (O) */ /* Local copies of parameters */ dcl callers_area_ptr pointer; dcl code fixed binary (35); /* Remaining declarations */ /* format: idind30 */ dcl 1 v4_wakeup_state aligned, 2 state, 3 switches aligned, 4 allow_normal bit (1) unaligned, 4 allow_urgent bit (1) unaligned, 4 pad bit (34) unaligned, 3 lock_id bit (36) aligned, 3 event_channel fixed bin (71), 3 process_id bit (36) aligned, 2 pad (64 - 5) bit (36) aligned; /* format: idind20 */ dcl 1 local_mra aligned like mseg_return_args; dcl error_table_$bad_subr_arg fixed binary (35) external; dcl ms_salvager_v4_ entry (pointer, fixed binary (35)); dcl mseg_util_v4_$incremental_read_priv entry (pointer, pointer, bit (2) aligned, bit (72) aligned, pointer, bit (1) aligned, fixed binary (35)); dcl mseg_util_v4_$read_priv entry (pointer, pointer, bit (1) aligned, pointer, bit (1) aligned, fixed binary (35)); dcl (addr, string, unspec) builtin; %page; /* Salvage the version 4 message segment */ mseg_upgrade_from_v4_$salvage: entry (P_mseg_operation_ptr, P_salvage_completed); mseg_operation_ptr = P_mseg_operation_ptr; mseg_ptr = mseg_operation.mseg_ptr; call ms_salvager_v4_ (mseg_ptr, code); /* it will report problems via admin_gate_ */ P_salvage_completed = (code = 0); return; %page; /* Get the wakeup acceptance state of a version 4 message segment -- In version 4 segments, the wakeup state is stored in the header "message". We will convert said "message" into the appropriate wakeup_state structure. */ mseg_upgrade_from_v4_$get_wakeup_state: entry (P_mseg_operation_ptr); mseg_operation_ptr = P_mseg_operation_ptr; mseg_ptr = mseg_operation.mseg_ptr; if mseg_ptr -> mseg_hdr_v4.ms_in_hdr then do; unspec (v4_wakeup_state) = unspec (mseg_ptr -> mseg_hdr_v4.hdr_ms); mseg_operation.wakeup_state.version = MSEG_WAKEUP_STATE_VERSION_1; string (mseg_operation.wakeup_state.flags) = string (v4_wakeup_state.switches); mseg_operation.wakeup_state.event_channel = v4_wakeup_state.event_channel; mseg_operation.wakeup_state.access_class = mseg_ptr -> mseg_hdr_v4.hdr_ms_access_class; mseg_operation.wakeup_state.process_id = v4_wakeup_state.process_id; mseg_operation.wakeup_state.lock_id = v4_wakeup_state.lock_id; mseg_operation.wakeup_state_valid = "1"b; end; else mseg_operation.wakeup_state_valid = "0"b; return; %page; /* Read the requested message from a version 4 message segment */ mseg_upgrade_from_v4_$read_message: entry (P_mseg_operation_ptr, P_callers_area_ptr, P_code); mseg_operation_ptr = P_mseg_operation_ptr; callers_area_ptr = P_callers_area_ptr; code = error_table_$bad_subr_arg; /* in case our caller's mseg_message_info is invalid */ mseg_ptr = mseg_operation.mseg_ptr; mseg_message_info_ptr = addr (mseg_operation.message_info); if mseg_message_info.message_code = MSEG_READ_FIRST then call mseg_util_v4_$read_priv (mseg_ptr, callers_area_ptr, "0"b, addr (local_mra), "0"b, code); else if mseg_message_info.message_code = MSEG_READ_LAST then call mseg_util_v4_$read_priv (mseg_ptr, callers_area_ptr, "1"b, addr (local_mra), "0"b, code); else if mseg_message_info.message_code = MSEG_READ_SPECIFIED then call mseg_util_v4_$incremental_read_priv (mseg_ptr, callers_area_ptr, "00"b, mseg_message_info.ms_id, addr (local_mra), "0"b, code); else if mseg_message_info.message_code = MSEG_READ_BEFORE_SPECIFIED then call mseg_util_v4_$incremental_read_priv (mseg_ptr, callers_area_ptr, "10"b, mseg_message_info.ms_id, addr (local_mra), "0"b, code); else if mseg_message_info.message_code = MSEG_READ_AFTER_SPECIFIED then call mseg_util_v4_$incremental_read_priv (mseg_ptr, callers_area_ptr, "01"b, mseg_message_info.ms_id, addr (local_mra), "0"b, code); if code = 0 then do; /*** Read succeeded -- Fill in the mseg_message_info appropriately */ mseg_message_info.ms_ptr = local_mra.ms_ptr; mseg_message_info.ms_len = local_mra.ms_len; mseg_message_info.ms_id = local_mra.ms_id; mseg_message_info.ms_access_class = local_mra.access_class; mseg_message_info.sender_id = local_mra.sender_id; mseg_message_info.sender_process_id = ""b; mseg_message_info.sender_level = local_mra.level; mseg_message_info.sender_authorization = local_mra.sender_authorization; mseg_message_info.sender_max_authorization = local_mra.sender_authorization; mseg_message_info.sender_audit = ""b; end; P_code = code; return; /* format: off */ %page; %include mseg_operation; %page; %include mseg_message_info; %page; %include mseg_wakeup_state; %page; %include entry_access_info; %page; %include mseg_hdr_v4; %page; %include mseg_return_args_v4; /* format: on */ end mseg_upgrade_from_v4_;  mseg_util_v2_.pl1 05/10/85 0856.8r w 05/06/85 1619.0 166203 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ mseg_util_v2_: proc; /* Adapted from the original version 2 mseg_util_ by J. Stern, 11/4/74 */ dcl (a_mptr, /* pointer to the message segment */ prev_tr_ptr, /* pointer to previous message trailer */ next_tr_ptr, /* pointer to next message trailer */ ms_ptr, /* pointer to message wanted */ a_ret_ptr, /* pointer to returned message */ ret_ptr init (null), deletep, /* pointer to block to be zeroed out */ t_ptr, /* scan pointer for returning message */ a_area_ptr, /* pointer to allocated area */ a_ms_ptr, /* pointer to updating message */ area_ptr) ptr; dcl (last, /* ON if message is last in block */ first, /* ON if message is first in block */ update, /* ON if message is being updated */ ms_end, /* ON when end of message is found */ read, /* ON if message is to be read */ delete) bit (1) aligned; /* on if message is to be deleted */ dcl (tr_offset, /* offset from beginning of block to trailer */ ms_count, /* number of messages in segment */ mseg_data_v2_$block_trailer_data ext, /* number of data words in block trailer */ mseg_data_v2_$block_hdr_data ext, /* number of data words in block header */ prev_offset, /* offset to previous message */ next_offset, /* offset to next message */ block_size, /* size of a message block */ blocks_in_message, /* number of blocks used for message */ blocks_left, /* number of free blocks in message segment */ copy_size, /* size of bit copy mask */ delete_size, /* bit size of block to be zeroed out */ incr_size, /* for stepping copy-to pointer */ a_ms_len, /* length of message in block trailer */ ms_len, found_ms_len, /* actual message size */ a_loc, /* location of message */ loc, a_ret_loc, /* location of incremental message */ bit_off) fixed bin (18); /* location of allocation bit to be turned off */ dcl (a_ms_wanted, /* flag telling which message is wanted */ ms_wanted, a_dir, /* direction of incremental search */ dir init ("0"b)) bit (2) aligned; dcl ( mseg_data_v2_$mseg_tr36 ext ) bit (36) aligned; dcl (a_time, /* time message was sent */ a_ret_time, time) fixed bin (54); dcl ( a_level, /* user level: 0 = non-own entry, 1 = own entry (argument) */ alloc_len, /* length of allocation bit string */ level, /* user level: 0 = non-own entry, 1 = own entry (internal) */ a_user_level, /* the callers' initial level */ user_level, ms_word_len, /* length of message in words */ zero_words (8) int static init (0, 0, 0, 0, 0, 0, 0, 0), /* for uid credibility check */ name_len) fixed bin; /* length of person-project portion of group id */ dcl ( a_code, /* error code (argument) */ code /* error code (internal) */ ) fixed bin (35); dcl (addr, addrel, bit, divide, fixed, index, null, ptr, rel, substr) builtin; dcl ( cleanup ) condition; dcl area_array area (30) aligned based (area_ptr), /* for allocating */ ms_word_array (ms_word_len) fixed bin aligned based (ret_ptr); dcl (caller_id, /* id of caller */ ms_sender_id) char (32) aligned; /* id of message sender */ dcl a_sender_id char (32) aligned; /* id of message sender */ dcl bit_copy_mask bit (copy_size) based; /* bit copy mask */ dcl bits (incr_size) bit (1) based unaligned; /* for resetting copy-to pointer */ dcl zeroes char (32) aligned based (addr (zero_words (1))); /* for uid credibility check */ % include mseg_hdr_v2; % include ms_block_hdr_v2; % include ms_block_trailer_v2; dcl error_table_$bad_segment ext fixed bin (35); dcl error_table_$moderr ext fixed bin (35); dcl error_table_$no_message ext fixed bin (35); dcl get_group_id_$tag_star ext entry returns (char (32) aligned); dcl ptr_is_good_v2_ ext entry (ptr) returns (bit (1) aligned); /* */ read: entry (a_mptr, a_ms_wanted, a_area_ptr, a_loc, a_time, a_user_level, a_ret_ptr, a_ms_len, a_sender_id, a_level, a_code); ms_wanted = a_ms_wanted; area_ptr = a_area_ptr; read = "1"b; update, delete = "0"b; go to COMMON; delete: entry (a_mptr, a_loc, a_time, a_user_level, a_code); ms_wanted = "11"b; /* delete by id only */ update, read = "0"b; delete = "1"b; go to COMMON; read_and_delete: entry (a_mptr, a_ms_wanted, a_area_ptr, a_user_level, a_ret_ptr, a_ms_len, a_sender_id, a_level, a_code); ms_wanted = a_ms_wanted; area_ptr = a_area_ptr; read, delete = "1"b; update = "0"b; go to COMMON; incremental_read: entry (a_mptr, a_dir, a_area_ptr, a_loc, a_time, a_user_level, a_ret_ptr, a_ms_len, a_ret_loc, a_ret_time, a_sender_id, a_level, a_code); ms_wanted = "11"b; dir = a_dir; area_ptr = a_area_ptr; read = "1"b; delete = "0"b; update = "0"b; go to COMMON; update: entry (a_mptr, a_ms_ptr, a_ms_len, a_loc, a_time, a_user_level, a_code); read, delete = "0"b; update = "1"b; ms_len = a_ms_len; /* */ COMMON: on condition (cleanup) /* establish cleanup handler to free allocated message */ begin; if ret_ptr ^= null /* a message was allocated */ then do; free ms_word_array in (area_array); /* free it */ a_ret_ptr = null; /* and return null argument ptr */ end; a_code = error_table_$bad_segment; /* make sure salvaging happens */ end; code = 0; mptr = a_mptr; alloc_len = fixed (bit (mseg_hdr_v2.alloc_len, 16), 17); /* pick allocation bit string length out of header */ user_level = a_user_level; if user_level ^= 0 /* user calling for his own message */ then do; caller_id = get_group_id_$tag_star (); /* get his pers-proj name */ name_len = index (caller_id, "*")-2; caller_id = substr (caller_id, 1, name_len); end; if ms_wanted = "11"b /* copy id if given */ then do; time = a_time; loc = a_loc; /* copy message location also */ end; first, last, ms_end = "0"b; /* initialize flags */ ms_count = /* get number of messages */ fixed (mptr -> mseg_hdr_v2.number_of_messages, 18); block_size = fixed (mseg_hdr_v2.block_size, 18); /* pick out block size from header */ tr_offset = /* calculate trailer offset */ block_size-mseg_data_v2_$block_trailer_data; if (delete) /* user is deleting a message */ then do; blocks_left = /* get present number of free blocks */ fixed (mptr -> mseg_hdr_v2.space_left, 18); delete_size = block_size*36; /* compute bit size for zeroing blocks */ end; /* */ /* locate the message */ if ms_wanted = "01"b /* last message wanted */ then do; loc = fixed (mptr -> mseg_hdr_v2.last_ms_offset, 18); ms_ptr = ptr (mptr, loc); /* make pointer to last message */ last = "1"b; /* set flag to remember */ if ms_count = 1 /* only one message */ then first = "1"b; /* it is first also */ end; else if ms_wanted = "10"b /* first message wanted */ then do; loc = fixed (mptr -> mseg_hdr_v2.first_ms_offset, 18); ms_ptr = ptr (mptr, loc); /* make pointer to first message */ first = "1"b; /* set flag to remember */ if ms_count = 1 /* only one message */ then last = "1"b; /* it is last also */ end; if (first | last) then if ((^ptr_is_good_v2_ (ms_ptr))| (^ms_ptr -> ms_block_hdr.first_block)) then go to BAD_SEG; /* inconsistency, must be at least one message in segment */ if ms_wanted = "11"b /* locate message by unique id */ then do; /* check the validity of the given offset */ ms_ptr = ptr (mptr, loc); /* make pointer to message */ if ((^ptr_is_good_v2_ (ms_ptr))| (ms_ptr -> ms_block_hdr.first_block ^= "1"b)) then go to NO_MSG; tr_ptr = addrel (ms_ptr, tr_offset); /* get pointer to trailer data */ if tr_ptr -> ms_size = "0"b /* make credibility check on trailer */ | tr_ptr -> ms_block_trailer_v2.time = "0"b | tr_ptr -> sender_id = zeroes | tr_ptr -> ms_block_trailer_v2.tr_pattern ^= mseg_data_v2_$mseg_tr36 then go to BAD_SEG; if tr_ptr -> ms_block_trailer_v2.time = bit (fixed (time, 54), 54) /* message time correct */ then do; if (delete) then do; /* message is to be deleted */ if fixed (mptr -> mseg_hdr_v2.first_ms_offset, 18) = loc /* first message */ then first = "1"b; /* set flag to remember */ if fixed (mptr -> mseg_hdr_v2.last_ms_offset, 18) = loc /* last message */ then last = "1"b; /* set flag to remember */ end; end; else /* message time specified is incorrect */ go to NO_MSG; /* incremental message wanted */ if dir ^= "0"b then do; if dir = "10"b /* previous message wanted */ then do; /* increment message pointer */ if tr_ptr -> ms_block_trailer_v2.b_offset ^= "0"b then do; loc = fixed (tr_ptr -> ms_block_trailer_v2.b_offset, 18); ms_ptr = ptr (ms_ptr, loc); end; else do; /* error, no previous message */ if fixed (mseg_hdr_v2.first_ms_offset, 18) ^= loc then go to BAD_SEG; /* format error, not first message */ NO_MSG: code = error_table_$no_message; go to FIN; end; end; else if dir = "01"b /* next message wanted */ then do; /* increment message pointer */ if tr_ptr -> ms_block_trailer_v2.f_offset ^= "0"b then do; loc = fixed (tr_ptr -> ms_block_trailer_v2.f_offset, 18); ms_ptr = ptr (ms_ptr, loc); end; else do; /* error, no next message */ if fixed (mseg_hdr_v2.last_ms_offset, 18) ^= loc then go to BAD_SEG; /* format error, not last message */ go to NO_MSG; end; end; end; end; /* get information from the first block trailer */ tr_ptr = /* get pointer to trailer */ addrel (ms_ptr, tr_offset); if tr_ptr -> ms_size = "0"b /* make trailer credibility check */ | tr_ptr -> ms_block_trailer_v2.time = "0"b | tr_ptr -> sender_id = zeroes | tr_ptr -> ms_block_trailer_v2.tr_pattern ^= mseg_data_v2_$mseg_tr36 then go to BAD_SEG; if dir ^= "0"b /* pick up incremental id */ then time = fixed (tr_ptr -> ms_block_trailer_v2.time, 54); if (delete) then do; if (^first) then do; /* not first message */ prev_offset = /* get offset to previous message */ fixed (tr_ptr -> ms_block_trailer_v2.b_offset, 18); prev_tr_ptr = /* make pointer to previous trailer */ ptr (mptr, prev_offset+tr_offset); end; if (^last) then do; /* not last message */ next_offset = /* get offset to next message */ fixed (tr_ptr -> ms_block_trailer_v2.f_offset, 18); next_tr_ptr = /* make pointer to next trailer */ ptr (mptr, next_offset+tr_offset); end; end; ms_sender_id = tr_ptr -> ms_block_trailer_v2.sender_id; /* pick out senders' id */ level = fixed (ms_block_trailer_v2.ring_no, 17); /* pick out validation level */ /* make final access check */ if user_level ^= 0 /* user called for own message */ then if caller_id ^= substr (ms_sender_id, 1, name_len) /* this is not his message */ then do; ms_len = 0; /* not found */ if (delete | update) /* no "d" permission, not own message */ then code = error_table_$moderr; else /* user not deleting */ if dir = "0"b /* ordinary read */ then time = fixed (bit (tr_ptr -> ms_block_trailer_v2.time, 54), 54); /* return message time */ go to FIN; end; if update then if fixed (tr_ptr -> ms_block_trailer_v2.ms_size, 18) ^= ms_len /* incorrect message size specified */ then go to NO_MSG; /* allocate an area for the returned message */ ms_len = fixed (ms_block_trailer_v2.ms_size, 18); /* pick out message size */ if (read) then do; ms_word_len = divide (ms_len+35, 36, 17, 0); /* compute word length from bit count */ allocate ms_word_array in (area_array) set (ret_ptr); /* allocate the area */ t_ptr = ret_ptr; /* initialize scan pointer */ end; else /* not reading message */ if update /* updating message */ then t_ptr = a_ms_ptr; /* initialize scan ptr */ /* */ /* chase the message thread */ found_ms_len = 0; /* initialize size of found message */ blocks_in_message = 0; /* initialize count */ block_ptr = ms_ptr; /* initialize block pointer */ ms_end = "0"b; /* initialize end of message flag */ if (delete | update) /* user is deleting or updating a message */ then mseg_hdr_v2.aip = "1"b; /* turn on aip bit */ do while (^ms_end); blocks_in_message = /* increment message block count */ blocks_in_message + 1; found_ms_len = found_ms_len + fixed (ms_block_hdr.block_count, 18); /* increment message size */ if found_ms_len > ms_len /* more message than block trailer specified */ then do; /* error in message segment */ BAD_SEG: code = error_table_$bad_segment; go to FIN; end; if (read | update) then do; /* return message for reading */ copy_size = /* set size of copy mask */ fixed (block_ptr -> ms_block_hdr.block_count, 18); incr_size = copy_size + 1; /* to step copy-to ptr later */ if read /* reading message */ then t_ptr -> bit_copy_mask = /* copy message */ addrel (block_ptr, mseg_data_v2_$block_hdr_data) -> bit_copy_mask; else /* not reading */ if update /* updating message */ then addrel (block_ptr, mseg_data_v2_$block_hdr_data) -> bit_copy_mask = t_ptr -> bit_copy_mask; /* overwrite */ end; if (delete) then do; /* user is deleting a message */ bit_off = divide (fixed (rel (block_ptr), 18), block_size, 18, 0)+1; /* calculate alloc bit for block */ if substr (mseg_hdr_v2.alloc_bits, bit_off, 1) = "0"b /* block not in use */ then go to BAD_SEG; /* format error */ else substr (mseg_hdr_v2.alloc_bits, bit_off, 1) = "0"b; /* turn bit off */ deletep = block_ptr; /* remember block ptr to delete later */ end; if blocks_in_message = 1 /* first block */ then if ms_wanted ^= "11"b /* id not given */ then do; /* get id */ tr_ptr = addrel (block_ptr, block_size-mseg_data_v2_$block_trailer_data); time = fixed (bit (tr_ptr -> ms_block_trailer_v2.time, 54), 54); end; if block_ptr -> ms_block_hdr.f_offset = "0"b then do; /* message block is last in message */ if found_ms_len ^= ms_len /* found size doesn't agree with trailer */ then go to BAD_SEG; /* format error */ else ms_end = "1"b; /* indicate end of message */ end; else do; block_ptr = /* step the block pointer */ ptr (block_ptr, fixed (block_ptr -> ms_block_hdr.f_offset, 18)); if (read) then t_ptr = /* increment copy-to pointer */ addr (t_ptr -> bits (incr_size)); end; if (delete) /* message is being deleted */ then do; copy_size = delete_size; /* set size of copy mask */ deletep -> bit_copy_mask = "0"b; /* use mask to zero out block */ end; end; /* */ /* finish deleting message if requested */ if (delete) then do; blocks_left = /* calculate new remaining blocks */ blocks_left + blocks_in_message; if ms_count > 1 /* there will be a remaining message */ then do; /* unthread the message */ if (first) then do; /* unthread first message */ mptr -> mseg_hdr_v2.first_ms_offset = bit (fixed (next_offset, 18), 18); /* reset header offset to new first message */ next_tr_ptr -> ms_block_trailer_v2.b_offset = "0"b; /* reset new first message back pointer */ end; if (last) then do; /* unthread last message */ mptr -> mseg_hdr_v2.last_ms_offset = bit (fixed (prev_offset, 18), 18); /* reset header offset to new last message */ prev_tr_ptr -> ms_block_trailer_v2.f_offset = "0"b; /* reset new last message forward pointer */ end; if (^first) then if (^last) then do; /* unthread mid message */ prev_tr_ptr -> ms_block_trailer_v2.f_offset = bit (fixed (next_offset, 18), 18); /* reset forward offset of previous message */ next_tr_ptr -> ms_block_trailer_v2.b_offset = bit (fixed (prev_offset, 18), 18); /* reset backward offset of next message */ end; end; else /* no messages left */ mseg_hdr_v2.first_ms_offset, /* zero out hdr pointers */ mseg_hdr_v2.last_ms_offset = "0"b; /* update header after deletion */ mptr -> mseg_hdr_v2.space_left = /* reset space left */ fixed (blocks_left); ms_count = ms_count - 1; mptr -> mseg_hdr_v2.number_of_messages = /* reset number of messages */ fixed (ms_count); mptr -> mseg_hdr_v2.aip = "0"b; /* turn off allocation in progress bit */ end; FIN: if code = 0 then do; if (read) then a_ms_len = ms_len; if (^delete & ^update) then do; a_time = time; /* return loc and time if not given */ a_loc = loc; end; if dir ^= "0"b /* return incremental data */ then do; a_ret_time = time; a_ret_loc = loc; end; end; else do; /* error, return null arguments */ if (read) then a_ms_len = 0; if (^delete & ^update) then a_time, a_loc = 0; if dir ^= "0"b then a_ret_loc, a_ret_time = 0; if ret_ptr ^= null /* a message was allocated */ then do; free ms_word_array in (area_array); /* free it */ a_ret_ptr = null; /* return null argument */ end; end; a_code = code; if (read) /* return allocation pointer for freeing */ then do; a_ret_ptr = ret_ptr; if code = 0 then do; a_sender_id = ms_sender_id; a_level = level; end; else if ^update then do; if user_level = 0 then a_sender_id = ""; a_level = -1; end; end; return; end mseg_util_v2_;  mseg_util_v3_.pl1 05/10/85 0856.8r w 05/06/85 1619.0 212472 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ mseg_util_v3_: proc; /* Modified for version 3 message segments by J. Stern, 10/22/74 */ /* Modified to use mseg_error_ by J. Stern, 11/12/75 */ /* Modified 3/77 by Charlie Davis for the installation of version 4 message segments */ dcl (a_mptr, /* pointer to the message segment */ prev_tr_ptr, /* pointer to previous message trailer */ next_tr_ptr, /* pointer to next message trailer */ prev_in_bucket_ptr, /* pointer to previous message in hash bucket */ ms_ptr, /* pointer to message wanted */ ret_ptr init (null), deletep, /* pointer to block to be zeroed out */ a_arg_ptr, /* pointer to return_arg structure (argument) */ arg_ptr, /* pointer to return_arg structure (internal) */ t_ptr, /* scan pointer for returning message */ a_area_ptr, /* pointer to allocated area */ a_ms_ptr, /* pointer to updating message */ area_ptr) ptr; dcl (read init ("0"b), /* ON for read or read and delete entry */ incr_read init ("0"b), /* ON for incremental read entry */ delete init ("0"b), /* ON for delete or read and delete entry */ update init ("0"b), /* ON for update entry */ get_count init ("0"b), /* ON for get_count entry */ mseg_priv, /* ON if calling process has privileged access */ a_own, /* ON if reading own message (argument) */ own, /* ON if reading own message (internal) */ last, /* ON if message is last in segment */ first, /* ON if message is first in segment */ search_sw, /* ON if message id not found for incremental reading */ ms_end) bit (1) aligned; /* ON when end of message is found */ dcl back_in_bucket_offset bit (18) aligned; /* offset of message one back in hash bucket */ dcl (tr_offset, /* offset from beginning of block to trailer */ ms_count, /* number of messages in segment */ a_count, /* message count (argument) */ count, /* message count (internal) */ prev_offset, /* offset to previous message */ next_offset, /* offset to next message */ block_size, /* size of a message block */ blocks_in_message, /* number of blocks used for message */ copy_size, /* size of bit copy mask */ delete_size, /* bit size of block to be zeroed out */ a_ms_len, /* length of message in block trailer */ ms_len, found_ms_len, /* actual message size */ update_len, /* size of update message */ loc, bit_off) fixed bin (18); /* location of allocation bit to be turned off */ dcl (a_first_or_last, /* ON if last message wanted (argument) */ first_or_last) bit (1) aligned; /* ON if last message wanted (internal) */ dcl (a_dir, /* direction of incremental search */ dir init ("00"b)) bit (2) aligned; dcl (a_ms_id, /* message ID (argument) */ ms_id) bit (72) aligned; /* message ID (internal) */ dcl (authorization, /* authorization of calling process */ access_class) bit (72) aligned; /* access class of message segment */ dcl privileges bit (36) aligned; /* privileges of calling process */ dcl 1 based_priv unal based (addr (privileges)) like aim_template.privileges; dcl ( alloc_len, /* length of allocation bit string */ level, /* user level: 0 = non-own entry, 1 = own entry (internal) */ ms_word_len, /* length of message in words */ htx, /* hash table index */ id_len) fixed bin; /* length of person-project portion of group id */ dcl ( a_code, /* error code (argument) */ code /* error code (internal) */ ) fixed bin (35); dcl (addr, addrel, bit, divide, fixed, index, null, ptr, rel, size, substr) builtin; dcl ( area, cleanup ) condition; dcl area_array area (30) aligned based (area_ptr), /* for allocating */ ms_word_array (ms_word_len) fixed bin aligned based (ret_ptr); dcl (caller_id, /* id of caller */ ms_sender_id) char (32) aligned; /* id of message sender */ dcl proc_name char (32); /* procedure name */ dcl reason char (40); /* reason why operation failed */ dcl bit_copy_mask bit (copy_size) based; /* bit copy mask */ dcl bits (copy_size) bit (1) based unaligned; /* for resetting copy-to pointer */ dcl 1 return_args aligned based (arg_ptr), /* return argument structure */ 2 ms_ptr ptr, /* pointer to message */ 2 ms_len fixed bin (18), /* length of message in bits */ 2 sender_id char (32), /* person-project ID of message sender */ 2 level fixed bin, /* validation level of sender */ 2 ms_id bit (72), /* unique ID of message */ 2 sender_authorization bit (72), /* access authorization of message sender */ 2 access_class bit (72); /* message access class */ % include mseg_hdr_v3; % include ms_block_hdr_v3; % include ms_block_trailer_v3; % include aim_template; dcl error_table_$bad_segment ext fixed bin (35); dcl error_table_$ai_restricted ext fixed bin (35); dcl error_table_$no_message ext fixed bin (35); dcl error_table_$inconsistent ext fixed bin (35); dcl error_table_$bigarg ext fixed bin (35); dcl error_table_$noalloc ext fixed bin (35); dcl get_group_id_$tag_star ext entry returns (char (32) aligned); dcl get_authorization_ ext entry returns (bit (72) aligned); dcl get_privileges_ ext entry returns (bit (36) aligned); dcl hcs_$get_access_class_seg ext entry (ptr, bit (72) aligned, fixed bin (35)); dcl mseg_error_v3_ entry options (variable); dcl read_allowed_ ext entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl read_write_allowed_ ext entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); /* */ read: entry (a_mptr, a_area_ptr, a_first_or_last, a_arg_ptr, a_own, a_code); proc_name = "mseg_util_$read"; first_or_last = a_first_or_last; area_ptr = a_area_ptr; read = "1"b; go to COMMON; delete: entry (a_mptr, a_ms_id, a_own, a_code); proc_name = "mseg_util_$delete"; ms_id = a_ms_id; delete = "1"b; go to COMMON; read_and_delete: entry (a_mptr, a_area_ptr, a_first_or_last, a_arg_ptr, a_own, a_code); proc_name = "mseg_util_$read_and_delete"; first_or_last = a_first_or_last; area_ptr = a_area_ptr; read, delete = "1"b; go to COMMON; incremental_read: entry (a_mptr, a_area_ptr, a_dir, a_ms_id, a_arg_ptr, a_own, a_code); proc_name = "mseg_util_$incremental_read"; ms_id = a_ms_id; dir = a_dir; if dir = "11"b then do; /* undefined */ code = error_table_$inconsistent; go to FIN; end; area_ptr = a_area_ptr; incr_read = "1"b; go to COMMON; update: entry (a_mptr, a_ms_ptr, a_ms_len, a_ms_id, a_own, a_code); proc_name = "mseg_util_$update"; update = "1"b; ms_id = a_ms_id; go to COMMON; get_count: entry (a_mptr, a_count, a_code); proc_name = "mseg_util_$get_count"; get_count = "1"b; own = "0"b; go to COMMON2; /* */ COMMON: own = a_own; COMMON2: mptr = a_mptr; code = 0; search_sw = "0"b; ms_count = /* get number of messages */ fixed (mptr -> mseg_hdr.number_of_messages, 18); block_size = fixed (mseg_hdr.block_size, 18); /* pick out block size from header */ tr_offset = block_size - size (ms_block_trailer); /* calculate trailer offset */ /* See if first or last message wanted */ if get_count then go to COUNT; /* start counting with first message */ if read then do; /* read first or last message */ if first_or_last = "1"b /* last message wanted */ then do; dir = "10"b; /* prepare to scan backward */ LAST: loc = fixed (mptr -> mseg_hdr.last_ms_offset, 18); /* get offset of last message */ end; else do; /* first message wanted */ COUNT: dir = "01"b; /* prepare to scan forward */ FIRST: loc = fixed (mptr -> mseg_hdr.first_ms_offset, 18); /* get offset of first message */ end; if delete then do; ms_ptr = ptr (mptr, loc); tr_ptr = addrel (ms_ptr, tr_offset); ms_id = tr_ptr -> ms_block_trailer.ms_id; go to THREAD; end; end; /* look up message ID in hash table */ else do; /* for incr read, update ; delete */ THREAD: htx = fixed (substr (ms_id, 64, 9)); /* hash table index = low 9 bits of message ID */ loc = fixed (hash_table.last_in_bucket (htx), 18); /* get loc of last message in bucket */ prev_in_bucket_ptr = null; /* no previous message yet */ do while (loc ^= 0); /* search bucket for matching message ID */ ms_ptr = ptr (mptr, loc); /* get ptr to first block of message */ if ^ms_ptr -> ms_block_hdr.first_block /* check if really first block */ then do; reason = "not first block in hash lookup"; go to BAD_SEG; end; tr_ptr = addrel (ms_ptr, tr_offset); /* get trailer ptr */ if tr_ptr -> ms_block_trailer.tr_pattern ^= trailer_pattern /* check pattern */ then do; reason = "bad trailer pattern in hash lookup"; go to BAD_SEG; end; if tr_ptr -> ms_block_trailer.ms_id = ms_id /* found it */ then go to FOUND_ID; prev_in_bucket_ptr = tr_ptr; /* remember ptr to this message */ loc = fixed (tr_ptr -> ms_block_trailer.back_in_bucket, 18); /* go back one in bucket */ end; if incr_read then if dir ^= "00"b then do; /* forward or backward incr read */ search_sw = "1"b; /* search for next message even though this message is gone */ if dir = "10"b then go to LAST; /* search for largest message id < ms_id */ else go to FIRST; /* search for smallest message id > ms_id */ end; go to NO_MSG; /* bucket exhausted */ FOUND_ID: end; /* prepare to check access */ authorization = get_authorization_ (); /* get caller's authorization */ privileges = get_privileges_ (); /* get caller's privileges */ mseg_priv = based_priv.ring1; /* get ring 1 privilege flag */ if own /* caller can only reference his own message */ then do; caller_id = get_group_id_$tag_star (); /* get caller's goup id */ id_len = index (caller_id, ".*"); /* find index of the ".*" tag */ end; /* get_count */ if get_count then do; if mseg_priv /* caller has privileged access */ then do; FULL_COUNT: a_count = ms_count; /* return full count */ go to FIN; end; call hcs_$get_access_class_seg (mptr, access_class, code); /* get message seg access class */ if code ^= 0 then go to FIN; if read_allowed_ (authorization, access_class) /* caller is authorized to see all messages */ then go to FULL_COUNT; /* return full count */ count = 0; /* initialize count */ go to READ; /* get count of read-accessible messages */ end; /* incremental read */ else if search_sw then go to READ; else if incr_read then do; if own /* must be caller's own message */ then if substr (ms_block_trailer.sender_id, 1, id_len) ^= substr (caller_id, 1, id_len) /* not his own */ then go to NO_MSG; /* pretend it doesn't exist */ if ^mseg_priv /* no special access privilege */ then if ^read_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) /* no read permit */ then go to NO_MSG; /* pretend it doesn't exist */ if dir = "10"b /* previous message wanted */ then do; /* increment message pointer */ if tr_ptr -> ms_block_trailer.b_offset = "0"b then do; /* error, no previous message */ if fixed (mseg_hdr.first_ms_offset, 18) ^= loc then do; reason = "bad first offset"; go to BAD_SEG; end; NO_MSG: code = error_table_$no_message; go to FIN; end; loc = fixed (tr_ptr -> ms_block_trailer.b_offset, 18); go to READ; end; else if dir = "01"b /* next message wanted */ then do; /* increment message pointer */ if tr_ptr -> ms_block_trailer.f_offset = "0"b then do; /* error, no next message */ if fixed (mseg_hdr.last_ms_offset, 18) ^= loc then do; reason = "bad last offset"; go to BAD_SEG; end; go to NO_MSG; end; loc = fixed (tr_ptr -> ms_block_trailer.f_offset, 18); go to READ; end; end; /* read */ else if read then do; READ: do while (loc ^= 0); /* scan for read-accessible message */ ms_ptr = ptr (mptr, loc); /* get ptr to first block of message */ if ^ms_ptr -> ms_block_hdr.first_block /* check if really first block */ then do; reason = "not first block"; go to BAD_SEG; end; tr_ptr = addrel (ms_ptr, tr_offset); /* get trailer ptr */ if tr_ptr -> ms_block_trailer.tr_pattern ^= trailer_pattern /* check pattern */ then do; reason = "bad trailer pattern"; go to BAD_SEG; end; if own /* must be caller's own message */ then if substr (ms_block_trailer.sender_id, 1, id_len) ^= substr (caller_id, 1, id_len) /* not his own */ then go to NEXT; /* skip it */ if ^mseg_priv /* no special access privileges */ then do; if ^read_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) /* no read permit */ then go to NEXT; /* skip over this one */ if delete /* read and delete requested */ then if ^read_write_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) then go to AI_ERR; /* cannot delete this message */ end; if get_count /* get_count entry */ then count = count + 1; /* increment count of read-accessible messages */ else if search_sw then if dir = "01"b then if substr (tr_ptr -> ms_block_trailer.ms_id, 19, 54) > substr (ms_id, 19, 54) then go to EXIT; /* found the one we're searching for */ else go to NEXT; else if substr (tr_ptr -> ms_block_trailer.ms_id, 19, 54) < substr (ms_id, 19, 54) then go to EXIT; /* found it */ else go to NEXT; else go to EXIT; /* found a message to read, exit loop */ NEXT: if dir = "01"b /* scanning forward */ then loc = fixed (tr_ptr -> ms_block_trailer.f_offset, 18); /* get loc of next message */ else loc = fixed (tr_ptr -> ms_block_trailer.b_offset, 18); /* get loc of previous message */ end; if get_count /* we're finished counting */ then do; a_count = count; go to FIN; end; go to NO_MSG; /* couldn't find anything to read */ EXIT: end; /* update or delete */ else if update | delete then do; if own /* must be caller's own message */ then if substr (ms_block_trailer.sender_id, 1, id_len) ^= substr (caller_id, 1, id_len) /* not his own */ then go to NO_MSG; /* pretend it doesn't exist */ if ^mseg_priv /* no special access privilege */ then if ^read_write_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) /* no read-write permit */ then if ^read_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) /* not even read permit */ then go to NO_MSG; /* pretend it doesn't exist */ else do; /* caller has read permit, but not modify */ AI_ERR: code = error_table_$ai_restricted; go to FIN; end; end; /* prepare to perform requested operation */ ms_len = fixed (ms_block_trailer.ms_size, 18); /* pick out message size */ if update then do; update_len = a_ms_len; if update_len > ms_len /* incorrect message size specified */ then do; code = error_table_$bigarg; /* user message too big */ go to FIN; end; t_ptr = a_ms_ptr; /* initialize copy ptr */ end; if delete then do; if fixed (mptr -> mseg_hdr.first_ms_offset, 18) = loc /* first message */ then first = "1"b; /* set flag to remember */ else first = "0"b; if fixed (mptr -> mseg_hdr.last_ms_offset, 18) = loc /* last message */ then last = "1"b; /* set flag to remember */ else last = "0"b; if (^first) then do; /* not first message */ prev_offset = /* get offset to previous message */ fixed (tr_ptr -> ms_block_trailer.b_offset, 18); prev_tr_ptr = /* make pointer to previous trailer */ ptr (mptr, prev_offset+tr_offset); end; if (^last) then do; /* not last message */ next_offset = /* get offset to next message */ fixed (tr_ptr -> ms_block_trailer.f_offset, 18); next_tr_ptr = /* make pointer to next trailer */ ptr (mptr, next_offset+tr_offset); end; back_in_bucket_offset = tr_ptr -> ms_block_trailer.back_in_bucket; delete_size = block_size * 36; /* the block size in bits */ alloc_len = mptr -> mseg_hdr.alloc_len; /* a local copy of the number of allocation bits */ end; if read | incr_read then do; ms_sender_id = tr_ptr -> ms_block_trailer.sender_id; /* pick out senders' id */ level = fixed (ms_block_trailer.ring_no, 17); /* pick out validation level */ ms_id = tr_ptr -> ms_block_trailer.ms_id; /* pick out message id */ authorization = tr_ptr -> ms_block_trailer.sender_authorization; /* pick out sender authorization */ access_class = tr_ptr -> ms_block_trailer.access_class; /* pick out message access class */ /* allocate an area for the returned message */ on cleanup begin; /* establish cleanup handler to free allocated message */ if ret_ptr ^= null /* a message was allocated */ then do; free ms_word_array in (area_array); /* free it */ a_arg_ptr -> return_args.ms_ptr = null; /* and return null argument ptr */ end; end; on area begin; code = error_table_$noalloc; go to FIN; end; ms_word_len = divide (ms_len+35, 36, 17, 0); /* compute word length from bit count */ allocate ms_word_array in (area_array) set (ret_ptr); /* allocate the area */ t_ptr = ret_ptr; /* initialize scan pointer */ end; /* */ /* chase the message thread */ found_ms_len = 0; /* initialize size of found message */ blocks_in_message = 0; /* initialize count */ block_ptr = ms_ptr; /* initialize block pointer */ ms_end = "0"b; /* initialize end of message flag */ if delete /* user is deleting a message */ then mseg_hdr.mip = "1"b; /* turn on mip bit */ do while (^ms_end); blocks_in_message = /* increment message block count */ blocks_in_message + 1; found_ms_len = found_ms_len + fixed (ms_block_hdr.block_count, 18); /* increment message size */ if found_ms_len > ms_len /* more message than block trailer specified */ then do; /* error in message segment */ reason = "message too long"; go to BAD_SEG; end; if (read | incr_read | update) then do; /* return message for reading */ copy_size = /* set size of copy mask */ fixed (block_ptr -> ms_block_hdr.block_count, 18); if update then do; /* updating message */ if found_ms_len > update_len then do; /* update only part of this block */ copy_size = copy_size - (found_ms_len - update_len); ms_end = "1"b; end; addrel (block_ptr, size (ms_block_hdr)) -> bit_copy_mask = t_ptr -> bit_copy_mask; /* overwrite */ end; else /* reading message */ t_ptr -> bit_copy_mask = /* copy message */ addrel (block_ptr, size (ms_block_hdr)) -> bit_copy_mask; t_ptr = addr (t_ptr -> bits (copy_size + 1)); /* increment copy ptr */ end; if (delete) then do; /* user is deleting a message */ bit_off = divide (fixed (rel (block_ptr), 18), block_size, 18, 0)+1; /* calculate alloc bit for block */ if substr (mseg_hdr.alloc_bits, bit_off, 1) = "0"b /* block not in use */ then do; reason = "unprotected block"; go to BAD_SEG; end; else substr (mseg_hdr.alloc_bits, bit_off, 1) = "0"b; /* turn bit off */ deletep = block_ptr; /* remember block ptr to delete later */ end; if ^ms_end then if block_ptr -> ms_block_hdr.f_offset = "0"b then do; /* message block is last in message */ if found_ms_len ^= ms_len /* found size doesn't agree with trailer */ then do; reason = "bad message length"; go to BAD_SEG; end; else ms_end = "1"b; /* indicate end of message */ end; else do; block_ptr = /* step the block pointer */ ptr (block_ptr, fixed (block_ptr -> ms_block_hdr.f_offset, 18)); end; if (delete) /* message is being deleted */ then do; copy_size = delete_size; /* set size of copy mask */ deletep -> bit_copy_mask = "0"b; /* use mask to zero out block */ end; end; /* */ /* finish deleting message if requested */ if (delete) then do; if ms_count > 1 /* there will be a remaining message */ then do; /* unthread the message */ if (first) then do; /* unthread first message */ mptr -> mseg_hdr.first_ms_offset = bit (fixed (next_offset, 18), 18); /* reset header offset to new first message */ next_tr_ptr -> ms_block_trailer.b_offset = "0"b; /* reset new first message back pointer */ end; if (last) then do; /* unthread last message */ mptr -> mseg_hdr.last_ms_offset = bit (fixed (prev_offset, 18), 18); /* reset header offset to new last message */ prev_tr_ptr -> ms_block_trailer.f_offset = "0"b; /* reset new last message forward pointer */ end; if (^first) then if (^last) then do; /* unthread mid message */ prev_tr_ptr -> ms_block_trailer.f_offset = bit (fixed (next_offset, 18), 18); /* reset forward offset of previous message */ next_tr_ptr -> ms_block_trailer.b_offset = bit (fixed (prev_offset, 18), 18); /* reset backward offset of next message */ end; end; else /* no messages left */ mseg_hdr.first_ms_offset, /* zero out hdr pointers */ mseg_hdr.last_ms_offset = "0"b; /* rethread the hash bucket */ if prev_in_bucket_ptr = null then hash_table.last_in_bucket (htx) = back_in_bucket_offset; else prev_in_bucket_ptr -> ms_block_trailer.back_in_bucket = back_in_bucket_offset; /* update header after deletion */ mptr -> mseg_hdr.space_left = /* reset space left */ mptr -> mseg_hdr.space_left + blocks_in_message; ms_count = ms_count - 1; mptr -> mseg_hdr.number_of_messages = /* reset number of messages */ fixed (ms_count); mptr -> mseg_hdr.mip = "0"b; /* turn off modification in progress bit */ end; if read | incr_read then do; /* fill in return argument structure */ arg_ptr = a_arg_ptr; /* copy ptr to return_args structure */ return_args.ms_ptr = ret_ptr; /* ptr to message */ return_args.ms_len = ms_len; /* length of message */ return_args.sender_id = ms_sender_id; /* person-project ID of message sender */ return_args.level = level; /* validation level of message sender */ return_args.ms_id = ms_id; /* message ID */ return_args.sender_authorization = authorization; /* authorization of message sender */ return_args.access_class = access_class; /* access class of message */ end; FIN: a_code = code; return; BAD_SEG: call mseg_error_v3_ (mptr, 0, proc_name, reason); code = error_table_$bad_segment; go to FIN; end mseg_util_v3_;  mseg_util_v4_.pl1 05/09/85 1152.2r w 05/06/85 1619.0 231840 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ mseg_util_v4_: proc; /* Modified for version 3 message segments by J. Stern, 10/22/74 */ /* Modified to use mseg_error_ by J. Stern, 11/12/75 */ /* Modified for "o" operations to test only Person_id 12/18/79 S. Herbst */ /* Modified 3/77 by Charlie Davis for the installation of version 4 message segments */ /* Modified: February 1983 by G. Palter for privileged entries used by compacting */ /* Modified: 84-05-07 BIM for get_process_authorization_ instead of get_authorization_ */ /* Modified: August 1984 by G. Palter to fix message segment error #0004 -- If a user's access to a mailbox or message segment includes read (r) and own (o) but not delete (d) permission, mailbox_$delete_index, message_segment_$delete_index, and message_segment_$delete_file will return error_table_$no_message when asked to delete a message not created by the user. Since, in this case, the user can determine which messages exist in the segment, these entrypoints should return error_table_$moderr to indicate that the user doesn't have permission to delete the message */ dcl (a_mptr, /* pointer to the message segment */ prev_tr_ptr, /* pointer to previous message trailer */ next_tr_ptr, /* pointer to next message trailer */ prev_in_bucket_ptr, /* pointer to previous message in hash bucket */ ms_ptr, /* pointer to message wanted */ ret_ptr init (null), deletep, /* pointer to block to be zeroed out */ a_arg_ptr, /* pointer to return_arg structure (argument) */ arg_ptr, /* pointer to return_arg structure (internal) */ t_ptr, /* scan pointer for returning message */ a_area_ptr, /* pointer to allocated area */ a_ms_ptr, /* pointer to updating message */ area_ptr) ptr; dcl (read init ("0"b), /* ON for read or read and delete entry */ incr_read init ("0"b), /* ON for incremental read entry */ delete init ("0"b), /* ON for delete or read and delete entry */ update init ("0"b), /* ON for update entry */ get_count init ("0"b), /* ON for get_count entry */ priv_entry init ("0"b), /* ON for privileged read entrypoint */ mseg_priv, /* ON if calling process has privileged access */ a_own, /* ON if reading own message (argument) */ own, /* ON if reading own message (internal) */ a_read_access, /* ON if user has read access to the segment (argument) */ read_access init ("0"b), /* ON if user has read access to the segment (internal) */ last, /* ON if message is last in segment */ first, /* ON if message is first in segment */ search_sw, /* ON if message id not found for incremental reading */ ms_end) bit (1) aligned; /* ON when end of message is found */ dcl back_in_bucket_offset bit (18) aligned; /* offset of message one back in hash bucket */ dcl (tr_offset, /* offset from beginning of block to trailer */ ms_count, /* number of messages in segment */ a_count, /* message count (argument) */ count, /* message count (internal) */ prev_offset, /* offset to previous message */ next_offset, /* offset to next message */ block_size, /* size of a message block */ blocks_in_message, /* number of blocks used for message */ update_len, /* size of update message */ loc, bit_off) fixed bin (18); /* location of allocation bit to be turned off */ dcl ( copy_size, /* size of bit copy mask */ delete_size, /* bit size of block to be zeroed out */ a_ms_len, /* length of message in block trailer */ ms_len, found_ms_len /* actual message size */ ) fixed bin (24); dcl (a_first_or_last, /* ON if last message wanted (argument) */ first_or_last) bit (1) aligned; /* ON if last message wanted (internal) */ dcl (a_dir, /* direction of incremental search */ dir init ("00"b)) bit (2) aligned; dcl (a_ms_id, /* message ID (argument) */ ms_id) bit (72) aligned; /* message ID (internal) */ dcl (authorization, /* authorization of calling process */ access_class) bit (72) aligned; /* access class of message segment */ dcl privileges bit (36) aligned; /* privileges of calling process */ dcl 1 based_priv unal based (addr (privileges)) like aim_template.privileges; dcl ( alloc_len, /* length of allocation bit string */ level, /* user level: 0 = non-own entry, 1 = own entry (internal) */ ms_word_len, /* length of message in words */ htx, /* hash table index */ id_len) fixed bin; /* length of person-project portion of group id */ dcl ( a_code, /* error code (argument) */ code /* error code (internal) */ ) fixed bin (35); dcl (addr, addrel, bit, divide, fixed, index, length, null, ptr, rel, rtrim, size, substr) builtin; dcl ( area, cleanup ) condition; dcl area_array area (30) aligned based (area_ptr), /* for allocating */ ms_word_array (ms_word_len) fixed bin aligned based (ret_ptr); dcl (caller_id, /* id of caller */ ms_sender_id) char (32); /* id of message sender */ dcl proc_name char (32); /* procedure name */ dcl reason char (40); /* reason why operation failed */ dcl bit_copy_mask bit (copy_size) based; /* bit copy mask */ dcl bits (copy_size) bit (1) based unaligned; /* for resetting copy-to pointer */ dcl 1 return_args aligned based (arg_ptr), /* return argument structure */ 2 ms_ptr ptr, /* pointer to message */ 2 ms_len fixed bin (18), /* length of message in bits */ 2 sender_id char (32), /* person-project ID of message sender */ 2 level fixed bin, /* validation level of sender */ 2 ms_id bit (72), /* unique ID of message */ 2 sender_authorization bit (72), /* access authorization of message sender */ 2 access_class bit (72); /* message access class */ %include mseg_hdr_v4; declare mptr pointer; %include ms_block_hdr_v4; %include ms_block_trailer_v4; %include aim_template; dcl error_table_$bad_segment ext fixed bin (35); dcl error_table_$ai_restricted ext fixed bin (35); dcl error_table_$moderr fixed binary (35) external; dcl error_table_$no_message ext fixed bin (35); dcl error_table_$inconsistent ext fixed bin (35); dcl error_table_$bigarg ext fixed bin (35); dcl error_table_$noalloc ext fixed bin (35); dcl get_group_id_$tag_star entry() returns(char(32)); dcl get_process_authorization_ ext entry returns (bit (72) aligned); dcl get_privileges_ ext entry returns (bit (36) aligned); dcl hcs_$get_access_class_seg ext entry (ptr, bit (72) aligned, fixed bin (35)); dcl mseg_error_v4_ entry options (variable); dcl read_allowed_ ext entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl read_write_allowed_ ext entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); /* */ read_priv: entry (a_mptr, a_area_ptr, a_first_or_last, a_arg_ptr, a_own, a_code); proc_name = "mseg_util_v4_$read_priv"; priv_entry = "1"b; go to R_COMMON; read: entry (a_mptr, a_area_ptr, a_first_or_last, a_arg_ptr, a_own, a_code); proc_name = "mseg_util_v4_$read"; R_COMMON: first_or_last = a_first_or_last; area_ptr = a_area_ptr; read = "1"b; go to COMMON; delete: entry (a_mptr, a_ms_id, a_own, a_read_access, a_code); proc_name = "mseg_util_v4_$delete"; ms_id = a_ms_id; delete = "1"b; read_access = a_read_access; go to COMMON; read_and_delete: entry (a_mptr, a_area_ptr, a_first_or_last, a_arg_ptr, a_own, a_code); proc_name = "mseg_util_v4_$read_and_delete"; first_or_last = a_first_or_last; area_ptr = a_area_ptr; read, delete = "1"b; go to COMMON; incremental_read_priv: entry (a_mptr, a_area_ptr, a_dir, a_ms_id, a_arg_ptr, a_own, a_code); proc_name = "mseg_util_v4_$incremental_read_priv"; priv_entry = "1"b; go to IR_COMMON; incremental_read: entry (a_mptr, a_area_ptr, a_dir, a_ms_id, a_arg_ptr, a_own, a_code); proc_name = "mseg_util_v4_$incremental_read"; IR_COMMON: ms_id = a_ms_id; dir = a_dir; if dir = "11"b then do; /* undefined */ code = error_table_$inconsistent; go to FIN; end; area_ptr = a_area_ptr; incr_read = "1"b; go to COMMON; update: entry (a_mptr, a_ms_ptr, a_ms_len, a_ms_id, a_own, a_read_access, a_code); proc_name = "mseg_util_v4_$update"; update = "1"b; ms_id = a_ms_id; read_access = a_read_access; go to COMMON; get_count: entry (a_mptr, a_count, a_code); proc_name = "mseg_util_v4_$get_count"; get_count = "1"b; own = "0"b; go to COMMON2; /* */ COMMON: own = a_own; COMMON2: mptr = a_mptr; code = 0; search_sw = "0"b; ms_count = /* get number of messages */ fixed (mptr -> mseg_hdr_v4.number_of_messages, 18); block_size = fixed (mptr -> mseg_hdr_v4.block_size, 18); /* pick out block size from header */ tr_offset = block_size - size (ms_block_trailer); /* calculate trailer offset */ /* See if first or last message wanted */ if get_count then go to COUNT; /* start counting with first message */ if read then do; /* read first or last message */ if first_or_last = "1"b /* last message wanted */ then do; dir = "10"b; /* prepare to scan backward */ LAST: loc = fixed (mptr -> mseg_hdr_v4.last_ms_offset, 18); /* get offset of last message */ end; else do; /* first message wanted */ COUNT: dir = "01"b; /* prepare to scan forward */ FIRST: loc = fixed (mptr -> mseg_hdr_v4.first_ms_offset, 18); /* get offset of first message */ end; if delete then do; ms_ptr = ptr (mptr, loc); tr_ptr = addrel (ms_ptr, tr_offset); ms_id = tr_ptr -> ms_block_trailer.ms_id; go to THREAD; end; end; /* look up message ID in hash table */ else do; /* for incr read, update ; delete */ THREAD: htx = fixed (substr (ms_id, 64, 9)); /* hash table index = low 9 bits of message ID */ loc = fixed (mptr -> mseg_hdr_v4.hash_table.last_in_bucket (htx), 18); /* get loc of last message in bucket */ prev_in_bucket_ptr = null; /* no previous message yet */ do while (loc ^= 0); /* search bucket for matching message ID */ ms_ptr = ptr (mptr, loc); /* get ptr to first block of message */ if ^ms_ptr -> ms_block_hdr.first_block /* check if really first block */ then do; reason = "not first block in hash lookup"; go to BAD_SEG; end; tr_ptr = addrel (ms_ptr, tr_offset); /* get trailer ptr */ if tr_ptr -> ms_block_trailer.tr_pattern ^= trailer_pattern /* check pattern */ then do; reason = "bad trailer pattern in hash lookup"; go to BAD_SEG; end; if tr_ptr -> ms_block_trailer.ms_id = ms_id /* found it */ then go to FOUND_ID; prev_in_bucket_ptr = tr_ptr; /* remember ptr to this message */ loc = fixed (tr_ptr -> ms_block_trailer.back_in_bucket, 18); /* go back one in bucket */ end; if incr_read then if dir ^= "00"b then do; /* forward or backward incr read */ search_sw = "1"b; /* search for next message even though this message is gone */ if dir = "10"b then go to LAST; /* search for largest message id < ms_id */ else go to FIRST; /* search for smallest message id > ms_id */ end; go to NO_MSG; /* bucket exhausted */ FOUND_ID: end; /* prepare to check access */ authorization = get_process_authorization_ (); /* get caller's authorization */ privileges = get_privileges_ (); /* get caller's privileges */ mseg_priv = based_priv.ring1 | priv_entry; /* get ring 1 privilege flag */ if own /* caller can only reference his own message */ then do; caller_id = get_group_id_$tag_star (); /* get caller's group id */ if substr (caller_id, 1, 10) = "anonymous." then id_len = length (rtrim (caller_id)) - 1; /* ignore .* tag for anonymous */ else id_len = index (caller_id, "."); /* others: compare only Person_id */ end; /* get_count */ if get_count then do; if mseg_priv /* caller has privileged access */ then do; FULL_COUNT: a_count = ms_count; /* return full count */ go to FIN; end; call hcs_$get_access_class_seg (mptr, access_class, code); /* get message seg access class */ if code ^= 0 then go to FIN; if read_allowed_ (authorization, access_class) /* caller is authorized to see all messages */ then go to FULL_COUNT; /* return full count */ count = 0; /* initialize count */ go to READ; /* get count of read-accessible messages */ end; /* incremental read */ else if search_sw then go to READ; else if incr_read then do; if own /* must be caller's own message */ then if substr (ms_block_trailer.sender_id, 1, id_len) ^= substr (caller_id, 1, id_len) /* not his own */ then go to NO_MSG; /* pretend it doesn't exist */ if ^mseg_priv /* no special access privilege */ then if ^read_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) /* no read permit */ then go to NO_MSG; /* pretend it doesn't exist */ if dir = "10"b /* previous message wanted */ then do; /* increment message pointer */ if tr_ptr -> ms_block_trailer.b_offset = "0"b then do; /* error, no previous message */ if fixed (mptr -> mseg_hdr_v4.first_ms_offset, 18) ^= loc then do; reason = "bad first offset"; go to BAD_SEG; end; NO_MSG: code = error_table_$no_message; go to FIN; end; loc = fixed (tr_ptr -> ms_block_trailer.b_offset, 18); go to READ; end; else if dir = "01"b /* next message wanted */ then do; /* increment message pointer */ if tr_ptr -> ms_block_trailer.f_offset = "0"b then do; /* error, no next message */ if fixed (mptr -> mseg_hdr_v4.last_ms_offset, 18) ^= loc then do; reason = "bad last offset"; go to BAD_SEG; end; go to NO_MSG; end; loc = fixed (tr_ptr -> ms_block_trailer.f_offset, 18); go to READ; end; end; /* read */ else if read then do; READ: do while (loc ^= 0); /* scan for read-accessible message */ ms_ptr = ptr (mptr, loc); /* get ptr to first block of message */ if ^ms_ptr -> ms_block_hdr.first_block /* check if really first block */ then do; reason = "not first block"; go to BAD_SEG; end; tr_ptr = addrel (ms_ptr, tr_offset); /* get trailer ptr */ if tr_ptr -> ms_block_trailer.tr_pattern ^= trailer_pattern /* check pattern */ then do; reason = "bad trailer pattern"; go to BAD_SEG; end; if own /* must be caller's own message */ then if substr (ms_block_trailer.sender_id, 1, id_len) ^= substr (caller_id, 1, id_len) /* not his own */ then go to NEXT; /* skip it */ if ^mseg_priv /* no special access privileges */ then do; if ^read_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) /* no read permit */ then go to NEXT; /* skip over this one */ if delete /* read and delete requested */ then if ^read_write_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) then go to AI_ERR; /* cannot delete this message */ end; if get_count /* get_count entry */ then count = count + 1; /* increment count of read-accessible messages */ else if search_sw then if dir = "01"b then if substr (tr_ptr -> ms_block_trailer.ms_id, 19, 54) > substr (ms_id, 19, 54) then go to EXIT; /* found the one we're searching for */ else go to NEXT; else if substr (tr_ptr -> ms_block_trailer.ms_id, 19, 54) < substr (ms_id, 19, 54) then go to EXIT; /* found it */ else go to NEXT; else go to EXIT; /* found a message to read, exit loop */ NEXT: if dir = "01"b /* scanning forward */ then loc = fixed (tr_ptr -> ms_block_trailer.f_offset, 18); /* get loc of next message */ else loc = fixed (tr_ptr -> ms_block_trailer.b_offset, 18); /* get loc of previous message */ end; if get_count /* we're finished counting */ then do; a_count = count; go to FIN; end; go to NO_MSG; /* couldn't find anything to read */ EXIT: end; /* update or delete */ else if update | delete then do; if own /* must be caller's own message */ then if substr (ms_block_trailer.sender_id, 1, id_len) ^= substr (caller_id, 1, id_len) /* not his own */ then if read_access then do; /* caller is allowed to know the message is present */ code = error_table_$moderr; go to FIN; end; else go to NO_MSG; /* pretend it doesn't exist */ if ^mseg_priv /* no special access privilege */ then if ^read_write_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) /* no read-write permit */ then if ^read_allowed_ (authorization, tr_ptr -> ms_block_trailer.access_class) /* not even read permit */ then go to NO_MSG; /* pretend it doesn't exist */ else do; /* caller has read permit, but not modify */ AI_ERR: code = error_table_$ai_restricted; go to FIN; end; end; /* prepare to perform requested operation */ ms_len = fixed (ms_block_trailer.ms_size, 24); /* pick out message size */ if update then do; update_len = a_ms_len; if update_len > ms_len /* incorrect message size specified */ then do; code = error_table_$bigarg; /* user message too big */ go to FIN; end; t_ptr = a_ms_ptr; /* initialize copy ptr */ end; if delete then do; if fixed (mptr -> mseg_hdr_v4.first_ms_offset, 18) = loc /* first message */ then first = "1"b; /* set flag to remember */ else first = "0"b; if fixed (mptr -> mseg_hdr_v4.last_ms_offset, 18) = loc /* last message */ then last = "1"b; /* set flag to remember */ else last = "0"b; if (^first) then do; /* not first message */ prev_offset = /* get offset to previous message */ fixed (tr_ptr -> ms_block_trailer.b_offset, 18); prev_tr_ptr = /* make pointer to previous trailer */ ptr (mptr, prev_offset+tr_offset); end; if (^last) then do; /* not last message */ next_offset = /* get offset to next message */ fixed (tr_ptr -> ms_block_trailer.f_offset, 18); next_tr_ptr = /* make pointer to next trailer */ ptr (mptr, next_offset+tr_offset); end; back_in_bucket_offset = tr_ptr -> ms_block_trailer.back_in_bucket; delete_size = block_size * 36; /* the block size in bits */ alloc_len = mptr -> mseg_hdr_v4.alloc_len; /* a local copy of the number of allocation bits */ end; if read | incr_read then do; ms_sender_id = tr_ptr -> ms_block_trailer.sender_id; /* pick out senders' id */ level = fixed (ms_block_trailer.ring_no, 17); /* pick out validation level */ ms_id = tr_ptr -> ms_block_trailer.ms_id; /* pick out message id */ authorization = tr_ptr -> ms_block_trailer.sender_authorization; /* pick out sender authorization */ access_class = tr_ptr -> ms_block_trailer.access_class; /* pick out message access class */ /* allocate an area for the returned message */ on cleanup begin; /* establish cleanup handler to free allocated message */ if ret_ptr ^= null /* a message was allocated */ then do; free ms_word_array in (area_array); /* free it */ a_arg_ptr -> return_args.ms_ptr = null; /* and return null argument ptr */ end; end; on area begin; code = error_table_$noalloc; go to FIN; end; ms_word_len = divide (ms_len+35, 36, 17, 0); /* compute word length from bit count */ allocate ms_word_array in (area_array) set (ret_ptr); /* allocate the area */ t_ptr = ret_ptr; /* initialize scan pointer */ end; /* */ /* chase the message thread */ found_ms_len = 0; /* initialize size of found message */ blocks_in_message = 0; /* initialize count */ block_ptr = ms_ptr; /* initialize block pointer */ ms_end = "0"b; /* initialize end of message flag */ if delete /* user is deleting a message */ then mptr -> mseg_hdr_v4.mip = "1"b; /* turn on mip bit */ do while (^ms_end); blocks_in_message = /* increment message block count */ blocks_in_message + 1; found_ms_len = found_ms_len + fixed (ms_block_hdr.block_count, 24); /* increment message size */ if found_ms_len > ms_len /* more message than block trailer specified */ then do; /* error in message segment */ reason = "message too long"; go to BAD_SEG; end; if (read | incr_read | update) then do; /* return message for reading */ copy_size = /* set size of copy mask */ fixed (block_ptr -> ms_block_hdr.block_count, 24); if update then do; /* updating message */ if found_ms_len > update_len then do; /* update only part of this block */ copy_size = copy_size - (found_ms_len - update_len); ms_end = "1"b; end; addrel (block_ptr, size (ms_block_hdr)) -> bit_copy_mask = t_ptr -> bit_copy_mask; /* overwrite */ end; else /* reading message */ t_ptr -> bit_copy_mask = /* copy message */ addrel (block_ptr, size (ms_block_hdr)) -> bit_copy_mask; t_ptr = addr (t_ptr -> bits (copy_size + 1)); /* increment copy ptr */ end; if (delete) then do; /* user is deleting a message */ bit_off = divide (fixed (rel (block_ptr), 18), block_size, 18, 0)+1; /* calculate alloc bit for block */ if substr (mptr -> mseg_hdr_v4.alloc_bits, bit_off, 1) = "0"b /* block not in use */ then do; reason = "unprotected block"; go to BAD_SEG; end; else substr (mptr -> mseg_hdr_v4.alloc_bits, bit_off, 1) = "0"b; /* turn bit off */ deletep = block_ptr; /* remember block ptr to delete later */ end; if ^ms_end then if block_ptr -> ms_block_hdr.f_offset = "0"b then do; /* message block is last in message */ if found_ms_len ^= ms_len /* found size doesn't agree with trailer */ then do; reason = "bad message length"; go to BAD_SEG; end; else ms_end = "1"b; /* indicate end of message */ end; else do; block_ptr = /* step the block pointer */ ptr (block_ptr, fixed (block_ptr -> ms_block_hdr.f_offset, 18)); end; if (delete) /* message is being deleted */ then do; copy_size = delete_size; /* set size of copy mask */ deletep -> bit_copy_mask = "0"b; /* use mask to zero out block */ end; end; /* */ /* finish deleting message if requested */ if (delete) then do; if ms_count > 1 /* there will be a remaining message */ then do; /* unthread the message */ if (first) then do; /* unthread first message */ mptr -> mseg_hdr_v4.first_ms_offset = bit (fixed (next_offset, 18), 18); /* reset header offset to new first message */ next_tr_ptr -> ms_block_trailer.b_offset = "0"b; /* reset new first message back pointer */ end; if (last) then do; /* unthread last message */ mptr -> mseg_hdr_v4.last_ms_offset = bit (fixed (prev_offset, 18), 18); /* reset header offset to new last message */ prev_tr_ptr -> ms_block_trailer.f_offset = "0"b; /* reset new last message forward pointer */ end; if (^first) then if (^last) then do; /* unthread mid message */ prev_tr_ptr -> ms_block_trailer.f_offset = bit (fixed (next_offset, 18), 18); /* reset forward offset of previous message */ next_tr_ptr -> ms_block_trailer.b_offset = bit (fixed (prev_offset, 18), 18); /* reset backward offset of next message */ end; end; else /* no messages left */ mptr -> mseg_hdr_v4.first_ms_offset, /* zero out hdr pointers */ mptr -> mseg_hdr_v4.last_ms_offset = "0"b; /* rethread the hash bucket */ if prev_in_bucket_ptr = null then mptr -> mseg_hdr_v4.hash_table.last_in_bucket (htx) = back_in_bucket_offset; else prev_in_bucket_ptr -> ms_block_trailer.back_in_bucket = back_in_bucket_offset; /* update header after deletion */ mptr -> mseg_hdr_v4.space_left = /* reset space left */ mptr -> mseg_hdr_v4.space_left + blocks_in_message; ms_count = ms_count - 1; mptr -> mseg_hdr_v4.number_of_messages = /* reset number of messages */ fixed (ms_count); mptr -> mseg_hdr_v4.mip = "0"b; /* turn off modification in progress bit */ end; if read | incr_read then do; /* fill in return argument structure */ arg_ptr = a_arg_ptr; /* copy ptr to return_args structure */ return_args.ms_ptr = ret_ptr; /* ptr to message */ return_args.ms_len = ms_len; /* length of message */ return_args.sender_id = ms_sender_id; /* person-project ID of message sender */ return_args.level = level; /* validation level of message sender */ return_args.ms_id = ms_id; /* message ID */ return_args.sender_authorization = authorization; /* authorization of message sender */ return_args.access_class = access_class; /* access class of message */ end; FIN: a_code = code; return; BAD_SEG: call mseg_error_v4_ (mptr, 0, proc_name, reason); code = error_table_$bad_segment; go to FIN; end mseg_util_v4_;  ptr_is_good_v2_.pl1 05/10/85 0857.4r w 05/06/85 1619.0 28818 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ %; /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ ptr_is_good_v2_ : proc (a_test_ptr) returns (bit (1) aligned); /* Adapted from the original version 2 ptr_is_good_ by J. Stern, 11/4/74 */ dcl (alloc_len internal static, /* length of allocation bits */ a_block_size, /* given block size for salvager entry */ block_size, /* size of message block */ hdr_alloc_len, /* length of header allocation bits */ i, /* computation variable */ message_begin, /* first legal beginning loc for message */ offset, /* offset of given pointer */ seg_size internal static) fixed bin (18); dcl code fixed bin (35); dcl (a_test_ptr, /* pointer to be validated (argument) */ test_ptr) ptr; /* pointer to be validated (internal) */ dcl ( a_flag, /* ON if pointer is valid (argument) */ flag init ("0"b), salvager_entry init ("0"b) ) bit (1) aligned; /* ON if pointer is valid (internal) */ dcl hcs_$get_max_length_seg entry (ptr, fixed bin (18), fixed bin (35)); dcl (addr, divide, fixed, mod, ptr, rel) builtin; % include mseg_hdr_v2; /* */ go to COMMON; ms_salvager_entry: entry (a_test_ptr, a_block_size) returns (bit (1) aligned); salvager_entry = "1"b; COMMON: /* copy argument */ test_ptr = a_test_ptr; /* create offset from pointer */ offset = fixed (rel (test_ptr), 18); /* create message segment ptr */ mptr = ptr (test_ptr, 0); if salvager_entry /* get proper block size */ then block_size = a_block_size; else block_size = mptr -> mseg_hdr_v2.block_size; /* check block size, compute needed variables */ if block_size <= 0 then go to fin; call hcs_$get_max_length_seg (mptr, seg_size, code); if code ^= 0 then go to fin; alloc_len = divide (seg_size, block_size, 18, 0); i = divide (36* (fixed (rel (addr (mptr -> mseg_hdr_v2.hdr_ms_end)), 18) + 1)+alloc_len+35, 36, 18, 0); hdr_alloc_len = divide (i+block_size-1, block_size, 18, 0); message_begin = fixed (rel (addr (mptr -> mseg_hdr_v2.hdr_ms.hdr_ms_end)))+hdr_alloc_len+1; /* validate message pointer */ if offset >= message_begin /* pointer is past header */ then if offset <= seg_size - block_size /* pointer is not off end of segment */ then if mod (offset, block_size) = 0 /* pointer points to block boundary */ then flag = "1"b; /* pointer is o.k. */ fin: a_flag = flag; /* return test indicator */ return (a_flag); end ptr_is_good_v2_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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