/* BEGIN INCLUDE FILE - dm_comp_vec_str_proc.incl.pl1 */ /* DESCRIPTION: This program compares the value of a simple_typed_vector and a key. It is responsible for "parsing" the key bit string into its constituent fields, using the information provided by the field_table. Dimension I of the simple_typed_vector is assumed to be the same field as field I of the key. The comparison is done a-field-at-a-time, starting with field 1 and continuing with field 2, field 3, etc. until either an inequality is found or all of the fields have been compared. Global variables are assumed to be in the main procedure so as to simulate the calling sequence: call COMPARE_VECTOR_TO_STRING (cvs_p_field_table_ptr, cvs_p_simple_typed_vector_ptr, cvs_p_key_string_ptr, cvs_p_key_string_length, cvs_p_last_field_idx, cvs_p_first_inequal_field_id, cvs_p_vector_equal_to_key, cvs_p_vector_less_than_key, cvs_p_code); They must be declared as follows described under Parameters. */ /* HISTORY: Written by Matthew Pierret, 04/19/84. (Extracted from dmu_compare_vector_to_str.pl1.) Modified: 05/03/84 by Matthew Pierret: Changed to FIELD_TABLE_VERSION_3. 12/07/84 by M. Sharpe: to correct format and dcls. */ /****^ HISTORY COMMENTS: 1) change(86-12-17,Dupuis), approve(87-04-01,MCR7632), audit(87-01-13,Blair), install(87-04-02,MR12.1-1020): Corrected a bug (phx20420) where the cvs_location_of_first_varying_field was being set incorrectly when it was a bit varying or char varying field, and all of the fields weren't present. END HISTORY COMMENTS */ /* format: style2,ind3 */ %page; COMPARE_VECTOR_TO_STRING: proc (); /* START OF DECLARATIONS */ /* Parameter */ /* dcl cvs_p_field_table_ptr ptr; /* points to a field_table dcl cvs_p_simple_typed_vector_ptr /* points to the simple_typed_vector ptr; /* to be compared with ... dcl cvs_p_key_string_ptr ptr; /* (points to) the string dcl cvs_p_key_string_length fixed bin (24); /* length of the string in bits dcl cvs_p_last_field_idx fixed bin (17); /* the index of the last field /* contained in the string. This last /* field have a truncated value. If /* this is -1, all fields are present /* in full form. dcl cvs_p_first_inequal_field_id fixed bin (17); /* is set by this routine to be the id /* of the first field which did not /* compare equal. dcl cvs_p_vector_equal_to_key bit (1) aligned; /* is set by this routine to ON if the /* vector and string are equal. dcl cvs_p_vector_less_than_key bit (1) aligned; /* is set by this routine to ON if the /* vector is less than the key dcl cvs_p_code fixed bin (35); */ /* Automatic */ dcl cv_p_code fixed bin (35); dcl cv_p_descriptor_ptr ptr; dcl cv_p_field_value_length fixed bin (35); dcl cv_p_field_value_ptr ptr; dcl cv_p_vector_equal_to_key bit (1) aligned; dcl cv_p_vector_less_than_key bit (1) aligned; dcl cv_p_vector_value_length fixed bin (35); dcl cv_p_vector_value_ptr ptr; dcl cvs_current_field_id fixed bin (35); dcl cvs_field_idx fixed bin; dcl cvs_field_value_offset fixed bin (24); dcl cvs_key_string_length fixed bin (35); dcl cvs_key_string_ptr ptr; dcl cvs_last_field_idx fixed bin; dcl cvs_last_field_is_truncated bit (1) aligned init ("0"b); dcl cvs_last_field_length_in_bits fixed bin (35); dcl cvs_last_field_length_ptr ptr; dcl cvs_last_field_value_ptr ptr; dcl cvs_length_field_length fixed bin (35); dcl cvs_length_field_ptr ptr; dcl cvs_location_of_first_varying_field fixed bin (35); dcl cvs_maximum_field_idx fixed bin (17); dcl 1 cvs_truncated_field_descriptor like arg_descriptor; dcl cvs_varying_field_idx fixed bin; dcl cvs_varying_field_value_offset fixed bin (24); /* Based */ dcl cvs_based_real_fix_bin_1u based fixed bin (35) unaligned; dcl cvs_key_string based (cvs_key_string_ptr) bit (cvs_key_string_length); dcl cvs_length_field_string based (cvs_length_field_ptr) bit (cvs_length_field_length); /* Builtin */ dcl (addbitno, addr, bin, hbound, min, null) builtin; /* Controlled */ /* Constant */ dcl ( BITS_PER_WORD init (36), BITS_PER_BYTE init (9), BYTES_PER_WORD init (4) ) internal static options (constant) fixed bin (17); dcl VECTOR_VALUE_IS_IN_VECTOR_FORMAT init ("0"b) bit (1) aligned internal static options (constant); /* Entry */ dcl sub_err_ entry () options (variable); /* External */ dcl error_table_$unimplemented_version fixed bin (35) ext; /* END OF DECLARATIONS */ cvs_key_string_ptr = cvs_p_key_string_ptr; cvs_key_string_length = cvs_p_key_string_length; cvs_last_field_idx = cvs_p_last_field_idx; simple_typed_vector_ptr = cvs_p_simple_typed_vector_ptr; if simple_typed_vector.type ^= SIMPLE_TYPED_VECTOR_TYPE then call sub_err_ (error_table_$unimplemented_version, myname, ACTION_CANT_RESTART, null, 0, "^/Expected the simple_typed_vector structure, type ^d;^/Received type ^d instead.", SIMPLE_TYPED_VECTOR_TYPE, simple_typed_vector.type); field_table_ptr = cvs_p_field_table_ptr; if field_table.version ^= FIELD_TABLE_VERSION_3 then call sub_err_ (error_table_$unimplemented_version, myname, ACTION_CANT_RESTART, null, 0, "^/Expected version ^a of the field_table structure;^/Received ^a instead.", FIELD_TABLE_VERSION_3, field_table.version); cv_p_code = 0; cv_p_vector_equal_to_key = "1"b; cv_p_vector_less_than_key = "0"b; if cvs_last_field_idx = -1 /* not truncated */ then do; cvs_maximum_field_idx = min (hbound (simple_typed_vector.dimension, 1), hbound (field_table.field, 1)); cvs_location_of_first_varying_field = field_table.location_of_first_varying_field; cvs_last_field_is_truncated = "0"b; end; else if cvs_last_field_idx > 0 then do; cvs_maximum_field_idx = min (cvs_last_field_idx, hbound (simple_typed_vector.dimension, 1)); arg_descriptor_ptr = addr (field_table.field (cvs_last_field_idx).descriptor); if (arg_descriptor.type = varying_char_dtype) | (arg_descriptor.type = varying_bit_dtype) then cvs_last_field_is_truncated = "0"b; else if arg_descriptor.type = bit_dtype then do; if arg_descriptor.size > BITS_PER_WORD + BITS_PER_BYTE then do; cvs_last_field_length_ptr = addbitno (cvs_key_string_ptr, field_table.field (cvs_last_field_idx).location - 1); cvs_last_field_value_ptr = addbitno (cvs_last_field_length_ptr, BITS_PER_WORD); cvs_truncated_field_descriptor.packed = "1"b; cvs_truncated_field_descriptor.flag = "1"b; cvs_truncated_field_descriptor.type = bit_dtype; cvs_truncated_field_descriptor.size = cvs_last_field_length_ptr -> cvs_based_real_fix_bin_1u; cvs_last_field_length_in_bits = cvs_truncated_field_descriptor.size + BITS_PER_WORD; cvs_last_field_is_truncated = "1"b; end; end; else if arg_descriptor.type = char_dtype then do; if arg_descriptor.size > BYTES_PER_WORD + 1 then do; cvs_last_field_length_ptr = addbitno (cvs_key_string_ptr, field_table.field (cvs_last_field_idx).location - 1); cvs_last_field_value_ptr = addbitno (cvs_last_field_length_ptr, BITS_PER_WORD); cvs_truncated_field_descriptor.packed = "1"b; cvs_truncated_field_descriptor.flag = "1"b; cvs_truncated_field_descriptor.type = char_dtype; cvs_truncated_field_descriptor.size = cvs_last_field_length_ptr -> cvs_based_real_fix_bin_1u; cvs_last_field_length_in_bits = cvs_truncated_field_descriptor.size * BITS_PER_BYTE + BITS_PER_WORD; cvs_last_field_is_truncated = "1"b; end; end; else cvs_last_field_is_truncated = "0"b; if cvs_last_field_is_truncated then cvs_location_of_first_varying_field = field_table.field (cvs_last_field_idx).location + cvs_last_field_length_in_bits; else cvs_location_of_first_varying_field = field_table.location_of_first_varying_field; end; cvs_varying_field_value_offset = cvs_location_of_first_varying_field - 1; /* 1 is subtracted because locations are */ /* 1-based, offsets are 0-based. */ FIELD_LOOP: do cvs_field_idx = 1 to cvs_maximum_field_idx while (cv_p_code = 0 & cv_p_vector_equal_to_key); if cvs_last_field_is_truncated & cvs_field_idx = cvs_last_field_idx then do; cv_p_field_value_ptr = cvs_last_field_value_ptr; cv_p_field_value_length = -1; cv_p_descriptor_ptr = addr (cvs_truncated_field_descriptor); end; else do; cv_p_descriptor_ptr = addr (field_table.field (cvs_field_idx).descriptor); /* Is field varying or non-varying? */ if ^(cv_p_descriptor_ptr -> arg_descriptor.type = varying_char_dtype | cv_p_descriptor_ptr -> arg_descriptor.type = varying_bit_dtype) then PREPARE_NONVARYING_FIELD: do; cv_p_field_value_length = -1; cv_p_field_value_ptr = addbitno (cvs_key_string_ptr, field_table.field (cvs_field_idx).location - 1); end PREPARE_NONVARYING_FIELD; else PREPARE_VARYING_FIELD: do; cvs_length_field_length = field_table.field (cvs_field_idx).length_in_bits; cvs_length_field_ptr = addbitno (cvs_key_string_ptr, field_table.field (cvs_field_idx).location - 1); cv_p_field_value_length = bin (cvs_length_field_string, 35, 0); cvs_field_value_offset = cvs_varying_field_value_offset; if field_table.field (cvs_field_idx).flags.length_is_in_characters then cvs_varying_field_value_offset = cvs_varying_field_value_offset + cv_p_field_value_length * BITS_PER_BYTE; else cvs_varying_field_value_offset = cvs_varying_field_value_offset + cv_p_field_value_length; cv_p_field_value_ptr = addbitno (cvs_key_string_ptr, cvs_field_value_offset); end PREPARE_VARYING_FIELD; end; cv_p_vector_value_ptr = simple_typed_vector.dimension (cvs_field_idx).value_ptr; cv_p_vector_value_length = -1; /* length is only needed if vector is in field format */ call COMPARE_VALUES (VECTOR_VALUE_IS_IN_VECTOR_FORMAT); /* Actually uses global variables to simulate: call COMPARE_VALUES (VECTOR_VALUE_IS_IN_VECTOR_FORMAT, cv_p_descriptor_ptr, cv_p_vector_value_ptr, cv_p_field_value_ptr, cv_p_field_value_length, cv_p_vector_equal_to_key, cv_p_vector_less_than_key, cv_p_code); */ if cv_p_vector_equal_to_key then if cvs_last_field_is_truncated & cvs_field_idx = cvs_last_field_idx then if cvs_truncated_field_descriptor.size < arg_descriptor.size then cv_p_vector_equal_to_key = "0"b; end FIELD_LOOP; cvs_p_first_inequal_field_id = cvs_field_idx - bin (^cv_p_vector_equal_to_key); if cvs_maximum_field_idx < hbound (simple_typed_vector.dimension, 1) then cvs_p_vector_equal_to_key = "0"b; /* The vector is longer than the key, so the */ /* comparison cannot be equal. */ else cvs_p_vector_equal_to_key = cv_p_vector_equal_to_key; cvs_p_vector_less_than_key = cv_p_vector_less_than_key; cvs_p_code = cv_p_code; return; %page; %include dm_comp_values_proc; %page; %include dm_field_table; %page; %include vu_typed_vector; %page; %include arg_descriptor; %page; %include std_descriptor_types; %page; %include sub_err_flags; end COMPARE_VECTOR_TO_STRING; /* END INCLUDE FILE - dm_comp_vec_str_proc.incl.pl1 */ */ ----------------------------------------------------------- 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 */