COMPILATION LISTING OF SEGMENT tape_mult_parse_ Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 1003.1 mst Sat Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 /****^ HISTORY COMMENTS: 14* 1) change(87-01-08,GDixon), approve(87-03-30,MCR7643), 15* audit(87-03-31,Farley), install(87-04-28,MR12.1-1028): 16* Add support for -device attach option, to specify the tape device on which 17* to mount the tape. 18* END HISTORY COMMENTS */ 19 20 21 /* format: style4,delnl,insnl,indattr,ifthen,dclind9 */ 22 tape_mult_parse_: 23 procedure (arg_tmdb_ptr, arg_dev_name, arg_options, arg_com_err_sw, arg_error_code); 24 25 /* This program is part of the Multics standard tape I/O module, tape_mult_. 26* * 27* * Created on 10/24/74 by Bill Silver. 28* * Modified 4/79 by R.J.C. Kissel to handle 6250 bpi. 29* * Modified 1/2/81 by J. A. Bush for bootable tape_labels 30* * Modified 1/7/82 by J. A. Bush for the "-error_tally" att. desc arg 31* * Modified 8/82 by S. Krupp for change from tdcm_ to tape_ioi_ interface. 32* * 33* * This program is called to parse the attach options accepted by tape_mult_. 34* * It will set up all of the attach option defaults. The option values will be 35* * returned in the tape_mult_ data block. tape_mult_parse_ will also build the 36* * attach description string. 37**/ 38 39 40 /* ARGUMENT DATA */ 41 42 dcl arg_error_code fixed bin (35), /* (O) error_table_ code. */ 43 arg_com_err_sw bit (1), /* (I) I/O module comerr switch. */ 44 arg_options (*) char (*) varying, /* (I) Array of input options. */ 45 arg_dev_name char (32) varying, /* (O) Requested -device name. */ 46 arg_tmdb_ptr ptr; /* (I) Pointer to tape_mult_ data block. */ 47 48 49 /* AUTOMATIC DATA */ 50 51 dcl attach_description char (64) varying, /* Used to build attach description. */ 52 com_err_sw bit (1) aligned, 53 error_code fixed bin (35), /* error_table_ code. */ 54 keyx fixed bin, /* Index to option key arrays. */ 55 num_options fixed bin, /* Number of attach options. */ 56 option char (32) varying, /* A single option string. */ 57 optx fixed bin, /* Index to options array. */ 58 pic99 pic "99", /* tape device number */ 59 value char (32) varying; /* A single option value string. */ 60 61 62 /* INTERNAL STATIC DATA */ 63 64 dcl short_keys (9) char (4) internal static/* Table of short option key names. */ 65 init ("-wrt", "-den", "-tk ", "-com", "-sys", "-vsn", "-et ", "-ips", "-dv"); 66 67 dcl long_keys (9) char (16) internal static 68 /* Table of long option key names. */ 69 init ("-write", "-density", "-track", "-comment", "-system", "-volume_set_name", 70 "-error_tally", "-speed", "-device"); 71 72 dcl value_flags (9) bit (1) internal static /* ON => option has accompanying value . */ 73 init ("0"b, "1"b, "1"b, "0"b, "0"b, "1"b, "0"b, "1"b, "1"b); 74 75 76 /* EXTERNAL ENTRIES CALLED */ 77 78 dcl (after, decimal, hbound, index, length, ltrim, null, string, substr, verify) 79 builtin; 80 81 dcl ( 82 error_table_$bad_arg, 83 error_table_$inconsistent, 84 error_table_$noarg, 85 error_table_$wrong_no_of_args 86 ) fixed bin (35) external; 87 88 dcl com_err_ entry options (variable); 89 dcl canon_for_volume_label_ 90 entry (char (*), char (*), char (*), fixed bin, fixed bin (35)); 91 dcl get_group_id_ entry () returns (char (32)), 92 get_ring_ entry returns (fixed bin); 93 1 1 /* Begin include file ... tmdb.incl.pl1 1 2* * 1 3* * Created by Bill Silver on 10/20/74 1 4* * Modified by J. A. Bush 12/30/80 for bootable tape labels 1 5* * Modified by J. A. Bush 12/15/81 for re-write of read error recovery 1 6* * Modified 8/82 by S.Krupp for change from tdcm_ to tape_ioi_ 1 7* * This include file describes the work variables used by the Multics standard 1 8* * tape I/O module, tape_mult_. This include file must be used with the include 1 9* * file: mstr.incl.pl1 1 10**/ 1 11 1 12 1 13 /****^ HISTORY COMMENTS: 1 14* 1) change(86-10-13,GWMay), approve(86-10-13,MCR7552), 1 15* audit(86-10-13,Martinson), install(86-10-20,MR12.0-1189): 1 16* added fields to the tmdb structure that will add support for the use of 1 17* rcp in determining the density and format of a tape. 1 18* END HISTORY COMMENTS */ 1 19 1 20 1 21 /* format: style4,delnl,insnl,indattr,ifthen,declareind10,dclind10 */ 1 22 dcl tmdb_ptr ptr; /* Pointer to tape_mult_ data block. */ 1 23 1 24 dcl 1 tmdb based (tmdb_ptr) aligned, /* tape_mult_ data block. */ 1 25 2 attach, /* Attach description. */ 1 26 3 length fixed bin, /* Actual length of attach description. */ 1 27 3 description char (64), /* Attach description string. */ 1 28 2 open, /* Open description. */ 1 29 3 length fixed bin, /* Actual length of open description. */ 1 30 3 description char (32), /* Open description string. */ 1 31 2 opt, /* Attach options. */ 1 32 3 flags, /* Flags set from user input and options. */ 1 33 ( 4 com_err bit (1), /* ON => call com_err_ if there is an error. */ 1 34 4 ring bit (1), /* ON => use writ ring, OFF => no write ring. */ 1 35 4 system bit (1), /* ON => user wants to be a system process. */ 1 36 4 err_tal bit (1), /* ON => user wants error report */ 1 37 4 begin bit (1), /* ON => begin processing tape */ 1 38 4 write_sw bit (1), /* ON => write allowed */ 1 39 4 async_sw bit (1) /* ON => user is prepared for errors to imply that previous put_chars failed. */ 1 40 ) unaligned, /* ON => user wants error tally displayed on closing */ 1 41 3 reel_name char (32) unal, /* Tape reel slot ID. */ 1 42 3 volume_set_id char (32) unal, /* volume set name */ 1 43 3 mount_mode char (7), /* Mount mode: "writing" or "reading". */ 1 44 3 tracks fixed bin, /* Either 9 or 7. */ 1 45 3 density fixed bin, /* Either 1600 or 800. */ 1 46 3 tbpp ptr, /* If not null, ptr to temp seg containing boot program */ 1 47 3 blp ptr, /* Ptr to buffer containing boot label record (READ ONLY) */ 1 48 3 speed bit (36), /* bits are 75, 125, 200 ips */ 1 49 3 comment char (64), /* User comment to operator. */ 1 50 2 head like mstr_header, /* Dummy tape record header. */ 1 51 2 trail like mstr_trailer, /* Dummy tape record trailer. */ 1 52 2 work, /* Work variables used. */ 1 53 3 flags, /* Flags we need that aren't in head.flags. */ 1 54 ( 4 eod bit (1), /* ON => end of good data. */ 1 55 4 eof bit (1), /* ON => End of File. */ 1 56 4 bot bit (1), /* ON => beginning of tape */ 1 57 4 retry_read bit (1), /* ON => try reread recovery */ 1 58 4 read_fwd bit (1), /* ON => want to read forward (recovery) */ 1 59 4 fatal_read_error bit (1), /* ON => read error recovery failed. */ 1 60 4 data_loss bit (1) /* ON => read something, but with evidence that we lost something */ 1 61 ) unaligned, 1 62 3 rcp_id bit (36), /* Id of current tape drive attachment */ 1 63 3 tioi_id bit (36), /* Id of current tape_ioi_ activation */ 1 64 3 label_uid bit (72), /* Unique ID of label record. */ 1 65 3 label_version fixed bin, /* version of label, returned on read */ 1 66 3 output_mode fixed bin, /* output mode tape was written with */ 1 67 3 buf_pos fixed bin, /* Current position within current bufffer. */ 1 68 3 curr_buf ptr, /* Current buffer being processed. */ 1 69 3 next_buf ptr, /* Next buffer to be processed. */ 1 70 3 rec_length fixed bin (21), /* Length of data record in characters. */ 1 71 3 n_full fixed bin, /* Number of buffers ready to write. */ 1 72 3 n_recs_to_eof fixed bin, /* Num recs to write pre eof mark. */ 1 73 3 n_bufs fixed bin, /* Total number of buffers. */ 1 74 3 bufs_per_subset fixed bin, /* Number of buffers per subset. */ 1 75 3 buf_len fixed bin (21), /* Length of a buffer. */ 1 76 3 buffer (8) ptr, /* Pointers to a subset of I/O buffers. */ 1 77 2 meters, 1 78 3 fwd_rd_recovery fixed bin, 1 79 3 reposition_recovery 1 80 fixed bin, 1 81 2 channels, 1 82 3 rcp fixed bin(71), /* Regular, used by rcp. */ 1 83 3 ioi fixed bin(71), /* Fast, used by ioi. */ 1 84 2 buffer (1040) fixed bin (35), /* Work buffer (currently used for label I/O). */ 1 85 2 volume_density fixed bin, /* either the input from -den or the value */ 1 86 1 87 /* returned by rcp_$check_attach in tape_info */ 1 88 2 volume_format char (16); /* determined by rcp_ */ 1 89 /* End of include file ... tmdb.incl.pl1 */ 94 95 2 1 2 2 /* Begin include file ...... mstr.incl.pl1 */ 2 3 /* Modified 2/11/74 by N. I. Morris */ 2 4 /* Modified 12/30/80 by J. A. Bush for bootable tape labels */ 2 5 /* Modified 12/14/82 by J. A. Bush to add version number to the record header */ 2 6 2 7 /* format: style4,delnl,insnl,indattr,ifthen,declareind10,dclind10 */ 2 8 dcl mstrp ptr; /* pointer to MST record */ 2 9 2 10 dcl 1 mstr based (mstrp) aligned, /* Multics standard tape mstr */ 2 11 2 head like mstr_header, /* tape record header */ 2 12 2 data bit (36864 refer (mstr.head.data_bit_len)), 2 13 /* record body */ 2 14 2 trail like mstr_trailer; /* record trailer */ 2 15 2 16 dcl 1 mst_label based (mstrp) aligned, /* bootable label structure */ 2 17 2 xfer_vector (4), /* bootload interrupt transfer vector */ 2 18 3 lda_instr bit (36), /* this will be a "LDA 4" instruction */ 2 19 3 tra_instr bit (36), /* a "TRA" instruction to start of boot pgm */ 2 20 2 head like mstr_header, /* standard record header */ 2 21 2 vid like volume_identifier, /* tape volume info */ 2 22 2 fv_overlay (0:31), /* overlay for fault vectors when tape booted */ 2 23 3 scu_instr bit (36), /* an "SCU" instruction to address of fault_data */ 2 24 3 dis_instr bit (36), /* a "DIS" instruction, with Y field = to its own addr */ 2 25 2 fault_data (8) bit (36), /* SCU data for unexpected faults goes here */ 2 26 2 boot_pgm_path char (168) unaligned, /* path name of boot program */ 2 27 2 userid char (32) unaligned, /* Storage for Person.Project.Instance of creator of tape */ 2 28 2 label_version fixed bin, /* defined by LABEL_VERSION constant below */ 2 29 2 output_mode fixed bin, /* mode in which tape was written with */ 2 30 2 boot_pgm_len fixed bin, /* length in words of boot program */ 2 31 2 copyright char (56), /* Protection notice goes here if boot pgm is written */ 2 32 2 pad (13) bit (36), /* pad out to 192 (300 octal) */ 2 33 2 boot_pgm (0 refer (mst_label.boot_pgm_len)) bit (36), 2 34 /* boot program */ 2 35 2 trail like mstr_trailer; /* standard record trailer */ 2 36 2 37 dcl 1 mstr_header based aligned, /* Multics standard tape record header */ 2 38 ( 2 c1 bit (36), /* constant = 670314355245(8) */ 2 39 2 uid bit (72), /* unique ID */ 2 40 2 rec_within_file fixed bin (17), /* phys. rec. # within phys. file */ 2 41 2 phy_file fixed bin (17), /* phys. file # on phys. tape */ 2 42 2 data_bits_used fixed bin (17), /* # of bits of data in record */ 2 43 2 data_bit_len fixed bin (17), /* bit length of data space */ 2 44 2 flags, /* record flags */ 2 45 3 admin bit (1), /* admin record flag */ 2 46 3 label bit (1), /* label record flag */ 2 47 3 eor bit (1), /* end-of-reel record flag */ 2 48 3 pad1 bit (11), 2 49 3 set bit (1), /* ON if any of following items set */ 2 50 3 repeat bit (1), /* repeated record flag */ 2 51 3 padded bit (1), /* record contains padding flag */ 2 52 3 eot bit (1), /* EOT reflector encountered flag */ 2 53 3 drain bit (1), /* synchronous write flag */ 2 54 3 continue bit (1), /* continue on next reel flag */ 2 55 3 pad2 bit (4), 2 56 2 header_version fixed bin (3) unsigned, /* current header version number */ 2 57 2 repeat_count fixed bin (8), /* repetition count */ 2 58 2 checksum bit (36), /* checksum of header and trailer */ 2 59 2 c2 bit (36) 2 60 ) unal; /* constant = 512556146073(8) */ 2 61 2 62 dcl 1 mstr_trailer based aligned, /* Multics standard tape record trailer */ 2 63 ( 2 c1 bit (36), /* constant = 107463422532(8) */ 2 64 2 uid bit (72), /* unique ID (matches header) */ 2 65 2 tot_data_bits fixed bin (35), /* total data bits written on logical tape */ 2 66 2 pad_pattern bit (36), /* padding pattern */ 2 67 2 reel_num fixed bin (11), /* reel sequence # */ 2 68 2 tot_file fixed bin (23), /* phys. file number */ 2 69 2 tot_rec fixed bin (35), /* phys. record # for logical tape */ 2 70 2 c2 bit (36) 2 71 ) unal; /* constant = 265221631704(8) */ 2 72 2 73 dcl 1 volume_identifier based aligned, /* tape volume info */ 2 74 ( 2 installation_id char (32), /* installation that created tape */ 2 75 2 tape_reel_id char (32), /* tape reel name */ 2 76 2 volume_set_id char (32) 2 77 ) unaligned; /* name of the volume set */ 2 78 2 79 dcl ( 2 80 header_c1 init ("670314355245"b3), 2 81 header_c2 init ("512556146073"b3), 2 82 trailer_c1 init ("107463422532"b3), 2 83 trailer_c2 init ("265221631704"b3), 2 84 label_c1 init ("000004235000"b3) 2 85 ) bit (36) static; 2 86 2 87 dcl LABEL_VERSION fixed bin static options (constant) init (3); 2 88 /* current label version */ 2 89 dcl HEADER_VERSION fixed bin static options (constant) init (1); 2 90 /* current header version */ 2 91 2 92 /* End of include file ...... mstr.incl.pl1 */ 2 93 96 97 3 1 /* --------------- BEGIN include file rcp_volume_formats.incl.pl1 --------------- */ 3 2 3 3 3 4 3 5 /****^ HISTORY COMMENTS: 3 6* 1) change(86-12-08,GWMay), approve(86-12-08,PBF7552), 3 7* audit(86-12-08,Martinson), install(86-12-17,MR12.0-1250): 3 8* added array entry 0 to the volume format types to indicate that the tape 3 9* volume was not authenticated by rcp. 3 10* END HISTORY COMMENTS */ 3 11 3 12 3 13 /* General volume types */ 3 14 3 15 dcl (Volume_unauthenticated initial (0), 3 16 Volume_blank initial (1), 3 17 Volume_unknown_format initial (6), 3 18 Volume_unreadable initial (7), 3 19 3 20 /* Tape volume types */ 3 21 3 22 Volume_multics_tape initial (2), 3 23 Volume_gcos_tape initial (3), 3 24 Volume_ibm_tape initial (4), 3 25 Volume_ansi_tape initial (5)) fixed bin static options (constant); 3 26 3 27 /* Printable descriptions of volume types */ 3 28 3 29 dcl Tape_volume_types (0:7) char (16) static options (constant) initial 3 30 ("unauthenticated", 3 31 "blank", 3 32 "Multics", 3 33 "GCOS", 3 34 "IBM", 3 35 "ANSI", 3 36 "unrecognizable", 3 37 "unreadable"); 3 38 3 39 /* ---------------- END include file rcp_volume_formats.incl.pl1 ---------------- */ 98 99 4 1 /* Begin include file ... rcp_resource_types.incl.pl1 4 2* * 4 3* * Created 3/79 by Michael R. Jordan for MR7.0R 4 4* * 4 5* * This include file defines the official RCP resource types. 4 6* * The array of names is indexed by the corresponding device type. 4 7* * MOD by RAF for MCA 4 8**/ 4 9 4 10 4 11 4 12 /****^ HISTORY COMMENTS: 4 13* 1) change(85-09-09,Fawcett), approve(85-09-09,MCR6979), 4 14* audit(85-12-09,CLJones), install(86-03-21,MR12.0-1033): 4 15* Support of MCA. 4 16* END HISTORY COMMENTS */ 4 17 4 18 dcl DEVICE_TYPE (8) char (32) 4 19 internal static options (constant) 4 20 init ("tape_drive", "disk_drive", "console", "printer", "punch", "reader", "special", "mca"); 4 21 4 22 dcl NUM_QUALIFIERS (8) fixed bin /* Number of qualifiers for each device type. */ 4 23 internal static init (3, 0, 0, 2, 0, 0, 0, 0); 4 24 4 25 dcl VOLUME_TYPE (8) char (32) 4 26 internal static options (constant) 4 27 init ("tape_vol", "disk_vol", "", "", "", "", "", ""); 4 28 4 29 dcl TAPE_DRIVE_DTYPEX fixed bin static internal options (constant) init (1); 4 30 dcl DISK_DRIVE_DTYPEX fixed bin static internal options (constant) init (2); 4 31 dcl CONSOLE_DTYPEX fixed bin static internal options (constant) init (3); 4 32 dcl PRINTER_DTYPEX fixed bin static internal options (constant) init (4); 4 33 dcl PUNCH_DTYPEX fixed bin static internal options (constant) init (5); 4 34 dcl READER_DTYPEX fixed bin static internal options (constant) init (6); 4 35 dcl SPECIAL_DTYPEX fixed bin static internal options (constant) init (7); 4 36 dcl MCA_DTYPEX fixed bin static internal options (constant) init (8); 4 37 dcl TAPE_VOL_VTYPEX fixed bin static internal options (constant) init (1); 4 38 dcl DISK_VOL_VTYPEX fixed bin static internal options (constant) init (2); 4 39 4 40 4 41 /* End include file ... rcp_resource_types.incl.pl1 */ 100 101 102 tmdb_ptr = arg_tmdb_ptr; /* Copy argument. */ 103 com_err_sw = arg_com_err_sw; 104 105 error_code = 0; 106 107 attach_description = "tape_mult_"; /* Initialize option values. */ 108 arg_dev_name = ""; 109 string (tmdb.opt.flags) = "0"b; /* Defaults are all FALSE. */ 110 tmdb.opt.flags.com_err = com_err_sw; 111 tmdb.opt.mount_mode = "reading"; /* Default is reading. */ 112 tmdb.opt.tracks = 9; /* Default is 9 track tape drive. */ 113 tmdb.opt.density = 0; /* Default depends upon track type. */ 114 tmdb.opt.speed = ""b; 115 tmdb.opt.comment = " "; 116 tmdb.opt.volume_set_id = ""; /* default is no volume set name */ 117 tmdb.opt.tbpp = null; /* Use internal boot pgm by default */ 118 tmdb.opt.blp = null; /* set boot label ptr to null, initially */ 119 120 num_options = hbound (arg_options, 1); /* Get number of options. */ 121 if num_options < 1 /* There must be at least a reel name. */ 122 then do; /* No options. */ 123 error_code = error_table_$noarg; 124 goto RETURN; 125 end; 126 127 option = arg_options (1); /* Copy reel name argument. */ 128 if (length (option) < 1) | /* Is it a valid reel name length? */ (length (option) > 32) then do; 129 /* No, reject option. */ 130 error_code = error_table_$bad_arg; 131 goto RETURN; 132 end; 133 134 if (get_group_id_ () = "Initializer.SysDaemon.z") & (get_ring_ () = 1) then do; 135 call canon_for_volume_label_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), (option), tmdb.opt.reel_name, 136 Volume_multics_tape, error_code); 137 if error_code ^= 0 then 138 goto RETURN; 139 end; 140 else tmdb.opt.reel_name = option; 141 142 attach_description = attach_description || " " || option; 143 144 do optx = 2 to num_options; /* Now look for all other options. */ 145 option = arg_options (optx); /* Copy next option string */ 146 if length (option) < 5 /* Look for long or short key? */ 147 then do; /* Look through list of short keys. */ 148 do keyx = 1 to hbound (short_keys, 1); 149 if short_keys (keyx) = option then 150 goto FOUND_OPTION_KEY; 151 end; 152 end; 153 else do; /* Look through list of long keys. */ 154 do keyx = 1 to hbound (long_keys, 1); 155 if long_keys (keyx) = option then 156 goto FOUND_OPTION_KEY; 157 end; 158 end; 159 error_code = error_table_$bad_arg; /* No key matched. */ 160 if tmdb.opt.flags.com_err then 161 call com_err_ (0, "tape_mult_", "Unknown attach option ^a", option); 162 goto RETURN; 163 164 FOUND_OPTION_KEY: /* We found the key that matched. */ 165 call PROCESS_OPTION; /* Now go process this option. */ 166 if error_code ^= 0 /* Check for option errors. */ 167 then 168 goto RETURN; 169 end; /* All options OK, return attach description. */ 170 tmdb.attach.length = length (attach_description); 171 tmdb.attach.description = attach_description; 172 173 if tmdb.opt.tracks = 9 then /* Is this a 9 track tape? */ 174 if tmdb.opt.density = 0 then /* Yes, default density is 1600 bpi */ 175 tmdb.opt.density = 1600; 176 else ; 177 else if tmdb.opt.density = 0 then /* No, 7 track. Was density specified? */ 178 tmdb.opt.density = 800; /* No, set 7 track default density to 800 bpi */ 179 else if tmdb.opt.density ^= 800 then /* if density was specified, it must be 800 bpi */ 180 error_code = error_table_$inconsistent; 181 182 RETURN: 183 arg_error_code = error_code; 184 return; 185 186 PROCESS_OPTION: 187 procedure; 188 189 /* This procedure is called to process the current option. We 190* * know its option key index. We will use this to goto a routine 191* * that knows how to process this option. We will add this option 192* * string to the attach description. If this option has an accompanying 193* * value then we will add the value string to the attach description. 194* * We will skip over this value argument in the option array. 195**/ 196 attach_description = attach_description || " " || option; 197 198 if value_flags (keyx) /* Does this option have a value? */ 199 then do; /* Yes, process value string. */ 200 optx = optx + 1; /* Skip to value argument in array. */ 201 if optx > num_options /* Make sure a value argument was given. */ 202 then 203 goto UNBALANCED_OPTION; 204 value = arg_options (optx); /* Pick up value string. */ 205 attach_description = attach_description || " " || value; 206 end; 207 208 goto OPTION (keyx); /* GOTO based on key index. */ 209 210 OPTION (1): /* "-wrt" or "-write" */ 211 tmdb.opt.flags.ring, tmdb.opt.flags.write_sw = "1"b; 212 /* Turn ON write ring flag and switch. */ 213 214 tmdb.opt.mount_mode = "writing"; /* Set mount mode field. */ 215 return; 216 217 OPTION (2): /* "-den" or "-density" */ 218 if value = "1600" /* Is it a legal density value? */ 219 then do; /* Yes, 1600 BPI is legal. */ 220 tmdb.opt.density = 1600; 221 return; 222 end; 223 if value = "800" /* 800 BPI is legal too. */ 224 then do; 225 tmdb.opt.density = 800; 226 return; 227 end; 228 if value = "6250" then do; /* 6250 bpi is legal too. */ 229 tmdb.opt.density = 6250; 230 return; 231 end; 232 goto ILLEGAL_VALUE; /* Illegal density option value. */ 233 234 OPTION (3): /* "-tk" or "-track" */ 235 if value = "9" /* 9 track is valid. */ 236 then do; 237 tmdb.opt.tracks = 9; 238 return; 239 end; 240 if value = "7" /* 7 track is valid. */ 241 then do; 242 tmdb.opt.tracks = 7; 243 return; 244 end; 245 goto ILLEGAL_VALUE; 246 247 OPTION (4): /* "-com" or "-comment" */ 248 optx = optx + 1; /* Value_flag for comment key is OFF. */ 249 if optx > num_options /* Check for comment value. */ 250 then 251 goto UNBALANCED_OPTION; 252 tmdb.opt.comment = arg_options (optx); /* Copy comment arg. Not put in att desc. */ 253 return; 254 255 OPTION (5): /* "-sys" or "-system" */ 256 tmdb.opt.flags.system = "1"b; 257 return; 258 259 OPTION (6): 260 tmdb.opt.volume_set_id = value; /* "-vsn" or "-volume_set_name" */ 261 return; 262 263 OPTION (7): 264 tmdb.opt.flags.err_tal = "1"b; /* "-et" or "-error_tally" */ 265 return; 266 267 OPTION (8): /* "-ips" or "-speed" */ 268 begin; 269 dcl COMMA char (1) init (",") static options (constant); 270 dcl current_value char (32) varying; 271 dcl current_idx fixed bin; /* how far we've gotten into value */ 272 273 current_idx = 1; /* start from the beginning of the string */ 274 current_value = get_next_value (); 275 if current_value = "" then 276 goto ILLEGAL_VALUE; /* insist on at least one */ 277 do while (current_value ^= ""); 278 if current_value = "75" then 279 tmdb.opt.speed = tmdb.opt.speed | "100"b; 280 else if current_value = "125" then 281 tmdb.opt.speed = tmdb.opt.speed | "010"b; 282 else if current_value = "200" then 283 tmdb.opt.speed = tmdb.opt.speed | "001"b; 284 else goto ILLEGAL_VALUE; 285 current_value = get_next_value (); 286 end; /* do while ... */ 287 return; 288 289 get_next_value: 290 proc returns (char (32) varying); 291 292 dcl next_value char (32) varying; 293 294 if current_idx = -1 then 295 return (""); 296 if index (substr (value, current_idx), COMMA) = 0 then do; 297 next_value = substr (value, current_idx); 298 current_idx = -1; /* so next call will stop */ 299 return (next_value); 300 end; 301 else do; 302 next_value = substr (value, current_idx, index (substr (value, current_idx), COMMA) - 1); 303 current_idx = current_idx + length (next_value) + 1; 304 return (next_value); 305 end; 306 307 end get_next_value; 308 309 end; /* the begin */ 310 311 OPTION (9): 312 if length (value) < length ("tape1") then 313 go to ILLEGAL_VALUE; 314 if index (value, "tap") ^= 1 then 315 go to ILLEGAL_VALUE; 316 value = after (value, "tap"); 317 if verify (substr (value, 1, 1), "abcdefghijklmnopqurstuvwxyz") > 0 then 318 go to ILLEGAL_VALUE; 319 arg_dev_name = "tap" || substr (value, 1, 1) || "_"; 320 value = ltrim (substr (value, 2), "_"); 321 if verify (value, "0123456789") > 0 then 322 go to ILLEGAL_VALUE; 323 if length (value) > length ("99") then 324 go to ILLEGAL_VALUE; 325 pic99 = decimal (value); 326 arg_dev_name = arg_dev_name || pic99; 327 return; 328 329 330 ILLEGAL_VALUE: /* We don't know this value. */ 331 if substr (value, 1, 1) = "-" /* Does this look like a key name? */ 332 then 333 goto UNBALANCED_OPTION; /* Yes, illegal because unbalanced. */ 334 error_code = error_table_$bad_arg; 335 if tmdb.opt.flags.com_err then 336 call com_err_ (0, "tape_mult_", "Attachment option ^a is unknown.", option); 337 return; 338 339 UNBALANCED_OPTION: 340 error_code = error_table_$wrong_no_of_args; 341 if tmdb.opt.flags.com_err then 342 call com_err_ (0, "tape_mult_", "Expected value with option ^a is missing.", option); 343 344 end PROCESS_OPTION; 345 346 347 end tape_mult_parse_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0812.6 tape_mult_parse_.pl1 >spec>install>1112>tape_mult_parse_.pl1 94 1 10/21/86 1251.7 tmdb.incl.pl1 >ldd>include>tmdb.incl.pl1 96 2 12/20/82 1113.8 mstr.incl.pl1 >ldd>include>mstr.incl.pl1 98 3 12/17/86 1550.5 rcp_volume_formats.incl.pl1 >ldd>include>rcp_volume_formats.incl.pl1 100 4 03/27/86 1120.0 rcp_resource_types.incl.pl1 >ldd>include>rcp_resource_types.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. COMMA constant char(1) initial packed unaligned dcl 269 ref 296 302 TAPE_VOL_VTYPEX constant fixed bin(17,0) initial dcl 4-37 ref 135 VOLUME_TYPE 000011 constant char(32) initial array packed unaligned dcl 4-25 set ref 135* Volume_multics_tape 000206 constant fixed bin(17,0) initial dcl 3-15 set ref 135* after builtin function dcl 78 ref 316 arg_com_err_sw parameter bit(1) packed unaligned dcl 42 ref 22 103 arg_dev_name parameter varying char(32) dcl 42 set ref 22 108* 319* 326* 326 arg_error_code parameter fixed bin(35,0) dcl 42 set ref 22 182* arg_options parameter varying char array dcl 42 ref 22 120 127 145 204 252 arg_tmdb_ptr parameter pointer dcl 42 ref 22 102 attach based structure level 2 dcl 1-24 attach_description 000100 automatic varying char(64) dcl 51 set ref 107* 142* 142 170 171 196* 196 205* 205 blp 62 based pointer level 3 dcl 1-24 set ref 118* canon_for_volume_label_ 000022 constant entry external dcl 89 ref 135 com_err 32 based bit(1) level 4 packed packed unaligned dcl 1-24 set ref 110* 160 335 341 com_err_ 000020 constant entry external dcl 88 ref 160 335 341 com_err_sw 000121 automatic bit(1) dcl 51 set ref 103* 110 comment 65 based char(64) level 3 dcl 1-24 set ref 115* 252* current_idx 000175 automatic fixed bin(17,0) dcl 271 set ref 273* 294 296 297 298* 302 302 303* 303 current_value 000164 automatic varying char(32) dcl 270 set ref 274* 275 277 278 280 282 285* decimal builtin function dcl 78 ref 325 density 56 based fixed bin(17,0) level 3 dcl 1-24 set ref 113* 173 173* 177 177* 179 220* 225* 229* description 1 based char(64) level 3 dcl 1-24 set ref 171* err_tal 32(03) based bit(1) level 4 packed packed unaligned dcl 1-24 set ref 263* error_code 000122 automatic fixed bin(35,0) dcl 51 set ref 105* 123* 130* 135* 137 159* 166 179* 182 334* 339* error_table_$bad_arg 000010 external static fixed bin(35,0) dcl 81 ref 130 159 334 error_table_$inconsistent 000012 external static fixed bin(35,0) dcl 81 ref 179 error_table_$noarg 000014 external static fixed bin(35,0) dcl 81 ref 123 error_table_$wrong_no_of_args 000016 external static fixed bin(35,0) dcl 81 ref 339 flags 32 based structure level 3 dcl 1-24 set ref 109* get_group_id_ 000024 constant entry external dcl 91 ref 134 get_ring_ 000026 constant entry external dcl 91 ref 134 hbound builtin function dcl 78 ref 120 148 154 index builtin function dcl 78 ref 296 302 314 keyx 000123 automatic fixed bin(17,0) dcl 51 set ref 148* 149* 154* 155* 198 208 length builtin function dcl 78 in procedure "tape_mult_parse_" ref 128 128 146 170 303 311 311 323 323 length based fixed bin(17,0) level 3 in structure "tmdb" dcl 1-24 in procedure "tape_mult_parse_" set ref 170* long_keys 000112 constant char(16) initial array packed unaligned dcl 67 ref 154 155 ltrim builtin function dcl 78 ref 320 mount_mode 53 based char(7) level 3 dcl 1-24 set ref 111* 214* mstr_header based structure level 1 dcl 2-37 mstr_trailer based structure level 1 dcl 2-62 next_value 000204 automatic varying char(32) dcl 292 set ref 297* 299 302* 303 304 null builtin function dcl 78 ref 117 118 num_options 000124 automatic fixed bin(17,0) dcl 51 set ref 120* 121 144 201 249 opt 32 based structure level 2 dcl 1-24 option 000125 automatic varying char(32) dcl 51 set ref 127* 128 128 135 140 142 145* 146 149 155 160* 196 335* 341* optx 000136 automatic fixed bin(17,0) dcl 51 set ref 144* 145* 200* 200 201 204 247* 247 249 252 pic99 000137 automatic picture(2) packed unaligned dcl 51 set ref 325* 326 reel_name 33 based char(32) level 3 packed packed unaligned dcl 1-24 set ref 135* 140* ring 32(01) based bit(1) level 4 packed packed unaligned dcl 1-24 set ref 210* short_keys 000156 constant char(4) initial array packed unaligned dcl 64 ref 148 149 speed 64 based bit(36) level 3 dcl 1-24 set ref 114* 278* 278 280* 280 282* 282 string builtin function dcl 78 set ref 109* substr builtin function dcl 78 ref 296 297 302 302 317 319 320 330 system 32(02) based bit(1) level 4 packed packed unaligned dcl 1-24 set ref 255* tbpp 60 based pointer level 3 dcl 1-24 set ref 117* tmdb based structure level 1 dcl 1-24 tmdb_ptr 000152 automatic pointer dcl 1-22 set ref 102* 109 110 111 112 113 114 115 116 117 118 135 140 160 170 171 173 173 173 177 177 179 210 210 214 220 225 229 237 242 252 255 259 263 278 278 280 280 282 282 335 341 tracks 55 based fixed bin(17,0) level 3 dcl 1-24 set ref 112* 173 237* 242* value 000140 automatic varying char(32) dcl 51 set ref 204* 205 217 223 228 234 240 259 296 297 302 302 311 314 316* 316 317 319 320* 320 321 323 325 330 value_flags 000111 constant bit(1) initial array packed unaligned dcl 72 ref 198 verify builtin function dcl 78 ref 317 321 volume_identifier based structure level 1 dcl 2-73 volume_set_id 43 based char(32) level 3 packed packed unaligned dcl 1-24 set ref 116* 259* write_sw 32(05) based bit(1) level 4 packed packed unaligned dcl 1-24 set ref 210* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. CONSOLE_DTYPEX internal static fixed bin(17,0) initial dcl 4-31 DEVICE_TYPE internal static char(32) initial array packed unaligned dcl 4-18 DISK_DRIVE_DTYPEX internal static fixed bin(17,0) initial dcl 4-30 DISK_VOL_VTYPEX internal static fixed bin(17,0) initial dcl 4-38 HEADER_VERSION internal static fixed bin(17,0) initial dcl 2-89 LABEL_VERSION internal static fixed bin(17,0) initial dcl 2-87 MCA_DTYPEX internal static fixed bin(17,0) initial dcl 4-36 NUM_QUALIFIERS internal static fixed bin(17,0) initial array dcl 4-22 PRINTER_DTYPEX internal static fixed bin(17,0) initial dcl 4-32 PUNCH_DTYPEX internal static fixed bin(17,0) initial dcl 4-33 READER_DTYPEX internal static fixed bin(17,0) initial dcl 4-34 SPECIAL_DTYPEX internal static fixed bin(17,0) initial dcl 4-35 TAPE_DRIVE_DTYPEX internal static fixed bin(17,0) initial dcl 4-29 Tape_volume_types internal static char(16) initial array packed unaligned dcl 3-29 Volume_ansi_tape internal static fixed bin(17,0) initial dcl 3-15 Volume_blank internal static fixed bin(17,0) initial dcl 3-15 Volume_gcos_tape internal static fixed bin(17,0) initial dcl 3-15 Volume_ibm_tape internal static fixed bin(17,0) initial dcl 3-15 Volume_unauthenticated internal static fixed bin(17,0) initial dcl 3-15 Volume_unknown_format internal static fixed bin(17,0) initial dcl 3-15 Volume_unreadable internal static fixed bin(17,0) initial dcl 3-15 header_c1 internal static bit(36) initial packed unaligned dcl 2-79 header_c2 internal static bit(36) initial packed unaligned dcl 2-79 label_c1 internal static bit(36) initial packed unaligned dcl 2-79 mst_label based structure level 1 dcl 2-16 mstr based structure level 1 dcl 2-10 mstrp automatic pointer dcl 2-8 trailer_c1 internal static bit(36) initial packed unaligned dcl 2-79 trailer_c2 internal static bit(36) initial packed unaligned dcl 2-79 NAMES DECLARED BY EXPLICIT CONTEXT. FOUND_OPTION_KEY 000742 constant label dcl 164 ref 149 155 ILLEGAL_VALUE 001616 constant label dcl 330 ref 232 245 275 282 311 314 317 321 323 OPTION 000000 constant label array(9) dcl 210 set ref 208 PROCESS_OPTION 001004 constant entry internal dcl 186 ref 164 RETURN 001000 constant label dcl 182 ref 124 131 137 162 166 UNBALANCED_OPTION 001667 constant label dcl 339 ref 201 249 330 get_next_value 001344 constant entry internal dcl 289 ref 274 285 tape_mult_parse_ 000315 constant entry external dcl 22 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2266 2316 2147 2276 Length 2564 2147 30 231 117 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tape_mult_parse_ 374 external procedure is an external procedure. PROCESS_OPTION internal procedure shares stack frame of external procedure tape_mult_parse_. begin block on line 267 begin block shares stack frame of external procedure tape_mult_parse_. get_next_value internal procedure shares stack frame of external procedure tape_mult_parse_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME tape_mult_parse_ 000100 attach_description tape_mult_parse_ 000121 com_err_sw tape_mult_parse_ 000122 error_code tape_mult_parse_ 000123 keyx tape_mult_parse_ 000124 num_options tape_mult_parse_ 000125 option tape_mult_parse_ 000136 optx tape_mult_parse_ 000137 pic99 tape_mult_parse_ 000140 value tape_mult_parse_ 000152 tmdb_ptr tape_mult_parse_ 000164 current_value begin block on line 267 000175 current_idx begin block on line 267 000204 next_value get_next_value THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry_desc set_chars_eis index_chars_eis any_to_any_truncate_index_after_cs THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. canon_for_volume_label_ com_err_ get_group_id_ get_ring_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$inconsistent error_table_$noarg error_table_$wrong_no_of_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 22 000310 102 000330 103 000334 105 000341 107 000342 108 000347 109 000351 110 000352 111 000356 112 000361 113 000363 114 000364 115 000365 116 000370 117 000373 118 000375 120 000376 121 000402 123 000404 124 000406 127 000407 128 000427 130 000434 131 000436 134 000437 135 000466 137 000532 139 000535 140 000536 142 000543 144 000577 145 000607 146 000633 148 000636 149 000643 151 000651 152 000653 154 000654 155 000661 157 000670 159 000672 160 000675 162 000741 164 000742 166 000743 169 000745 170 000747 171 000751 173 000756 176 000765 177 000766 179 000773 182 001000 184 001003 186 001004 196 001005 198 001041 200 001047 201 001050 204 001053 205 001077 206 001133 208 001134 210 001135 214 001142 215 001145 217 001146 220 001153 221 001156 223 001157 225 001164 226 001167 228 001170 229 001175 230 001200 232 001201 234 001202 237 001207 238 001212 240 001213 242 001220 243 001223 245 001224 247 001225 249 001226 252 001231 253 001250 255 001251 257 001254 259 001255 261 001262 263 001263 265 001266 273 001267 274 001271 275 001273 277 001300 278 001305 280 001316 282 001327 285 001337 286 001341 287 001342 309 001343 289 001344 294 001346 296 001354 297 001374 298 001404 299 001406 302 001415 303 001425 304 001431 311 001440 314 001443 316 001453 317 001474 319 001504 320 001517 321 001543 323 001556 325 001561 326 001601 327 001615 330 001616 334 001622 335 001625 337 001666 339 001667 341 001672 344 001733 ----------------------------------------------------------- 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