COMPILATION LISTING OF SEGMENT et_data Compiled by: Multics PL/I Compiler, Release 27b, of September 15, 1981 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 06/03/82 1020.5 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 et_data: procedure (statement, arg_et_data_ptr, code); 12 13 14 15 /* This procedure will parse the data in a "data" statement that is part of the 16* * input script to the eis_tester program. 17* * 18* * Created Jan, 73 by Bill Silver. 19* * 20* * 21* * A "data" statement has the following format: 22* * 23* * data num -option data_field ... data_field; 24* * 25* * 1. The first field in the statement MUST be "data". 26* * 27* * 2. The second field in the statement MUST be the number of the data field. 28* * It must be either "1", "2", or "3". Note, in some cases a "data 3" statement 29* * is valid even when there is no third descriptor. In this case it will be used 30* * to input test data. 31* * 32* * 3. The following option field may occur anywhere after the number field. 33* * -do X The X field must be a decimal integer from -128 to +4096. 34* * It represents a CHARACTER offset from character 0 of the middle page 35* * of the data area. Note, if the descriptor which points to this dat does not 36* * use AR or REG modification then only offsets that are a multiple of 4 will 37* * be accepted. 38* * 39* * 4. Data may be defined by the following types of data fields. They may be 40* * intermixed. The maximum size of the data is 1088 words ( 4352 characters ). 41* * Note, the data used by EIS instructions is always STRING type data and thus 42* * the input modes are limited to the 2 described below. 43* * 44* * a) ASCII - Input data may be an ASCII string. It must be enclosed in 45* * quotes. The maximum size of any one field is 256 characters. 46* * Quote characters may be entered in the string by expressing 47* * them as double quotes. ("") 48* * 49* * b) OCTAL - Data may be entered as a string of octal digits. The first non 50* * octal digit type character found will indicate the end of the string 51* * of octal data. The converted octal string will be padded on the RIGHT 52* * with zero bits to make it an integral number of 9 bit characters. 53* * 54* * 5. Repetition Factor ( XX ) - An unsigned decimal number enclosed in parenthesis 55* * may be used to specify the repetition of a field. Only the data field 56* * immediately following the repetition field will be repeated. 57**/ 58 /* */ 59 /* PARAMETERS to et_data. */ 60 61 62 dcl statement char (*), /* The input string containing the "data" 63* * statement to be parsed. */ 64 65 arg_et_data_ptr ptr, /* Input pointer to the et data. */ 66 67 code fixed bin (35); /* Error code. */ 68 69 70 71 72 73 74 /* AUTOMATIC DATA */ 75 76 77 /* The following data items are used in calls to et_util. */ 78 79 dcl state_ptr ptr, /* Pointer to the "data" input statement. */ 80 81 start fixed bin (35), /* The number of characters allready 82* * processed in this "data" statement. 83* * The next character is the start of 84* * the window. */ 85 86 size fixed bin (35), /* The current size ( in characters ) 87* * of the window on the "data" statement. */ 88 89 next_statement_x fixed bin; /* Index of the last character in the 90* * statement - in effect the number of 91* * characters in the statement. */ 92 93 94 95 /* These are some temporary variables. */ 96 97 dcl dec_num fixed bin, /* Holds converted decimal number. */ 98 99 dx fixed bin (17), /* Index to those tables that are dependent 100* * on the data statements associated with 101* * the three descriptors. */ 102 103 i fixed bin, /* Index. */ 104 105 len fixed bin, /* Length of a field. */ 106 107 rep_num fixed bin (17), /* The number of times a data field is to 108* * be repeated. */ 109 110 result_x fixed bin, /* The number of the descriptor which references 111* * the result data for this instruction. */ 112 113 save_offset fixed bin, /* Used to save term from "-do" option. */ 114 115 test_x fixed bin; /* The number of the data statement used to 116* * enter test data for this instruction. */ 117 118 119 dcl data_ptr ptr; /* Points to the current data area. */ 120 121 122 123 dcl temp_buf char (256) aligned, /* A temporary buffer used in processing the 124* * input data fields. */ 125 126 temp_buf_len fixed bin, /* The number of characters currently in 127* * this buffer. */ 128 129 temp_buf_start fixed bin; /* The indext to the next unused character 130* * position in this buffer. */ 131 132 133 134 135 136 /* BASED DATA */ 137 138 139 /* This is an overlay of the input "data" statement. */ 140 141 dcl 1 data_statement based (state_ptr), /* Used to access the input data statement 142* * as a stream of characters. */ 143 144 2 offset char (start), /* The part of the "data" statement which we have 145* * allready processed. */ 146 147 2 window char (size); /* The part of the "data" statement which we are 148* * currently accessing. */ 149 150 151 152 153 /* This is an overlay of the data areas where the input data will be moved. */ 154 155 dcl data_area char (4352) based (data_ptr) aligned; 156 157 158 159 /* This array defines a sting of real octal digits. This string is placed in 160* * the temporary buffer. 161**/ 162 dcl oct_array (1:768) bit (3) based unaligned; 163 164 165 /* This is an overlay of one word. It is used to move decimal and octal words. */ 166 167 dcl char_word char (4) based aligned; 168 169 170 171 /* This is an overlay of a descriptor word. We are only interested in the address 172* * field in the descriptor. 173**/ 174 175 dcl 1 desc_map based, 176 177 (2 pad1 bit (3), 178 179 2 y fixed bin (14), 180 181 2 pad2 bit (18)) unaligned; 182 183 184 /* This is an overlay of an mf field. */ 185 186 dcl 1 mf_map based unaligned, 187 2 ar bit (1), 188 2 rl bit (1), 189 2 id bit (1), 190 2 reg bit (4); 191 192 193 194 195 196 197 /* INTERNAL STATIC DATA */ 198 199 200 /* These indexes reference the test and result entries in the data_ptrs, 201* * data_lens, and data_offsets arrays. 202**/ 203 204 dcl (tx fixed bin init (4), 205 206 rx fixed bin init (5)) internal static; 207 208 209 /* This constant consists of one quote character. */ 210 211 dcl quote char (1) internal static init (""""); 212 213 214 /* These arrays define octal digits and their bit values. */ 215 216 dcl oct_chars (0:7) char (1) internal static 217 init ("0", "1", "2", "3", "4", "5", "6", "7"); 218 219 220 dcl oct_bits (0:7) bit (3) internal static 221 init ("000"b, "001"b, "010"b, "011"b, 222 "100"b, "101"b, "110"b, "111"b); 223 224 225 226 /* This array points to the three set up areas in etx. This is where the input 227* * data will be placed. 228**/ 229 230 dcl set_data_ptrs (3) ptr internal static, 231 232 init_flag fixed bin internal static init (0); 233 234 235 236 237 238 239 /* EXTERNAL DATA */ 240 241 242 /* The following declarations reference the procedures called by et_data. 243**/ 244 245 dcl com_err_ entry options (variable), 246 247 et_util$skip entry (ptr, fixed bin (35), fixed bin (35)), 248 et_util$convert_decimal entry (ptr, fixed bin (35), fixed bin (35), fixed bin, fixed bin (35)), 249 et_util$char_rel entry (ptr, fixed bin), 250 251 etx$set_data1 external, 252 etx$set_data2 external, 253 etx$set_data3 external; 254 255 256 dcl (addr, 257 addrel, 258 divide, 259 fixed, 260 length, 261 null, 262 search, 263 substr, 264 verify) builtin; 265 /* */ 1 1 /* BEGIN INCLUDE FILE ... et_instr_data_map.incl.pl1 1 2** 1 3** Created Jan, 73 by Bill Silver. 1 4** 1 5** 1 6** Below is a map of the data found in et_instr_data.alm. 1 7** This is a table of "eis" multi-word instructions. 1 8**/ 1 9 1 10 1 11 1 12 dcl et_instr_data$num_instructions fixed bin external; 1 13 1 14 1 15 dcl 1 et_instr_data$instructions( 0:1 ) aligned external, 1 16 1 17 (2 mnemonic char(4), /* Instruction's assembler name. */ 1 18 1 19 2 opcode bit(10), /* Opcode, rightmost bit always ON. */ 1 20 1 21 2 instr_typex fixed bin(7), /* 1 => alphanumeric, 2 => numeric, 1 22* * 3 => bit string 4 => conversion. */ 1 23 1 24 2 char_sizex (3) fixed bin(2), /* Defines the character size for each descriptor. 1 25* * 0 => 1, 1 => 4, 1 26* * 2 => 36, 3 => -1, 1 27* * -1 => no descriptor */ 1 28 1 29 2 mf2_flag bit(1), /* 1 => instruction word has "mf2" field. 1 30* * 0 => descriptor word has "mf2" field. */ 1 31 1 32 2 mf3_flag bit(1), /* 1 => instruction word has "mf3" field. 1 33* * 0 => descriptor word has "mf3" field. */ 1 34 1 35 2 desc_3_flag bit(1), /* 0 => instruction has 2 descriptors. 1 36* * 1 => instruction has 3 descriptors. */ 1 37 1 38 2 test_x fixed bin(2), /* The number of the data statement used 1 39* * to input the test data. */ 1 40 1 41 2 result_x fixed bin(2)) /* The number of the descriptor which 1 42* * references the result data. */ 1 43 1 44 unaligned; 1 45 1 46 1 47 /* END of INCLUDE FILE ... et_instr_data_map.incl.pl1 */ 266 267 /* */ 2 1 /* BEGINNING OF INCLUDE FILE ... et_setup_data.incl.pl1 2 2* * 2 3* * Created Jan, 73 by Bill Silver. 2 4* * 2 5* * 2 6* * This include file defines the data that is needed to set up a test of an eis 2 7* * instruction. The area where this data actually resides is in "et". 2 8**/ 2 9 2 10 2 11 dcl et_data_ptr ptr; /* Pointer to the et_data area. */ 2 12 2 13 2 14 dcl 1 et_setup_data based (et_data_ptr) aligned, 2 15 2 16 2 next_instruction_x fixed bin, /* Index in script file of where the next 2 17* * instruction test begins. */ 2 18 2 19 2 name char (6), /* Mnemonic name of the instruction 2 20* * being tested. */ 2 21 2 22 2 test_count fixed bin, /* The number of the current test. */ 2 23 2 24 2 note char (64), /* A NOTE containing a description of the test. */ 2 25 2 26 2 loop_count fixed bin, /* Number of times to execute the same 2 27* * variation of an instruction. */ 2 28 2 29 2 instr_offset fixed bin, /* Indicates the position of the eis 2 30* * instruction within the instruction 2 31* * area in etx. */ 2 32 2 33 2 instr_num fixed bin, /* The index of the current instruction's 2 34* * entry in the et_instr_data$instruction 2 35* * array. */ 2 36 2 37 2 instr_type fixed bin, /* 1 = alphanumeric 2 = numeric 2 38* * 3 = bit string 4 = conversion */ 2 39 2 40 2 instr_word bit (36), /* The instruction word of the eis 2 41* * instruction to be tested. */ 2 42 2 43 2 descriptors (3) bit (36), /* The three possible descriptor words 2 44* * of the eis instruction. */ 2 45 2 46 2 ind_words (3) bit (36), /* The three possible indirect words that 2 47* * may follow the eis instruction. */ 2 48 2 49 2 desc_ptrs (3) ptr, /* An array of pointers to where any 2 50* * indirect descriptors must be placed. */ 2 51 2 52 2 mf_ptrs (3) ptr, /* Pointers to the mf fields for each descriptor. 2 53* * If an entry is null then there is no descriptor 2 54* * associated with this entry. */ 2 55 2 56 2 num_chars (3) fixed bin, /* For each descriptor a code indicating what 2 57* * type of "ta" or "tn" field it may have. It 2 58* * implies the number of characters in a word. 2 59* * 1 - descriptor must reference word boundary. 2 60* * 4 - any legal "ta" or "tn" field. 2 61* * Implies 9 bit characters as default. 2 62* * 36 - descriptor may reference bits. 2 63* * -1 - must use "ta" field of descriptor 1 2 64* * 0 - no descriptor. */ 2 65 2 66 2 data_ptrs (5) ptr, /* An array of pointers to where 2 67* * the data for the corresponding 2 68* * descriptor will go. It points to 2 69* * the first word of the data. 2 70* * Entry (4) is for the test data. 2 71* * Entry (5) is for the result data. */ 2 72 2 73 2 data_lens (5) fixed bin, /* An array of lengths of the data fields. 2 74* * They will always be in units of chars. */ 2 75 2 76 2 data_offsets (5) fixed bin, /* An array of character offsets. They specify 2 77* * the character position of the string in 2 78* * the first word of the string. */ 2 79 2 80 2 page_faults (14) bit (1) unal, /* A table of flags which indicate pages 2 81* * which should take a page fault during 2 82* * execution of the eis instruction. */ 2 83 2 84 2 page_ptrs (14) ptr, /* A pointer to each page that is used 2 85* * by the instruction. Pages not used will 2 86* * have null entries. */ 2 87 2 88 2 truncation_flag fixed bin, /* Indicates whether or not the instruction is 2 89* * going to take a truncation fault. 2 90* * 1 => yes, 0 => no. */ 2 91 2 92 2 pointers (0:7) ptr, /* The values of the pointer registers 2 93* * before the execution of the eis instr. */ 2 94 2 95 2 regs, /* Index, A, and Q registers. */ 2 96 3 x (0:7) fixed bin (17) unaligned, 2 97 3 A fixed bin (35), 2 98 3 Q fixed bin (35), 2 99 3 pad (2) bit (36), 2 100 2 101 2 ir_word bit (36); /* The settings of the indicator 2 102* * registers after the eis instruction 2 103* * has been executed. */ 2 104 2 105 2 106 2 107 /* END of INCLUDE FILE ... et_setup_data.incl.pl1 */ 268 269 /* */ 270 /* Set up the window on the input "data" statement. We will skip the 271* * "data" field at the beginning of the statement. 272**/ 273 274 state_ptr = addr (statement); 275 next_statement_x = length (statement); 276 277 et_data_ptr = arg_et_data_ptr; /* Copy this argument. */ 278 279 start = 4; 280 size = next_statement_x - 4; 281 282 save_offset = 0; 283 284 285 /* Get the num field which must be next. */ 286 287 call et_util$skip (state_ptr, start, size); 288 289 290 /* Validate and convert the num field. */ 291 292 len = verify (substr (window, 1, 1), "123"); 293 294 if len = 0 295 296 then do; 297 dx = fixed (substr (window, 1, 1), 17); 298 start = start + 1; 299 size = size - 1; 300 end; 301 302 else do; 303 code = 401; 304 call com_err_ (0, "ET", "^d Illegal data num field: ^a", code, substr (window, 1, 1)); 305 return; 306 end; 307 308 309 /* Before we do anything more we will retrieve the test and result indexes for this 310* * instruction. These values are needed in several places. Also if this is 311* * the first time this procedure in the process we will initialize some 312* * pointers that we need. 313**/ 314 315 test_x = et_instr_data$instructions (instr_num).test_x; 316 317 result_x = et_instr_data$instructions (instr_num).result_x; 318 319 temp_buf = " "; /* Initialize mainly for debugging. */ 320 321 rep_num = 1; /* It is reset after each data field is 322* * moved into the setup area. */ 323 324 325 if init_flag = 0 326 327 then do; 328 set_data_ptrs (1) = addr (etx$set_data1); 329 set_data_ptrs (2) = addr (etx$set_data2); 330 set_data_ptrs (3) = addr (etx$set_data3); 331 init_flag = 1; 332 end; 333 334 335 /* Now check to see if this data statement is legal. Only data 3 statements can be 336* * illegal. They are illegal only if this instruction has no third descriptor and 337* * the data 3 statement is not used to input test data. 338**/ 339 340 if dx = 3 341 342 then if (^et_instr_data$instructions (instr_num).desc_3_flag) & 343 344 (test_x ^= 3) 345 346 then do; 347 code = 403; 348 call com_err_ (0, "ET", "^d Illegal data 3 statement.", code); 349 return; 350 end; 351 352 353 /* Now initialize the pointer to the set up data area in etx where this input data 354* * will be placed. 355**/ 356 357 data_ptr = set_data_ptrs (dx); 358 359 360 361 /* Now we can start processing the optional terms in the data statement. We will continue to 362* * process these terms until we find an error or until there is no more input in this 363* * data statement. 364**/ 365 366 367 input_loop: 368 369 370 /* Get the first character of the next field. If there is no more input for this 371* * statement we will go to the end of data to perform some necessary finishing 372* * touches for this data statement. 373**/ 374 375 call et_util$skip (state_ptr, start, size); 376 377 if substr (window, 1, 1) = ";" 378 then goto end_of_data; 379 380 381 /* There is another field. The first character of the field tells us what to 382* * do with this field. 383**/ 384 385 if substr (window, 1, 1) = "(" 386 387 then call get_repetition_num; 388 389 390 else if substr (window, 1, 1) = "-" 391 392 then call get_data_off; 393 394 395 else if substr (window, 1, 1) = quote 396 397 then call get_ascii_data; 398 399 400 else call get_octal_data; /* This is the default. */ 401 402 403 /* Regardless of which internal procedure was called it will return here. We must 404* * check the error code it returns. If there was an error we will print out the whole 405* * data statement and then return. 406**/ 407 408 if code ^= 0 409 410 then do; 411 start = 0; 412 size = next_statement_x; 413 call com_err_ (0, "ET", "^d data statement: ^a", code, window); 414 return; 415 end; 416 417 418 goto input_loop; /* This is the end of the loop. Each 419* * iteration will process 1 input field. */ 420 /* */ 421 /* We have finished processing all of the data in this statement. Now we must 422* * perform a little special processing that can only be done when all the 423* * data from this data statement are known. 424* * 425* * The first thing we must do is to set up the page_ptrs for this data area. 426* * Only the pages that are actually used will have non null entries. 427* */ 428 429 end_of_data: 430 431 if save_offset < 0 /* String starts in page 1. */ 432 433 then page_ptrs (3 + (dx-1)*4 + 1) = data_ptrs (dx); 434 435 436 save_offset = save_offset + data_lens (dx); 437 438 439 if save_offset > 0 /* String extends into page 2. */ 440 441 then page_ptrs (3 + (dx-1)*4 + 2) = addrel (data_ptrs (dx), 64); 442 443 444 if save_offset > 4096 /* String extends into page 3. */ 445 446 then page_ptrs (3 + (dx-1)*4 + 3) = addrel (data_ptrs (dx), 1088); 447 448 449 450 /* Now we must see if this statement is used to input test or result data. 451* * If so we must set up the array entries that are associated with test and 452* * result data. 453**/ 454 455 if dx = test_x 456 457 then do; /* This statement inputs test data. */ 458 459 data_ptrs (tx) = data_ptr; /* Test data is in setup area. */ 460 461 data_lens (tx) = data_lens (dx); /* This is both test and result len. */ 462 data_lens (rx) = data_lens (dx); 463 464 data_lens (dx) = 0; /* This data is NOT set up before 465* * the instruction is executed. */ 466 end; 467 468 469 if dx = result_x 470 471 then do; 472 473 data_ptrs (rx) = data_ptrs (dx); 474 475 data_offsets (rx) = data_offsets (dx); 476 477 end; 478 479 480 481 /* This is the logical end of the et_data procedure. */ 482 /* */ 483 get_repetition_num: procedure; 484 485 486 /* This procedure is called to parse a repetitions number field. The repetition number 487* * must be enclosed in parenthesis and it must be a positive decimal number. 488* * It will be returned in the variable "rep_num". 489**/ 490 491 492 493 start = start + 1; /* Move the window past the "(". */ 494 size = size - 1; 495 496 497 /* Skip to the first decimal digit. There may be blanks before and after the 498* * repetition number. 499**/ 500 501 call et_util$skip (state_ptr, start, size); 502 503 504 /* Now find the number of digits in the repetition number. We will also verify that 505* * it is a valiid decimal number. Note, if the value returned in "len" is 0 then 506* * all characters in the rest of the statement are decimal digits. If "len" is 507* * 1 then the first character of the decimal number is not a decimal digit. 508**/ 509 510 len = verify (window, "0123456789"); 511 512 if len < 2 513 514 then goto error_missing_right_paren; 515 516 517 len = len - 1; /* Adjust "len" to get actual number of 518* * decimal digits. */ 519 520 rep_num = fixed (substr (window, 1, len), 17); /* Convert repetition number. */ 521 522 523 start = start + len; /* Move window past decimal number. */ 524 size = size - len; 525 526 527 /* Now look for right parenthesis. */ 528 529 call et_util$skip (state_ptr, start, size); 530 531 if substr (window, 1, 1) ^= ")" 532 then goto error_missing_right_paren; 533 534 535 start = start + 1; /* Move window past the ")". */ 536 size = size - 1; 537 538 539 return; 540 541 542 543 544 error_missing_right_paren: 545 546 code = 411; 547 548 call com_err_ (0, "ET", "^d Error in repetition factor - right parenthesis missing.", code); 549 550 551 end get_repetition_num; 552 /* */ 553 get_data_off: procedure; 554 555 556 /* This procedure is called to process the "-do" option. The field after the 557* * "-do" must be a decimal number from -128 to +7. This number will be used to 558* * begin the data string at the CHARACTER which is offset the specified number of 559* * characters from character 0 of the first word of the second page of the data area. 560* * The number may be signed or unsigned. We will convert and validate this number 561* * and if it is OK we will: 562* * 1. Determine the effective character position in the first word of daata. 563* * This is stored in the corresponding data_offsets entry. 564* * 2. Adjust OUR data pointer for this data field. 565* * 3. Adjust the effective address of the descriptor which points to the data field. 566* * How this is done depends upon the modification used in this descriptor. 567**/ 568 569 570 571 if substr (window, 1, 3) ^= "-do" 572 573 then do; 574 code = 421; 575 call com_err_ (0, "ET", "^d Unknown data statement option: ^a", 576 code, substr (window, 1, 5)); 577 return; 578 end; 579 580 581 if save_offset ^= 0 582 583 then do; 584 code = 422; 585 call com_err_ (0, "ET", "^d ""-do"" option entered twice.", code); 586 return; 587 end; 588 589 590 start = start + 3; /* Move window past the option name. */ 591 size = size - 3; 592 593 594 call et_util$skip (state_ptr, start, size); 595 596 597 call et_util$convert_decimal (state_ptr, start, size, dec_num, code); 598 599 if code ^= 0 then return; 600 601 602 if (dec_num < -128) | (dec_num > 4096) 603 604 then do; 605 code = 423; 606 call com_err_ (0, "ET", "^d Illegal data offset: ^d", code, dec_num); 607 return; 608 end; 609 610 611 /* Now check to be sure that this data statement may have a "-do" option field. 612* * Some data 3 statements are only used to input test data. 613**/ 614 615 if (^et_instr_data$instructions (instr_num).desc_3_flag) & 616 (dx = 3) & (test_x = 3) 617 618 then do; 619 code = 424; 620 call com_err_ (0, "ET", "^d -do option not allowed in this data 3 statement.", code); 621 return; 622 end; 623 624 625 save_offset = dec_num; /* Save offset value. Needed at end. */ 626 627 628 /* Figure out offset of string in first word. */ 629 if dec_num > -1 630 631 then data_offsets (dx) = dec_num - (divide (dec_num, 4, 17, 0) * 4); 632 633 else do; 634 i = - dec_num; 635 data_offsets (dx) = 4 - (i - (divide (i, 4, 17, 0) * 4)); 636 if data_offsets (dx) = 4 637 then data_offsets (dx) = 0; 638 end; 639 640 641 /* Adjust our own data pointer. */ 642 643 call et_util$char_rel (data_ptrs (dx), dec_num); 644 645 646 /* We must adjust the effective address of this data's descriptor. Note, the offset 647* * is dec_num is a character offset. 648**/ 649 650 if mf_ptrs (dx) ^= null () /* Is there an mf field for this descriptor? */ 651 652 653 then do; /* YES, see if AR modification specified. */ 654 655 if mf_ptrs (dx) -> mf_map.ar 656 then do; /* AR mod, adjust pointer. */ 657 call et_util$char_rel (pointers (dx), dec_num); 658 return; 659 end; 660 end; 661 662 663 /* Either there was no mf field or the mf field did not specify AR or REG modification. 664* * In either case we will have to adjust the word offset field in the descriptor itself. 665* * This implies that the character offset specified by the user must be a multiple 666* * of 4. If it isn't then there is an error. 667**/ 668 669 len = divide (dec_num, 4, 17, 0); 670 671 if (dec_num - len * 4) ^= 0 672 673 then do; 674 code = 425; 675 call com_err_ (0, "ET", "^d Data offset must be multiple of 4 - only word modification possible.", code); 676 return; 677 end; 678 679 /* Offset is a multiple of the word size so we will adjust the descriptor offset field. */ 680 681 addr (descriptors (dx)) -> desc_map.y = 682 addr (descriptors (dx)) -> desc_map.y + len; 683 684 685 end get_data_off; 686 /* */ 687 get_ascii_data: procedure; 688 689 690 /* This procedure is called to move ASCII type input data into a set up data area in 691* * etx. It will move all of the data into a temporary buffer. Then using the 692* * repetiton factor it will move this string into the set up data area. 693**/ 694 695 696 697 temp_buf_len = 0; /* Initialize values dealing with */ 698 temp_buf_start = 1; /* temporary buffer. */ 699 700 701 702 ascii_loop: /* This loop will get all the character up to 703* * then next quote and move them into the 704* * temporary buffer. */ 705 706 707 start = start + 1; /* Move window past the left quote. */ 708 size = size - 1; 709 710 711 len = search (window, quote); /* Look for the right hand quote. */ 712 713 if len = 0 /* Did we find a quote? */ 714 then do; /* NO. */ 715 code = 421; 716 call com_err_ (0, "ET", "^d Missing right quote in ASCII input string.", code); 717 return; 718 end; 719 720 721 len = len - 1; /* Get the actual number of characters in 722* * the string. */ 723 724 725 /* If the string is not null and the input buffer will not be overflowed then 726* * we will move the string into the temporary buffer. 727**/ 728 729 if temp_buf_len + len > 256 /* Is the input string too long? */ 730 731 then do; /* YES. */ 732 code = 422; 733 call com_err_ (0, "ET", "^d ASCII input field qreater than 256 characters.", code); 734 return; 735 end; 736 737 738 if len ^= 0 739 740 then substr (temp_buf, temp_buf_start, len) = substr (window, 1, len); 741 742 743 /* Now that the data has been moved add to the temporary totals. */ 744 745 temp_buf_start = temp_buf_start + len; 746 temp_buf_len = temp_buf_len + len; 747 748 start = start + len + 1; /* Move window past the end of this string */ 749 size = size - len - 1; /* and past the right quote. */ 750 751 752 /* Now look for an embedded quote. It will be expressed as a dbouble quote. 753* * Thus if the next character is a quote we will move this one character into the 754* * temporary buffer and then go back to the beginning of the loop to finish processing 755* * the rest of the string. 756**/ 757 758 if substr (window, 1, 1) = quote 759 760 then do; 761 762 substr (temp_buf, temp_buf_start, 1) = quote; 763 764 temp_buf_start = temp_buf_start + 1; 765 temp_buf_len = temp_buf_len+ 1; 766 767 start = start + 1; 768 size = size - 1; 769 770 goto ascii_loop; /* The loop is set up just to look for 771* * embedded quotes. */ 772 end; 773 774 775 776 /* We have finished processing the whole input ASCII string for the field. Now using 777* * the repetition factor we will move it into the set up data area. 778**/ 779 780 call move_data; 781 782 783 end get_ascii_data; 784 /* */ 785 get_octal_data: procedure; 786 787 788 /* This procedure is called to process a STRING of octal digit characters. The 789* * converted string will be moved into the set up data area using the repition 790* * factor. 791**/ 792 793 794 795 len = 1; /* Start converted string at the beginning 796* * of the temporary buffer. */ 797 798 799 octal_loop: /* Each iteration of this loop will process 800* * 1 octal digit character. */ 801 802 do i = 0 to 7; 803 804 if substr (window, len, 1) = oct_chars (i) 805 806 then do; 807 addr (temp_buf) -> oct_array (len) = oct_bits (i); 808 len = len + 1; 809 goto octal_loop; 810 end; 811 end; 812 813 len = len - 1; /* Get the actual number of octal digits 814* * found in this string. */ 815 816 if len < 1 817 then do; 818 code = 431; 819 call com_err_ (0, "ET", "^d No octal digit found in octal field: ^a", 820 code, substr (window, len, 1)); 821 return; 822 end; 823 824 825 do i = 1 to 2; 826 addr (temp_buf) -> oct_array (len+i) = oct_bits (0); 827 end; 828 829 start = start + len; /* Move window to after the octal string. */ 830 size = size - len; 831 832 len = len + 2; /* Get number of characters to move. */ 833 temp_buf_len = divide (len, 3, 17, 0); 834 835 call move_data; 836 837 838 839 end get_octal_data; 840 /* */ 841 move_data: procedure; 842 843 844 /* This procedure is called to move the data in the temporary buffer into the 845* * set up data area for this statement. This operation will be performed as many 846* * times as specified in the repetiton factor for this field. 847**/ 848 849 850 do i = 1 to rep_num; 851 852 data_lens (dx) = data_lens (dx) + 1; /* Get starting position in data area. */ 853 854 substr (data_area, data_lens (dx), temp_buf_len) = 855 856 substr (temp_buf, 1, temp_buf_len); 857 858 data_lens (dx) = data_lens (dx) -1 + temp_buf_len; 859 860 end; 861 862 863 rep_num = 1; /* Reset the repitition number for the 864* * next field that is input. The repitition 865* * number is valid for only one field at 866* * a time. */ 867 868 869 end move_data; 870 871 872 873 end et_data; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/03/82 1020.5 et_data.pl1 >spec>on>phx-dir>et_data.pl1 266 1 05/06/74 1741.2 et_instr_data_map.incl.pl1 >ldd>include>et_instr_data_map.incl.pl1 268 2 06/02/82 1246.3 et_setup_data.incl.pl1 >spec>on>phx-dir>et_setup_data.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. addr builtin function dcl 256 ref 274 328 329 330 681 681 807 826 addrel builtin function dcl 256 ref 439 444 ar based bit(1) level 2 packed unaligned dcl 186 ref 655 arg_et_data_ptr parameter pointer dcl 62 ref 11 277 code parameter fixed bin(35,0) dcl 62 set ref 11 303* 304* 347* 348* 408 413* 544* 548* 574* 575* 584* 585* 597* 599 605* 606* 619* 620* 674* 675* 715* 716* 732* 733* 818* 819* com_err_ 000020 constant entry external dcl 245 ref 304 348 413 548 575 585 606 620 675 716 733 819 data_area based char(4352) dcl 155 set ref 854* data_lens 72 based fixed bin(17,0) array level 2 dcl 2-14 set ref 436 461* 461 462* 462 464* 852* 852 854 858* 858 data_offsets 77 based fixed bin(17,0) array level 2 dcl 2-14 set ref 475* 475 629* 635* 636 636* data_ptr 000116 automatic pointer dcl 119 set ref 357* 459 854 data_ptrs 60 based pointer array level 2 dcl 2-14 set ref 429 439 444 459* 473* 473 643* data_statement based structure level 1 packed unaligned dcl 141 dec_num 000105 automatic fixed bin(17,0) dcl 97 set ref 597* 602 602 606* 625 629 629 629 634 643* 657* 669 671 desc_3_flag 1(29) 000036 external static bit(1) array level 2 packed unaligned dcl 1-15 ref 340 615 desc_map based structure level 1 packed unaligned dcl 175 descriptors 31 based bit(36) array level 2 dcl 2-14 set ref 681 681 divide builtin function dcl 256 ref 629 635 669 833 dx 000106 automatic fixed bin(17,0) dcl 97 set ref 297* 340 357 429 429 436 439 439 444 444 455 461 462 464 469 473 475 615 629 635 636 636 643 650 655 657 681 681 852 852 854 858 858 et_data_ptr 000222 automatic pointer dcl 2-11 set ref 277* 315 317 340 429 429 436 439 439 444 444 459 461 461 462 462 464 473 473 475 475 615 629 635 636 636 643 650 655 657 681 681 852 852 854 858 858 et_instr_data$instructions 000036 external static structure array level 1 dcl 1-15 et_setup_data based structure level 1 dcl 2-14 et_util$char_rel 000026 constant entry external dcl 245 ref 643 657 et_util$convert_decimal 000024 constant entry external dcl 245 ref 597 et_util$skip 000022 constant entry external dcl 245 ref 287 367 501 529 594 etx$set_data1 000030 external static fixed bin(17,0) dcl 245 set ref 328 etx$set_data2 000032 external static fixed bin(17,0) dcl 245 set ref 329 etx$set_data3 000034 external static fixed bin(17,0) dcl 245 set ref 330 fixed builtin function dcl 256 ref 297 520 i 000107 automatic fixed bin(17,0) dcl 97 set ref 634* 635 635 799* 804 807* 825* 826* 850* init_flag 000016 internal static fixed bin(17,0) initial dcl 230 set ref 325 331* instr_num 26 based fixed bin(17,0) level 2 dcl 2-14 ref 315 317 340 615 len 000110 automatic fixed bin(17,0) dcl 97 set ref 292* 294 510* 512 517* 517 520 523 524 669* 671 681 711* 713 721* 721 729 738 738 738 745 746 748 749 795* 804 807 808* 808 813* 813 816 819 819 826 829 830 832* 832 833 length builtin function dcl 256 ref 275 mf_map based structure level 1 packed unaligned dcl 186 mf_ptrs 46 based pointer array level 2 dcl 2-14 ref 650 655 next_statement_x 000104 automatic fixed bin(17,0) dcl 79 set ref 275* 280 412 null builtin function dcl 256 ref 650 oct_array based bit(3) array unaligned dcl 162 set ref 807* 826* oct_bits 000000 constant bit(3) initial array unaligned dcl 220 ref 807 826 oct_chars 000002 constant char(1) initial array unaligned dcl 216 ref 804 page_ptrs 106 based pointer array level 2 dcl 2-14 set ref 429* 439* 444* pointers 144 based pointer array level 2 dcl 2-14 set ref 657* quote 002654 constant char(1) initial unaligned dcl 211 ref 395 711 758 762 rep_num 000111 automatic fixed bin(17,0) dcl 97 set ref 321* 520* 850 863* result_x 1(33) 000036 external static fixed bin(2,0) array level 2 in structure "et_instr_data$instructions" packed unaligned dcl 1-15 in procedure "et_data" ref 317 result_x 000112 automatic fixed bin(17,0) dcl 97 in procedure "et_data" set ref 317* 469 rx constant fixed bin(17,0) initial dcl 204 ref 462 473 475 save_offset 000113 automatic fixed bin(17,0) dcl 97 set ref 282* 429 436* 436 439 444 581 625* search builtin function dcl 256 ref 711 set_data_ptrs 000010 internal static pointer array dcl 230 set ref 328* 329* 330* 357 size 000103 automatic fixed bin(35,0) dcl 79 set ref 280* 287* 292 297 299* 299 304 304 367* 377 385 390 395 412* 413 413 494* 494 501* 510 520 524* 524 529* 531 536* 536 571 575 575 591* 591 594* 597* 708* 708 711 738 749* 749 758 768* 768 804 819 819 830* 830 start 000102 automatic fixed bin(35,0) dcl 79 set ref 279* 287* 292 297 298* 298 304 304 367* 377 385 390 395 411* 413 493* 493 501* 510 520 523* 523 529* 531 535* 535 571 575 575 590* 590 594* 597* 702* 702 711 738 748* 748 758 767* 767 804 819 819 829* 829 state_ptr 000100 automatic pointer dcl 79 set ref 274* 287* 292 297 304 304 367* 377 385 390 395 413 501* 510 520 529* 531 571 575 575 594* 597* 711 738 758 804 819 819 statement parameter char unaligned dcl 62 set ref 11 274 275 substr builtin function dcl 256 set ref 292 297 304 304 377 385 390 395 520 531 571 575 575 738* 738 758 762* 804 819 819 854* 854 temp_buf 000120 automatic char(256) dcl 123 set ref 319* 738* 762* 807 826 854 temp_buf_len 000220 automatic fixed bin(17,0) dcl 123 set ref 697* 729 746* 746 765* 765 833* 854 854 858 temp_buf_start 000221 automatic fixed bin(17,0) dcl 123 set ref 698* 738 745* 745 762 764* 764 test_x 000114 automatic fixed bin(17,0) dcl 97 in procedure "et_data" set ref 315* 340 455 615 test_x 1(30) 000036 external static fixed bin(2,0) array level 2 in structure "et_instr_data$instructions" packed unaligned dcl 1-15 in procedure "et_data" ref 315 tx constant fixed bin(17,0) initial dcl 204 ref 459 461 verify builtin function dcl 256 ref 292 510 window based char level 2 packed unaligned dcl 141 set ref 292 297 304 304 377 385 390 395 413* 510 520 531 571 575 575 711 738 758 804 819 819 y 0(03) based fixed bin(14,0) level 2 packed unaligned dcl 175 set ref 681* 681 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. char_word based char(4) dcl 167 et_instr_data$num_instructions external static fixed bin(17,0) dcl 1-12 NAMES DECLARED BY EXPLICIT CONTEXT. ascii_loop 001637 constant label dcl 702 ref 770 end_of_data 000644 constant label dcl 429 ref 377 error_missing_right_paren 001104 constant label dcl 544 set ref 512 531 et_data 000245 constant entry external dcl 11 get_ascii_data 001633 constant entry internal dcl 687 ref 395 get_data_off 001143 constant entry internal dcl 553 ref 390 get_octal_data 002051 constant entry internal dcl 785 ref 400 get_repetition_num 000753 constant entry internal dcl 483 ref 385 input_loop 000531 constant label dcl 367 set ref 418 move_data 002222 constant entry internal dcl 841 ref 780 835 octal_loop 002054 constant label dcl 799 ref 809 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2774 3034 2660 3004 Length 3260 2660 40 207 113 10 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME et_data 676 external procedure is an external procedure. get_repetition_num internal procedure shares stack frame of external procedure et_data. get_data_off internal procedure shares stack frame of external procedure et_data. get_ascii_data internal procedure shares stack frame of external procedure et_data. get_octal_data internal procedure shares stack frame of external procedure et_data. move_data internal procedure shares stack frame of external procedure et_data. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 set_data_ptrs et_data 000016 init_flag et_data STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME et_data 000100 state_ptr et_data 000102 start et_data 000103 size et_data 000104 next_statement_x et_data 000105 dec_num et_data 000106 dx et_data 000107 i et_data 000110 len et_data 000111 rep_num et_data 000112 result_x et_data 000113 save_offset et_data 000114 test_x et_data 000116 data_ptr et_data 000120 temp_buf et_data 000220 temp_buf_len et_data 000221 temp_buf_start et_data 000222 et_data_ptr et_data THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry_desc any_to_any_tr THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ et_util$char_rel et_util$convert_decimal et_util$skip THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. et_instr_data$instructions etx$set_data1 etx$set_data2 etx$set_data3 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000241 274 000260 275 000263 277 000264 279 000267 280 000271 282 000274 287 000275 292 000307 294 000321 297 000325 298 000340 299 000344 300 000352 303 000353 304 000356 305 000417 315 000420 317 000432 319 000436 321 000441 325 000443 328 000446 329 000450 330 000452 331 000454 340 000456 347 000467 348 000472 349 000524 357 000525 367 000531 377 000544 385 000554 390 000560 395 000564 400 000570 408 000571 411 000574 412 000575 413 000577 414 000642 418 000643 429 000644 436 000662 439 000666 444 000703 455 000721 459 000724 461 000727 462 000732 464 000735 469 000736 473 000741 475 000747 873 000752 483 000753 493 000754 494 000760 501 000766 510 001001 512 001016 517 001020 520 001022 523 001036 524 001042 529 001050 531 001063 535 001071 536 001075 539 001103 544 001104 548 001107 551 001142 553 001143 571 001144 574 001152 575 001155 577 001221 581 001222 584 001224 585 001227 586 001262 590 001263 591 001267 594 001275 597 001310 599 001330 602 001334 605 001341 606 001343 607 001402 615 001403 619 001421 620 001423 621 001455 625 001456 629 001460 634 001472 635 001474 636 001506 643 001511 650 001524 655 001532 657 001537 658 001550 669 001551 671 001554 674 001561 675 001564 676 001617 681 001620 685 001632 687 001633 697 001634 698 001635 702 001637 708 001643 711 001651 713 001666 715 001667 716 001672 717 001725 721 001726 729 001730 732 001734 733 001737 734 001772 738 001773 745 002001 746 002002 748 002003 749 002010 758 002021 762 002026 764 002032 765 002033 767 002034 768 002040 770 002046 780 002047 783 002050 785 002051 795 002052 799 002054 804 002060 807 002071 808 002101 809 002102 811 002103 813 002105 816 002107 818 002112 819 002115 821 002164 825 002165 826 002172 827 002177 829 002201 830 002205 832 002213 833 002215 835 002220 839 002221 841 002222 850 002223 852 002232 854 002235 858 002243 860 002247 863 002251 869 002253 ----------------------------------------------------------- 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