COMPILATION LISTING OF SEGMENT rmdb_rq_create_attribute Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 10/16/86 1334.2 mst Thu Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1985 * 4* * * 5* *********************************************************** */ 6 7 /* format: ^inddcls,^indattr,indnoniterend,^indnoniterdo,indend,tree,^case,insnl,comcol61,dclind5,declareind5,delnl */ 8 9 /*DESCRIPTION 10* This routine parses command arguments for the create_attribute rmdb 11* request. 12**/ 13 14 /****^ HISTORY COMMENTS: 15* 1) change(85-12-03,Spitzer), approve(85-12-03,MCR7311), 16* audit(86-09-02,Blair), install(86-10-16,MR12.0-1187): 17* written. 18* END HISTORY COMMENTS */ 19 20 rmdb_rq_create_attribute: 21 proc (Isci_ptr, Iinfo_ptr); 22 23 /* Initialize values */ 24 25 sci_ptr = Isci_ptr; 26 rmdb_ctl_ptr = Iinfo_ptr; 27 28 /* Determine the number of arguments. There must be an even number. */ 29 30 call ssu_$arg_count (sci_ptr, nargs); 31 if (nargs = 0) | (mod (nargs, 2) ^= 0) 32 then call ssu_$abort_line (sci_ptr, error_table_$wrong_no_of_args, 33 "^/Usage:^/^-^a attribute1 domain1 {...attributeN domainN}", myname); 34 35 /* Create the structure that contains the attributes to create */ 36 37 create_attr_info_count = mod (nargs, 2); 38 allocate create_attr_info in (my_area) set (create_attr_info_ptr); 39 40 /* Check to see if we have an open database */ 41 42 if rmdb_ctl.absolute_db_path = "" 43 then call ssu_$abort_line (sci_ptr, error_table_$action_not_performed, 44 "^/There is no currently readied database."); 45 46 /* Check to see if the database is consistent. If not, we must make it 47*consistent before we can create new attributes. Note that if for some reason 48*the database is not made consistent rmdb_execute_undo will not return, it 49*will either cause a request line or subsystem abort.*/ 50 51 call mdbm_util_$inconsistent_get_info (rmdb_ctl.db_model_ptr, incon_value, incon_name, unused2, undo_request); 52 if incon_value 53 then call rmdb_execute_undo (sci_ptr, "create_attribute", rmdb_ctl.absolute_db_path, rmdb_ctl.db_model_ptr, 54 incon_name, undo_request); 55 56 /* Fill in our structure */ 57 58 create_attr_info.version = create_attr_info_version_1; 59 create_attr_info.count = divide (nargs, 2, 17, 0); 60 attribute_index = 1; 61 62 do loop = 1 to nargs by 2; 63 call ssu_$arg_ptr (sci_ptr, loop, argp, argl); 64 65 if argl > 32 66 then call ssu_$abort_line (sci_ptr, error_table_$bigarg, 67 "^/The maximum length of attribute names is 32 characters. ^a", arg); 68 if verify (arg, mrds_data_$valid_rel_and_attr_name_chars) ^= 0 69 then call ssu_$abort_line (sci_ptr, mrds_error_$bad_ident, "^a", arg); 70 if search (substr (arg, 1, 1), "_-0123456789") ^= 0 71 then call ssu_$abort_line (sci_ptr, mrds_error_$inv_attr_name_first_char, "^a", arg); 72 73 create_attr_info.attribute (attribute_index).name = arg; 74 75 call ssu_$arg_ptr (sci_ptr, loop + 1, argp, argl); 76 if argl > 32 77 then call ssu_$abort_line (sci_ptr, error_table_$bigarg, 78 "^/The maximum length of domain names is 32 characters. ^a", arg); 79 if verify (arg, mrds_data_$valid_rel_and_attr_name_chars) ^= 0 80 then call ssu_$abort_line (sci_ptr, mrds_error_$bad_ident, "^a", arg); 81 if search (substr (arg, 1, 1), "_-0123456789") ^= 0 82 then call ssu_$abort_line (sci_ptr, mrds_error_$inv_domain_name_first_char, "^a", arg); 83 84 create_attr_info.attribute (attribute_index).domain = arg; 85 86 attribute_index = attribute_index + 1; 87 end; /* do loop */ 88 89 /* Check for duplicate attributes to create */ 90 91 do loop = 1 to create_attr_info.count-1; 92 do inner_loop = loop + 1 to create_attr_info.count; 93 if create_attr_info.attribute (loop).name = create_attr_info.attribute (inner_loop).name 94 then call ssu_$abort_line (sci_ptr, mrds_error_$attr_already_exists, "^a", create_attr_info.attribute (inner_loop).name); 95 end; /* do inner_loop */ 96 end; /* do loop */ 97 98 /* Do the actual attribute creation */ 99 100 call rmdb_create_attribute (rmdb_ctl_ptr, create_attr_info_ptr, error_message, code); 101 if code ^= 0 102 then call ssu_$abort_line (sci_ptr, code, "^a", error_message); 103 104 return; 105 1 1 /* BEGIN - mrds_rmdb_ctl.incl.pl1 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(82-03-26,Davids), approve(), audit(), install(): 1 7* created 1 8* 2) change(82-05-26,Davids), approve(), audit(), install(): 1 9* added db_model_ptr 1 10* 3) change(82-06-09,Harvey), approve(), audit(), install(): 1 11* deleted ssu_ routines ptr storage 1 12* 4) change(82-08-20,Davids), approve(), audit(), install(): 1 13* added the relmgr like reference and included the rmdb_relmgr_entries 1 14* include file 1 15* 5) change(83-05-24,Davids), approve(), audit(), install(): 1 16* added the saved_res_version_ptr element 1 17* 6) change(84-10-23,Benjamin), approve(), audit(), install(): 1 18* added flags (just database_readied_by_rmdb for now). 1 19* 7) change(85-11-08,Spitzer), approve(85-11-08,MCR7311), 1 20* audit(86-09-02,Blair), install(86-10-16,MR12.0-1187): 1 21* added crossref_file_info. 1 22* END HISTORY COMMENTS */ 1 23 1 24 1 25 dcl 01 rmdb_ctl based (rmdb_ctl_ptr), 1 26 02 version fixed bin, 1 27 02 rmdb_version char (16) varying, 1 28 02 absolute_db_path char (168), 1 29 02 temp_dir_path char (168), 1 30 02 work_area_ptr ptr, 1 31 02 db_model_ptr ptr, 1 32 02 saved_res_version_ptr ptr, 1 33 02 crossref_file_info, 1 34 03 iocb_ptr ptr, 1 35 03 name char (32), 1 36 02 relmgr_entries like rmdb_relmgr_entries, 1 37 02 flags, 1 38 03 database_readied_by_rmdb bit (1) unal, 1 39 03 unused bit (35) unal; 1 40 1 41 dcl RMDB_CTL_VERSION_1 fixed bin init (1) internal static options (constant); 1 42 1 43 dcl rmdb_ctl_ptr ptr; 1 44 1 45 2 1 /* START OF: rmdb_relmgr_entries.incl.pl1 * * * * * * * * * * * * * * * * */ 2 2 2 3 2 4 /****^ HISTORY COMMENTS: 2 5* 1) change(82-08-20,Davids), approve(), audit(), install(): 2 6* written 2 7* 2) change(86-01-28,Spitzer), approve(86-01-28,MCR7311), 2 8* audit(86-09-15,Gilcrease), install(86-10-16,MR12.0-1187): 2 9* add get_tuples_by_spec, put_tuple, put_tuples, create_cursor entry points. 2 10* 3) change(86-08-21,Blair), approve(86-08-21,MCR7311), 2 11* audit(86-09-15,Gilcrease), install(86-10-16,MR12.0-1187): 2 12* Back out the entries get_tuples_by_spec and put_tuples since they aren't 2 13* sufficiently well tested to be reliable. Replace with get_tuple_id and 2 14* get_tuple_by_id. 2 15* END HISTORY COMMENTS */ 2 16 2 17 2 18 dcl 01 rmdb_relmgr_entries based (rmdb_relmgr_entries_ptr), 2 19 02 create_relation entry (char (*), char (*), ptr, ptr, bit (36) aligned, 2 20 bit (36) aligned, fixed bin (35)), 2 21 02 delete_relation entry (char (*), char (*), fixed bin (35)), 2 22 02 open entry (char (*), char (*), bit (36) aligned, fixed bin (35)), 2 23 02 close entry (bit (36) aligned, fixed bin (35)), 2 24 02 create_index entry (bit (36) aligned, ptr, bit (36) aligned, fixed bin (17), 2 25 bit (36) aligned, fixed bin (35)), 2 26 02 delete_index entry (bit (36) aligned, bit (36) aligned, fixed bin (35)), 2 27 02 put_tuple entry (ptr, ptr, bit (36) aligned, fixed bin (35)), 2 28 02 get_tuple_id entry (ptr, ptr, ptr, ptr, fixed bin (35)), 2 29 02 get_tuple_by_id entry (ptr, bit (36) aligned, ptr, ptr, ptr, fixed bin (35)), 2 30 02 create_cursor entry (bit (36) aligned, ptr, ptr, fixed bin (35)); 2 31 2 32 dcl rmdb_relmgr_entries_ptr ptr; 2 33 2 34 /* END OF: rmdb_relmgr_entries.incl.pl1 * * * * * * * * * * * * * * * * */ 1 46 1 47 1 48 1 49 /* END - mrds_rmdb_ctl.incl.pl1 */ 106 3 1 /* START OF: rmdb_create_attr_info.incl.pl1 * * * * * * * * * * * * * * * * */ 3 2 3 3 3 4 /****^ HISTORY COMMENTS: 3 5* 1) change(85-12-03,Spitzer), approve(85-12-03,MCR7311), 3 6* audit(86-09-02,Blair), install(86-10-16,MR12.0-1187): 3 7* Contains a list of attributes to create 3 8* END HISTORY COMMENTS */ 3 9 3 10 dcl create_attr_info_count fixed bin (17); 3 11 dcl create_attr_info_ptr ptr; 3 12 dcl create_attr_info_version_1 char (8) int static options (constant) init ("cai 1.0"); 3 13 3 14 dcl 1 create_attr_info based (create_attr_info_ptr), 3 15 2 version char (8), 3 16 2 count fixed bin (17), 3 17 2 attribute (create_attr_info_count refer (create_attr_info.count)), 3 18 3 name char (32), 3 19 3 domain char (32); 3 20 3 21 /* END OF: rmdb_create_attr_info.incl.pl1 * * * * * * * * * * * * * * * * */ 107 108 109 dcl arg char (argl) based (argp); /* command line argument */ 110 dcl argl fixed bin (21); 111 dcl argp ptr; 112 dcl attribute_index fixed bin; /* loop index */ 113 dcl code fixed bin (35); 114 dcl divide builtin; 115 dcl empty builtin; 116 dcl error_message char (500); 117 dcl error_table_$action_not_performed fixed bin (35) ext static; 118 dcl error_table_$bigarg fixed bin (35) ext static; 119 dcl error_table_$wrong_no_of_args fixed bin (35) ext static; 120 dcl incon_name char (32); /* name of the request that caused the db to become inconsistent */ 121 dcl incon_value bit (1); /* true ::= the db is inconsistent */ 122 dcl Iinfo_ptr ptr; 123 dcl inner_loop fixed bin (17); /* loop index */ 124 dcl Isci_ptr ptr; 125 dcl loop fixed bin; /* loop index */ 126 dcl mdbm_util_$inconsistent_get_info entry (ptr, bit (1), char (*), char (*), char (*)); 127 dcl mod builtin; 128 dcl mrds_data_$valid_rel_and_attr_name_chars char (128) ext static; 129 dcl mrds_error_$attr_already_exists fixed bin(35) ext static; 130 dcl mrds_error_$bad_ident fixed bin(35) ext static; 131 dcl mrds_error_$inv_attr_name_first_char fixed bin(35) ext static; 132 dcl mrds_error_$inv_domain_name_first_char fixed bin(35) ext static; 133 dcl my_area area; /* small area to allocate in */ 134 dcl myname char (32) int static options (constant) init ("create_attribute"); 135 dcl nargs fixed bin; 136 dcl rmdb_create_attribute entry (ptr, ptr, char (*), fixed bin (35)); 137 dcl rmdb_execute_undo entry (ptr, char (32), char (168), ptr, char (32), char (100)); 138 dcl sci_ptr ptr; 139 dcl search builtin; 140 dcl ssu_$abort_line entry () options (variable); 141 dcl ssu_$arg_count entry (ptr, fixed bin); 142 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); 143 dcl substr builtin; 144 dcl undo_request char (100); /* rmdb request that will cause the db to become consistent */ 145 dcl unused2 char (200); /* output from mdbm_util_$inconsistent_get_info */ 146 dcl verify builtin; 147 148 end rmdb_rq_create_attribute; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/16/86 1144.1 rmdb_rq_create_attribute.pl1 >special_ldd>install>MR12.0-1187>rmdb_rq_create_attribute.pl1 106 1 10/16/86 1139.6 mrds_rmdb_ctl.incl.pl1 >special_ldd>install>MR12.0-1187>mrds_rmdb_ctl.incl.pl1 1-46 2 10/16/86 1140.2 rmdb_relmgr_entries.incl.pl1 >special_ldd>install>MR12.0-1187>rmdb_relmgr_entries.incl.pl1 107 3 10/16/86 1139.5 rmdb_create_attr_info.incl.pl1 >special_ldd>install>MR12.0-1187>rmdb_create_attr_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. Iinfo_ptr parameter pointer dcl 122 ref 20 26 Isci_ptr parameter pointer dcl 124 ref 20 25 absolute_db_path 6 based char(168) level 2 packed unaligned dcl 1-25 set ref 42 52* arg based char unaligned dcl 109 set ref 65* 68 68* 70 70* 73 76* 79 79* 81 81* 84 argl 000106 automatic fixed bin(21,0) dcl 110 set ref 63* 65 65 65 68 68 68 70 70 70 73 75* 76 76 76 79 79 79 81 81 81 84 argp 000110 automatic pointer dcl 111 set ref 63* 65 68 68 70 70 73 75* 76 79 79 81 81 84 attribute 3 based structure array level 2 packed unaligned dcl 3-14 attribute_index 000112 automatic fixed bin(17,0) dcl 112 set ref 60* 73 84 86* 86 code 000113 automatic fixed bin(35,0) dcl 113 set ref 100* 101 101* count 2 based fixed bin(17,0) level 2 dcl 3-14 set ref 38* 59* 91 92 create_attr_info based structure level 1 unaligned dcl 3-14 set ref 38 create_attr_info_count 000102 automatic fixed bin(17,0) dcl 3-10 set ref 37* 38 38 create_attr_info_ptr 000104 automatic pointer dcl 3-11 set ref 38* 58 59 73 84 91 92 93 93 93 100* create_attr_info_version_1 000010 constant char(8) initial unaligned dcl 3-12 ref 58 db_model_ptr 134 based pointer level 2 dcl 1-25 set ref 51* 52* divide builtin function dcl 114 ref 59 domain 13 based char(32) array level 3 packed unaligned dcl 3-14 set ref 84* empty builtin function dcl 115 ref 133 error_message 000114 automatic char(500) unaligned dcl 116 set ref 100* 101* error_table_$action_not_performed 000010 external static fixed bin(35,0) dcl 117 set ref 42* error_table_$bigarg 000012 external static fixed bin(35,0) dcl 118 set ref 65* 76* error_table_$wrong_no_of_args 000014 external static fixed bin(35,0) dcl 119 set ref 31* incon_name 000311 automatic char(32) unaligned dcl 120 set ref 51* 52* incon_value 000321 automatic bit(1) unaligned dcl 121 set ref 51* 52 inner_loop 000322 automatic fixed bin(17,0) dcl 123 set ref 92* 93 93* loop 000323 automatic fixed bin(17,0) dcl 125 set ref 62* 63* 75* 91* 92 93* mdbm_util_$inconsistent_get_info 000016 constant entry external dcl 126 ref 51 mod builtin function dcl 127 ref 31 37 mrds_data_$valid_rel_and_attr_name_chars 000020 external static char(128) unaligned dcl 128 ref 68 79 mrds_error_$attr_already_exists 000022 external static fixed bin(35,0) dcl 129 set ref 93* mrds_error_$bad_ident 000024 external static fixed bin(35,0) dcl 130 set ref 68* 79* mrds_error_$inv_attr_name_first_char 000026 external static fixed bin(35,0) dcl 131 set ref 70* mrds_error_$inv_domain_name_first_char 000030 external static fixed bin(35,0) dcl 132 set ref 81* my_area 000324 automatic area(1024) dcl 133 set ref 38 133* myname 000000 constant char(32) initial unaligned dcl 134 set ref 31* name 3 based char(32) array level 3 packed unaligned dcl 3-14 set ref 73* 93 93 93* nargs 002324 automatic fixed bin(17,0) dcl 135 set ref 30* 31 31 37 59 62 rmdb_create_attribute 000032 constant entry external dcl 136 ref 100 rmdb_ctl based structure level 1 unaligned dcl 1-25 rmdb_ctl_ptr 000100 automatic pointer dcl 1-43 set ref 26* 42 51 52 52 100* rmdb_execute_undo 000034 constant entry external dcl 137 ref 52 rmdb_relmgr_entries based structure level 1 unaligned dcl 2-18 sci_ptr 002326 automatic pointer dcl 138 set ref 25* 30* 31* 42* 52* 63* 65* 68* 70* 75* 76* 79* 81* 93* 101* search builtin function dcl 139 ref 70 81 ssu_$abort_line 000036 constant entry external dcl 140 ref 31 42 65 68 70 76 79 81 93 101 ssu_$arg_count 000040 constant entry external dcl 141 ref 30 ssu_$arg_ptr 000042 constant entry external dcl 142 ref 63 75 substr builtin function dcl 143 ref 70 81 undo_request 002330 automatic char(100) unaligned dcl 144 set ref 51* 52* unused2 002361 automatic char(200) unaligned dcl 145 set ref 51* verify builtin function dcl 146 ref 68 79 version based char(8) level 2 packed unaligned dcl 3-14 set ref 58* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. RMDB_CTL_VERSION_1 internal static fixed bin(17,0) initial dcl 1-41 rmdb_relmgr_entries_ptr automatic pointer dcl 2-32 NAME DECLARED BY EXPLICIT CONTEXT. rmdb_rq_create_attribute 000131 constant entry external dcl 20 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1356 1422 1131 1366 Length 1722 1131 44 263 225 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME rmdb_rq_create_attribute 1382 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME rmdb_rq_create_attribute 000100 rmdb_ctl_ptr rmdb_rq_create_attribute 000102 create_attr_info_count rmdb_rq_create_attribute 000104 create_attr_info_ptr rmdb_rq_create_attribute 000106 argl rmdb_rq_create_attribute 000110 argp rmdb_rq_create_attribute 000112 attribute_index rmdb_rq_create_attribute 000113 code rmdb_rq_create_attribute 000114 error_message rmdb_rq_create_attribute 000311 incon_name rmdb_rq_create_attribute 000321 incon_value rmdb_rq_create_attribute 000322 inner_loop rmdb_rq_create_attribute 000323 loop rmdb_rq_create_attribute 000324 my_area rmdb_rq_create_attribute 002324 nargs rmdb_rq_create_attribute 002326 sci_ptr rmdb_rq_create_attribute 002330 undo_request rmdb_rq_create_attribute 002361 unused2 rmdb_rq_create_attribute THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return_mac mdfx1 ext_entry verify_eis op_alloc_ op_empty_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. mdbm_util_$inconsistent_get_info rmdb_create_attribute rmdb_execute_undo ssu_$abort_line ssu_$arg_count ssu_$arg_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed error_table_$bigarg error_table_$wrong_no_of_args mrds_data_$valid_rel_and_attr_name_chars mrds_error_$attr_already_exists mrds_error_$bad_ident mrds_error_$inv_attr_name_first_char mrds_error_$inv_domain_name_first_char LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 20 000125 133 000136 25 000141 26 000145 30 000150 31 000161 37 000221 38 000223 42 000234 51 000265 52 000317 58 000347 59 000353 60 000356 62 000360 63 000367 65 000404 68 000441 70 000501 73 000544 75 000555 76 000576 79 000633 81 000673 84 000736 86 000746 87 000747 91 000752 92 000763 93 000775 95 001046 96 001050 100 001052 101 001076 104 001127 ----------------------------------------------------------- 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