COMPILATION LISTING OF SEGMENT apl_dim_read_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 11/29/83 1600.8 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 /* Read portion of the APL Device Interface Module. 11* Stolen from the "code_converter" module (which was stolen 12* from hardcore TTYDIM) by Paul Green, July, 1973. */ 13 14 /* Modified 740530 by PG to add tabsin mode to control changing spaces to tabs on input */ 15 /* Modified 741018 by PG for variable tab width. */ 16 /* Modified 780503 by William York to allow erasing of illegal characters to work. */ 17 /* Modified 781208 by PG to switch to clock builtin */ 18 /* Modified 790614 by PG use iox_-style calls. */ 19 /* Modified 790910 by PG to fix 295 (quit-editing w/o BS or CR left in LF) */ 20 21 /* format: style3 */ 22 apl_dim_read_: 23 procedure (sdb_ptr, readp, offset, nelem, nelemt, bv_status); 24 25 /* parameters */ 26 27 dcl ( 28 readp ptr, /* ptr to caller's buffer */ 29 offset fixed bin, /* offset in caller's buffer */ 30 nelem fixed bin (21), /* number of elements desired by caller */ 31 nelemt fixed bin (21), /* number of elements actually transmitted */ 32 bv_status bit (72) aligned /* I/O system status */ 33 ) parameter; 34 35 /* automatic */ 36 37 dcl (col, number_of_spaces, old_read_back_state, normal_read_n_transmitted, line, toffset, act, move, c, i, ini, outi, 38 outimax, sum, tpini) 39 fixed bin (21), 40 (outp, rbufp) ptr, 41 temp_ptr ptr, 42 inchar bit (9), 43 shift bit (2), 44 (oneshift, pass2, prefsw, target_eof) 45 bit (1), 46 real_time fixed bin (71); 47 48 /* entries */ 49 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)), 50 iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 51 iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)), 52 apl_dim_canonicalize_ 53 entry (ptr, ptr, fixed bin (21), fixed bin (21)); 54 55 /* based */ 56 57 declare based_string char (nelemt) based; 58 declare char_array (0:1044479) char (1) unaligned based; 59 60 dcl 1 char based (rbufp) aligned, /* to ref strings */ 61 2 a (0:1) bit (9) unaligned; 62 63 /* builtins */ 64 65 declare (addr, binary, bit, clock, fixed, hbound, length, mod, null, substr) 66 builtin; 67 68 /* conditions */ 69 70 declare apl_quit_ condition; 71 72 /* named constants (internal static initial) */ 73 74 declare character_error_message 75 char (11) internal static options (constant) initial ("char error 76 "); 77 78 /* include files */ 79 1 1 /* ====== BEGIN INCLUDE SEGMENT apl_dim_sdb.incl.pl1 ====================================== */ 1 2 1 3 /* format: style3,initlm0,idind30 */ 1 4 dcl sdb_ptr ptr; 1 5 1 6 dcl 1 stream_data_block aligned based (sdb_ptr), 1 7 2 outer_module_name char (32) init (my_name), 1 8 /* standard I/O System SDB header */ 1 9 2 device_name_list_ptr ptr init (addr (stream_data_block.device_name)), 1 10 2 device_name aligned, 1 11 3 next_ptr ptr init (null ()), 1 12 3 name_size fixed bin init (length (att_stream)), 1 13 3 name char (32) init (att_stream), 1 14 2 device_iocb_ptr ptr, /* ptr to IOCB for sdb.name */ 1 15 2 iocb_ptr ptr, /* ptr to IOCB for this attachment */ 1 16 /* info about conversion tables */ 1 17 2 sequence_table_ptr ptr, /* points to escape sequences in use */ 1 18 2 device_info_ptr ptr init (null ()), /* pointer to dev-info table */ 1 19 2 conv_tab_ptr ptr init (null ()), /* pointer to conversion tables */ 1 20 2 compression_in_ptr ptr initial (null ()), 1 21 /* pointer to compression input table */ 1 22 2 compression_out_ptr ptr initial (null ()), 1 23 /* pointer to compression output table */ 1 24 /* parameters of the device */ 1 25 2 keying_time fixed bin (71) init (0), 1 26 /* keying time of device */ 1 27 2 max_col fixed bin init (-1),/* number of columns per line */ 1 28 2 max_line fixed bin init (-1),/* number of lines per frame */ 1 29 2 actcol fixed bin init (0), /* present column */ 1 30 2 actline fixed bin init (0), /* present line */ 1 31 2 actshift unal bit (2) init ("11"b), 1 32 /* present shift */ 1 33 /* modes of the device */ 1 34 2 tabm unal bit (1) init ("1"b), 1 35 /* tabs may be used */ 1 36 2 conm unal bit (1) init ("1"b), 1 37 /* canonicalization should be performed */ 1 38 2 graphic unal bit (1) init ("0"b), 1 39 /* graphic mode */ 1 40 2 escm unal bit (1) init ("1"b), 1 41 /* processing escapes on input */ 1 42 2 erklm unal bit (1) init ("1"b), 1 43 /* erase/kill on */ 1 44 2 rawim unal bit (1) init ("0"b), 1 45 /* raw input mode */ 1 46 2 red_mode unal bit (1) init ("1"b), 1 47 /* red/black shifts may be transmitted */ 1 48 2 escape_out_seen unal bit (1) init ("0"b), 1 49 /* user typed overstruck O-U-T */ 1 50 2 tabsin_mode unal bit (1) init ("0"b), 1 51 /* ON means let tabs thru, OFF means change to spaces */ 1 52 2 hndlquit_mode unal bit (1) init ("1"b), 1 53 /* ON means dim does reset(read write), OFF it doesn't */ 1 54 2 padding unal bit (24), 1 55 2 read_back fixed bin init (0), /* input processing mode */ 1 56 /* info about read/write buffers */ 1 57 2 canonicalization_index fixed bin init (1), /* offset in canonicalization_buffer of next "free" char */ 1 58 2 read_offset fixed bin init (-1),/* offset in canonicalization_buffer of first character */ 1 59 2 character_error_index fixed bin init (-1),/* index of last good character */ 1 60 2 error_mark_column fixed bin init (0), /* column error marker goes in */ 1 61 2 inimax fixed bin init (0), /* index of last char (0-origin) + 1 */ 1 62 2 tab_width fixed bin init (10),/* how wide a tab stop is. */ 1 63 2 baud_rate fixed bin init (0), /* see apl_dim_table.incl.pl1 */ 1 64 2 internal_type unal dim (0:255) bit (9), 1 65 /* copied from device_info.code_move */ 1 66 2 canonicalization_buffer char (512), 1 67 2 normal_read_buffer char (512), 1 68 2 quit_read_buffer char (512); 1 69 1 70 dcl 1 type unal dim (0:255) defined (stream_data_block.internal_type (0)), 1 71 /* indexed by internal code */ 1 72 2 white bit (1), /* on if white space char */ 1 73 2 red bit (1), /* on if red/black shift char */ 1 74 2 action bit (4), /* 0 none, 1 esc, 2 erase, 3 kill, 4 delim, 5 break */ 1 75 2 move bit (3); /* 0=+1, 1=0, 2=-1, 3=tab, 4=cr, 5=nl, 6=np, 7=vt */ 1 76 1 77 /* constants for stream_data_block.read_back field. */ 1 78 1 79 declare read_back_names char (16) dimension (0:2) internal static options (constant) 1 80 initial ("read_back_spaces", "read_back_input", "read_back_output"); 1 81 1 82 dcl ( 1 83 read_back_spaces init (0), /* just keep track of column input starts in */ 1 84 read_back_input init (1), /* just read what user typed */ 1 85 read_back_output init (2) /* remember output & recanonicalize entire line */ 1 86 ) fixed bin internal static options (constant); 1 87 1 88 dcl status bit (72); 1 89 1 90 dcl 1 status_bits based (addr (status)), 1 91 2 status_code fixed bin (35), 1 92 ( 1 93 2 logical_initiation bit (1), 1 94 2 logical_completion bit (1), 1 95 2 physical_initiation bit (1), 1 96 2 physical_completion bit (1), 1 97 2 transaction_terminated bit (1), 1 98 2 unused_42_45 bit (4), 1 99 2 end_of_logical_data bit (1), 1 100 2 end_of_physical_data bit (1), 1 101 2 unused_48_51 bit (4), 1 102 2 stream_detached bit (1), 1 103 2 unused_53 bit (1), 1 104 2 transaction_aborted bit (1), 1 105 2 transaction_index bit (18) 1 106 ) unaligned; 1 107 1 108 /* ------ END INCLUDE SEGMENT apl_dim_sdb.incl.pl1 -------------------------------------- */ 80 2 1 /* ====== BEGIN INCLUDE SEGMENT apl_dim_table.incl.pl1 ==================================== */ 2 2 2 3 dcl (conversion_ptr, device_ptr, sequence_ptr) ptr, 2 4 n fixed bin; 2 5 2 6 dcl ( baud_rate_110 init (0), 2 7 baud_rate_150_or_134 init (1), 2 8 baud_rate_300 init (2), 2 9 baud_rate_1200 init (3) 2 10 ) fixed bin internal static options (constant); 2 11 2 12 2 13 dcl 1 device_info based (device_ptr) aligned, 2 14 2 conversion_offset unal bit (18), 2 15 2 sequence_offset unal bit (18), 2 16 2 compression_in_offset unal bit (18), 2 17 2 compression_out_offset unal bit (18), 2 18 2 device_name unal char (32), 2 19 2 graphic_terminal unal bit (1), 2 20 2 shift_needed unal bit (1), 2 21 2 quit_editing_allowed unal bit (1), 2 22 2 unused_bits_1 unal bit (15), 2 23 2 linefeed_character_device unal bit (9), 2 24 2 escape_character_code unal bit (9), /* internal 8-bit code */ 2 25 2 delay_character unal bit (9), 2 26 2 upper_case unal bit (9), 2 27 2 lower_case unal bit (9), 2 28 2 escape_character_device unal bit (9), /* external 7-bit device */ 2 29 2 default_page_length unal fixed bin (17), 2 30 2 default_line_length unal fixed bin (17), 2 31 2 pad_info dim (0:3) aligned, /* 110, 150, 300, 1200 */ 2 32 3 nl_addend unal fixed bin (17), 2 33 3 nl_multiplier unal fixed bin (17), 2 34 3 tab_addend unal fixed bin (17), 2 35 3 tab_multiplier unal fixed bin (17), 2 36 3 bs_n_pads unal fixed bin (17), /* number of pads after bs. */ 2 37 3 np_n_pads unal fixed bin (17), /* number of pads after new page. */ 2 38 2 editing_prompt varying char (8); 2 39 2 40 dcl 1 conversions based (conversion_ptr) aligned, 2 41 2 out unal dim (0:255) bit (9), /* internal 8-bit code to external 7-bit device */ 2 42 2 in unal dim (0:127) bit (9), /* external 7-bit device to internal 8-bit code */ 2 43 2 code_move unal dim (0:255) bit (9), /* internal movement of code */ 2 44 2 device_move unal dim (0:127) bit (6), /* external movement of device */ 2 45 2 unused_1 unal bit (24), 2 46 2 size fixed bin, 2 47 2 escape dim (0:n refer (conversions.size)), 2 48 3 prefix unal bit (1), 2 49 3 conceal unal bit (1), 2 50 3 unused_2 unal bit (7), 2 51 3 inchar unal bit (9), 2 52 3 outchar unal bit (9), 2 53 3 unused_3 unal bit (9); 2 54 2 55 dcl 1 sequence based (sequence_ptr) aligned, 2 56 2 size unal fixed bin (8), 2 57 2 characters unal dim (sequence.size) bit (9); 2 58 2 59 dcl 1 compression_in based (compression_in_ptr) aligned, 2 60 2 size fixed bin, 2 61 2 compression_string char (compression_in.size); 2 62 2 63 dcl 1 compression_out based (compression_out_ptr) aligned, 2 64 2 size fixed bin, 2 65 2 output_character dim (compression_out.size) unal bit (9); 2 66 2 67 /* ------ END INCLUDE SEGMENT apl_dim_table.incl.pl1 ------------------------------------ */ 81 82 83 /* program */ 84 85 begin: 86 oneshift, pass2, prefsw, target_eof = "0"b; 87 88 bv_status = ""b; 89 if rawim 90 then do; 91 real_time = clock (); 92 temp_ptr = addr (readp -> char_array (offset)); 93 call iox_$get_line (stream_data_block.device_iocb_ptr, temp_ptr, nelem, nelemt, status_code); 94 bv_status = status; 95 keying_time = keying_time + clock () - real_time; 96 return; 97 end; 98 ini = read_offset; 99 outimax = offset + nelem; 100 outp = readp; 101 nelemt = 0; 102 device_ptr = device_info_ptr; /* get pointer to device info table */ 103 conversion_ptr = conv_tab_ptr; /* pointer to conversion tables */ 104 rbufp = addr (canonicalization_buffer); 105 106 if ini < 0 107 then do; 108 call getmore; 109 ini = 0; 110 end; 111 112 /* Now that the characters have been read, begin processing them. 113* If no carriage return or backspace was typed, canonicalization is done by this program; 114* otherwise all canonicalization is done by "apl_dim_canonicalize_". */ 115 116 tpini = ini; 117 toffset = offset; 118 again: 119 outi = toffset; 120 shift = actshift; 121 col = actcol; 122 line = actline; 123 character_error_index = -1; 124 iloop: 125 if outimax <= outi /* if no more space */ 126 then go to rdone; /* quit right now */ 127 128 if ini >= inimax 129 then call getmore; 130 131 132 if shift 133 then substr (char.a (ini), 3, 1) = shift; /* if shifting console, add present shift state */ 134 135 inchar = in (binary (char.a (ini), 9)); /* convert char to ascii */ 136 ini = ini + 1; /* bump input index */ 137 138 haveascii: 139 if inchar & "100000000"b /* if special control char */ 140 then do; 141 i = binary (substr (inchar, 3, 7), 7); /* get action code */ 142 143 if i = 0 144 then shift = "01"b; /* go to lower case */ 145 else if i = 1 /* go to upper case */ 146 then shift = "10"b; 147 else if i = 2 /* one char shift */ 148 then oneshift = "1"b; 149 else if i = 3 /* pref */ 150 then do; 151 if ini >= inimax 152 then call getmore; 153 154 if shift 155 then substr (char.a (ini), 3, 1) = shift; 156 /* add shift bit */ 157 158 inchar = char.a (ini) & "001111111"b; 159 /* get raw code */ 160 ini = ini + 1; 161 prefsw = "1"b; /* search should look for prefix def. */ 162 163 prefesc: 164 do i = 0 to hbound (escape (*), 1); 165 /* search prefix/escape table */ 166 if inchar = escape (i).inchar 167 /* if match */ 168 then if escape (i).prefix = prefsw 169 /* and right kind */ 170 then do; 171 inchar = escape (i).outchar; 172 /* get results */ 173 if escape (i).conceal 174 /* if char is to be concealed */ 175 then go to store; 176 /* then don't look at it */ 177 else go to haveascii; 178 end; 179 end; 180 if prefsw /* if not found in table */ 181 then go to iloop; /* ignore pref and char */ 182 end; 183 else if i = 5 /* character error */ 184 then do; 185 if pass2 /* if 2nd pass required */ 186 then do; 187 inchar = "100011010"b; 188 /* tell 2nd pass to do it */ 189 go to store; 190 end; 191 192 if character_error_index < 0 /* if no errors yet */ 193 then character_error_index = outi - toffset; 194 195 go to bad_char_exit; 196 end; 197 198 go to iloop; 199 end; 200 201 bad_char_exit: 202 if inchar & "100000000"b 203 then act = 0; 204 else act = binary (type (binary (inchar, 9)).action, 4); 205 /* if normal char */ 206 207 if inchar & "100000000"b 208 then move = 0; 209 else move = binary (type (binary (inchar, 9)).move, 3); 210 /* get action and movement code */ 211 212 if (move = 2) | (move = 4) | (act = 5) /* bs, cr or quit-edit linefeed...second pass required */ 213 then if ^pass2 /* if not already set */ 214 then if conm /* and in canonical mode */ 215 then do; 216 pass2 = "1"b; 217 ini = tpini; 218 go to again; /* start conversion over */ 219 end; 220 221 go to new_col (move); /* switch on column move code */ 222 223 new_col (0): 224 col = col + 1; /* normal +1 movement */ 225 go to end_col; 226 227 new_col (1): 228 go to end_col; /* no movement */ 229 230 new_col (2): 231 if col > 0 232 then col = col - 1; /* backspace */ 233 go to end_col; 234 235 new_col (3): /* tab */ 236 if stream_data_block.tab_width < 2 /* turned off */ 237 then number_of_spaces = 1; /* treat like SP */ 238 else number_of_spaces = stream_data_block.tab_width - mod (col, stream_data_block.tab_width); 239 col = col + number_of_spaces; 240 if ^tabsin_mode 241 then do; 242 substr (outp -> based_string, outi + 1, number_of_spaces) = " "; 243 outi = outi + number_of_spaces; 244 go to iloop; 245 end; 246 go to end_col; 247 248 new_col (4): 249 col = 0; /* carriage return */ 250 go to end_col; 251 252 new_col (5): 253 col = 0; 254 line = line + 1; /* new line */ 255 go to end_col; 256 257 new_col (6): 258 col = 0; 259 line = 0; /* new page */ 260 go to end_col; 261 262 new_col (7): 263 line = line + 10 - mod (line, 10); /* vertical tab */ 264 265 end_col: 266 if act = 0 /* normal */ 267 then do; 268 if oneshift /* if char to be shifted */ 269 then do; 270 substr (inchar, 3, 1) = ^substr (inchar, 3, 1); 271 /* complement 100 bit */ 272 oneshift = "0"b; 273 end; 274 275 store: 276 outp -> char.a (outi) = inchar; /* store ascii char */ 277 outi = outi + 1; 278 go to iloop; 279 end; 280 281 else if act = 2 /* if erase char */ 282 then do; 283 if ^erklm /* if not in erase kill mode */ 284 then go to store; /* then store erase char */ 285 if pass2 /* if second pass required, don't erase now */ 286 then do; 287 inchar = "100011000"b; /* tell second pass to erase */ 288 go to store; 289 end; 290 291 if outi > toffset /* if something to erase */ 292 then do; 293 if character_error_index = outi - toffset - 1 294 /* if erasing bad char */ 295 then character_error_index = -1; 296 297 outi = outi - 1; 298 if type (binary (outp -> char.a (outi), 9)).white 299 /* if prev char white */ 300 then do outi = outi by -1 to offset + 1 301 while (type (binary (outp -> char.a (outi - 1), 9)).white); 302 /* erase all white space */ 303 end; 304 end; 305 end; 306 307 else if act = 3 /* kill */ 308 then do; 309 if ^erklm /* if not in erase kill mode */ 310 then go to store; /* then store kill char */ 311 312 if pass2 /* if second pass required */ 313 then do; 314 inchar = "100011001"b; /* fake kill char */ 315 go to store; 316 end; 317 outi = toffset; /* reset output string */ 318 character_error_index = -1; /* reset any character errors */ 319 end; 320 321 else if act = 4 /* read delimiter */ 322 then do; 323 if conm 324 then if type (binary (inchar, 9)).white /* if in canonical mode */ 325 then do outi = outi by -1 to toffset + 1 while (type (binary (outp -> char.a (outi - 1), 9)).white); 326 /* erase all white space */ 327 end; 328 outp -> char.a (outi) = inchar; /* store the new line */ 329 outi = outi + 1; 330 rdone: 331 nelemt = outi - toffset; /* indicate length of returned string */ 332 if pass2 /* if second pass required, do it */ 333 then call apl_dim_canonicalize_ (sdb_ptr, outp, toffset, nelemt); 334 nelemt = nelemt + toffset - offset; 335 if ini < inimax 336 then read_offset = ini; /* more characters to be processed */ 337 else do; 338 read_offset = -1; /* read-ahead buffer is empty */ 339 if target_eof 340 then do; 341 status = ""b; 342 status_bits.end_of_logical_data = "1"b; 343 bv_status = status; /* tell caller about eof */ 344 end; 345 end; 346 347 /* Copy unprocessed portion of canonicalization_buffer down to beginning. 348* While this copy is proceeding, no QUITs may occur. */ 349 350 if read_offset ^= -1 351 then do; 352 inimax = inimax - read_offset; 353 substr (canonicalization_buffer, 1, inimax) = 354 substr (canonicalization_buffer, read_offset + 1, inimax); 355 read_offset = 0; /* zero-origin */ 356 canonicalization_index = inimax + 1; 357 /* inimax is zero-origin, canon is 1-origin */ 358 end; 359 else canonicalization_index = 1; 360 361 actshift = shift; 362 actcol = col; 363 actline = line; 364 if stream_data_block.character_error_index >= 0 365 then do; 366 367 if stream_data_block.escape_out_seen 368 then do; 369 stream_data_block.escape_out_seen = "0"b; 370 stream_data_block.character_error_index = -1; 371 signal apl_quit_; 372 return; 373 end; 374 375 call iox_$control (stream_data_block.iocb_ptr, "resetread", null, status_code); 376 377 call iox_$put_chars (stream_data_block.iocb_ptr, addr (character_error_message), 378 length (character_error_message), status_code); 379 380 old_read_back_state = stream_data_block.read_back; 381 stream_data_block.read_back = read_back_output; 382 383 if stream_data_block.character_error_index > 0 384 then call iox_$put_chars (stream_data_block.iocb_ptr, addr (outp -> char_array (toffset)), 385 (stream_data_block.character_error_index), status_code); 386 387 stream_data_block.character_error_index = -1; 388 stream_data_block.read_back = old_read_back_state; 389 390 go to begin; 391 end; 392 393 return; 394 end; 395 396 397 else if act = 1 /* esc char */ 398 then do; 399 if ^escm /* if not in escape mode, store char */ 400 then go to store; 401 c = 0; /* count for oct esc */ 402 sum = 0; /* for oct to bin conversion */ 403 escl: 404 call skip_specials; 405 if (inchar & "111111000"b) = "000110000"b 406 /* if octal number */ 407 then do; 408 sum = sum * 8 + binary (inchar, 9) - 48; 409 /* add into sum */ 410 c = c + 1; 411 if c < 3 /* if done */ 412 then go to escl; 413 shortn: 414 inchar = bit (binary (sum, 9), 9); 415 /* store converted number */ 416 go to store; 417 end; 418 if c > 0 /* if started as octal, then quit */ 419 then do; 420 ini = ini - 1; /* fix to pickup non number again */ 421 go to shortn; 422 end; 423 prefsw = "0"b; /* if not octal esc, lookup in table */ 424 go to prefesc; 425 end; 426 else if act = 5 /* canonicalization break */ 427 then do; 428 outp -> char.a (outi) = inchar; /* store the break */ 429 outi = outi + 1; 430 if pass2 431 then do; 432 nelemt = outi - toffset; 433 call apl_dim_canonicalize_ (sdb_ptr, outp, toffset, nelemt); 434 outi = toffset + nelemt; 435 pass2 = "0"b; 436 end; 437 tpini = ini; 438 toffset = outi; 439 end; 440 go to iloop; 441 442 main_program_return: 443 return; 444 445 /* INTERNAL PROCEDURES */ 446 447 getmore: 448 proc; /* get more characters to read */ 449 450 if target_eof 451 then go to rdone; 452 453 real_time = clock (); 454 status = ""b; 455 call iox_$get_line (stream_data_block.device_iocb_ptr, addr (normal_read_buffer), length (normal_read_buffer), 456 normal_read_n_transmitted, status_code); 457 keying_time = keying_time + clock () - real_time; 458 if status_code ^= 0 459 then do; 460 bv_status = status; 461 go to main_program_return; 462 end; 463 464 if actshift 465 then actshift = "01"b; /* all input begins in lower case; as does each line of output. 466* (nl is in lower case!) */ 467 468 /* if not in read_back_output or read_back_input mode, then column is ok. Otherwise 469* we are guaranteed to be in column 0. */ 470 471 if stream_data_block.read_back ^= read_back_input 472 then actcol = 0; 473 474 if normal_read_n_transmitted = 0 475 then do; 476 target_eof = "1"b; 477 go to rdone; 478 end; 479 480 if end_of_logical_data 481 then target_eof = "1"b; 482 483 status = ""b; 484 485 if canonicalization_index <= 0 /* AAARRRGGGHHH!!! */ 486 then canonicalization_index = 1; /* fix it quick... */ 487 488 substr (canonicalization_buffer, canonicalization_index, normal_read_n_transmitted) = 489 substr (normal_read_buffer, 1, normal_read_n_transmitted); 490 canonicalization_index = canonicalization_index + normal_read_n_transmitted; 491 inimax = canonicalization_index - 1; /* inimax is zero origin */ 492 493 end getmore; 494 495 skip_specials: 496 proc; /* procedure to skip over "special" chars, setting shift bits */ 497 498 loop: 499 if ini >= inimax 500 then call getmore; /* first get the characters */ 501 502 if shift 503 then substr (char.a (ini), 3, 1) = shift; /* set shift bit */ 504 505 inchar = in (binary (char.a (ini), 9)); /* get char */ 506 ini = ini + 1; 507 508 if inchar & "100000000"b /* if special */ 509 then do; 510 i = binary (substr (inchar, 3, 7), 7); 511 if i = 0 512 then shift = "01"b; /* go to lower case */ 513 else if i = 1 514 then shift = "10"b; /* go to upper case */ 515 go to loop; /* check next char */ 516 end; 517 518 return; /* with variables set */ 519 520 end skip_specials; 521 522 end /* apl_dim_read_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1346.2 apl_dim_read_.pl1 >special_ldd>on>apl.1129>apl_dim_read_.pl1 80 1 03/27/82 0429.8 apl_dim_sdb.incl.pl1 >ldd>include>apl_dim_sdb.incl.pl1 81 2 03/27/82 0438.6 apl_dim_table.incl.pl1 >ldd>include>apl_dim_table.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. a based bit(9) array level 2 packed unaligned dcl 60 set ref 132* 135 154* 158 275* 298 298 323 328* 428* 502* 505 act 000106 automatic fixed bin(21,0) dcl 37 set ref 201* 204* 212 265 281 307 321 397 426 actcol 50 based fixed bin(17,0) initial level 2 dcl 1-6 set ref 121 362* 471* action 0(02) defined bit(4) array level 2 packed unaligned dcl 1-70 ref 204 actline 51 based fixed bin(17,0) initial level 2 dcl 1-6 set ref 122 363* actshift 52 based bit(2) initial level 2 packed unaligned dcl 1-6 set ref 120 361* 464 464* addr builtin function dcl 65 ref 92 93 104 342 375 377 377 377 383 383 383 455 455 455 458 480 apl_dim_canonicalize_ 000016 constant entry external dcl 49 ref 332 433 apl_quit_ 000136 stack reference condition dcl 70 ref 371 based_string based char unaligned dcl 57 set ref 242* binary builtin function dcl 65 ref 135 141 204 204 209 209 298 298 323 323 408 413 505 510 bit builtin function dcl 65 ref 413 bv_status parameter bit(72) dcl 27 set ref 22 88* 94* 343* 460* c 000110 automatic fixed bin(21,0) dcl 37 set ref 401* 410* 410 411 418 canonicalization_buffer 163 based char(512) level 2 dcl 1-6 set ref 104 353* 353 488* canonicalization_index 54 based fixed bin(17,0) initial level 2 dcl 1-6 set ref 356* 359* 485 485* 488 490* 490 491 char based structure level 1 dcl 60 char_array based char(1) array unaligned dcl 58 set ref 92 383 383 character_error_index 56 based fixed bin(17,0) initial level 2 dcl 1-6 set ref 123* 192 192* 293 293* 318* 364 370* 383 383 387* character_error_message 000010 constant char(11) initial unaligned dcl 74 set ref 377 377 377 377 clock builtin function dcl 65 ref 91 95 453 457 col 000100 automatic fixed bin(21,0) dcl 37 set ref 121* 223* 223 230 230* 230 238 239* 239 248* 252* 257* 362 conceal 267(01) based bit(1) array level 3 packed unaligned dcl 2-40 ref 173 conm 52(03) based bit(1) initial level 2 packed unaligned dcl 1-6 ref 212 323 conv_tab_ptr 36 based pointer initial level 2 dcl 1-6 ref 103 conversion_ptr 000146 automatic pointer dcl 2-3 set ref 103* 135 163 166 166 171 173 505 conversions based structure level 1 dcl 2-40 device_info_ptr 34 based pointer initial level 2 dcl 1-6 ref 102 device_iocb_ptr 26 based pointer level 2 dcl 1-6 set ref 93* 455* device_ptr 000150 automatic pointer dcl 2-3 set ref 102* end_of_logical_data 1(09) based bit(1) level 2 packed unaligned dcl 1-90 set ref 342* 480 erklm 52(06) based bit(1) initial level 2 packed unaligned dcl 1-6 ref 283 309 escape 267 based structure array level 2 dcl 2-40 ref 163 escape_out_seen 52(09) based bit(1) initial level 2 packed unaligned dcl 1-6 set ref 367 369* escm 52(05) based bit(1) initial level 2 packed unaligned dcl 1-6 ref 399 hbound builtin function dcl 65 ref 163 i 000111 automatic fixed bin(21,0) dcl 37 set ref 141* 143 145 147 149 163* 166 166 171 173* 183 510* 511 513 in 100 based bit(9) array level 2 packed unaligned dcl 2-40 ref 135 505 inchar 267(09) based bit(9) array level 3 in structure "conversions" packed unaligned dcl 2-40 in procedure "apl_dim_read_" ref 166 inchar 000126 automatic bit(9) unaligned dcl 37 in procedure "apl_dim_read_" set ref 135* 138 141 158* 166 171* 187* 201 204 207 209 270* 270 275 287* 314* 323 328 405 408 413* 428 505* 508 510 ini 000112 automatic fixed bin(21,0) dcl 37 set ref 98* 106 109* 116 128 132 135 136* 136 151 154 158 160* 160 217* 335 335 420* 420 437 498 502 505 506* 506 inimax 60 based fixed bin(17,0) initial level 2 dcl 1-6 set ref 128 151 335 352* 352 353 353 356 491* 498 internal_type 63 based bit(9) array level 2 packed unaligned dcl 1-6 ref 204 204 209 209 298 298 298 298 323 323 323 323 iocb_ptr 30 based pointer level 2 dcl 1-6 set ref 375* 377* 383* iox_$control 000010 constant entry external dcl 49 ref 375 iox_$get_line 000012 constant entry external dcl 49 ref 93 455 iox_$put_chars 000014 constant entry external dcl 49 ref 377 383 keying_time 44 based fixed bin(71,0) initial level 2 dcl 1-6 set ref 95* 95 457* 457 length builtin function dcl 65 ref 377 377 455 455 line 000104 automatic fixed bin(21,0) dcl 37 set ref 122* 254* 254 259* 262* 262 262 363 mod builtin function dcl 65 ref 238 262 move 0(06) defined bit(3) array level 2 in structure "type" packed unaligned dcl 1-70 in procedure "apl_dim_read_" ref 209 move 000107 automatic fixed bin(21,0) dcl 37 in procedure "apl_dim_read_" set ref 207* 209* 212 212 221 nelem parameter fixed bin(21,0) dcl 27 set ref 22 93* 99 nelemt parameter fixed bin(21,0) dcl 27 set ref 22 93* 101* 242 330* 332* 334* 334 432* 433* 434 normal_read_buffer 363 based char(512) level 2 dcl 1-6 set ref 455 455 455 455 488 normal_read_n_transmitted 000103 automatic fixed bin(21,0) dcl 37 set ref 455* 474 488 488 490 null builtin function dcl 65 ref 375 375 number_of_spaces 000101 automatic fixed bin(21,0) dcl 37 set ref 235* 238* 239 242 243 offset parameter fixed bin(17,0) dcl 27 ref 22 92 99 117 298 334 old_read_back_state 000102 automatic fixed bin(21,0) dcl 37 set ref 380* 388 oneshift 000130 automatic bit(1) unaligned dcl 37 set ref 85* 147* 268 272* outchar 267(18) based bit(9) array level 3 packed unaligned dcl 2-40 ref 171 outi 000113 automatic fixed bin(21,0) dcl 37 set ref 118* 124 192 242 243* 243 275 277* 277 291 293 297* 297 298 298* 298 298* 317* 323* 323 323* 328 329* 329 330 428 429* 429 432 434* 438 outimax 000114 automatic fixed bin(21,0) dcl 37 set ref 99* 124 outp 000120 automatic pointer dcl 37 set ref 100* 242 275 298 298 323 328 332* 383 383 428 433* pass2 000131 automatic bit(1) unaligned dcl 37 set ref 85* 185 212 216* 285 312 332 430 435* prefix 267 based bit(1) array level 3 packed unaligned dcl 2-40 ref 166 prefsw 000132 automatic bit(1) unaligned dcl 37 set ref 85* 161* 166 180 423* rawim 52(07) based bit(1) initial level 2 packed unaligned dcl 1-6 ref 89 rbufp 000122 automatic pointer dcl 37 set ref 104* 132 135 154 158 502 505 read_back 53 based fixed bin(17,0) initial level 2 dcl 1-6 set ref 380 381* 388* 471 read_back_input constant fixed bin(17,0) initial dcl 1-82 ref 471 read_back_output constant fixed bin(17,0) initial dcl 1-82 ref 381 read_offset 55 based fixed bin(17,0) initial level 2 dcl 1-6 set ref 98 335* 338* 350 352 353 355* readp parameter pointer dcl 27 ref 22 92 100 real_time 000134 automatic fixed bin(71,0) dcl 37 set ref 91* 95 453* 457 sdb_ptr parameter pointer dcl 1-4 set ref 22 89 93 95 95 98 102 103 104 120 121 122 123 128 151 192 192 204 209 212 235 238 238 240 283 293 293 298 298 309 318 323 323 323 332* 335 335 338 350 352 352 352 353 353 353 353 353 355 356 356 359 361 362 363 364 367 369 370 375 377 380 381 383 383 383 387 388 399 433* 455 455 455 455 455 457 457 464 464 471 471 485 485 488 488 488 490 490 491 491 498 shift 000127 automatic bit(2) unaligned dcl 37 set ref 120* 132 132 143* 145* 154 154 361 502 502 511* 513* size 266 based fixed bin(17,0) level 2 dcl 2-40 ref 163 status 000144 automatic bit(72) unaligned dcl 1-88 set ref 93 94 341* 342 343 375 377 383 454* 455 458 460 480 483* status_bits based structure level 1 unaligned dcl 1-90 status_code based fixed bin(35,0) level 2 dcl 1-90 set ref 93* 375* 377* 383* 455* 458 stream_data_block based structure level 1 dcl 1-6 substr builtin function dcl 65 set ref 132* 141 154* 242* 270* 270 353* 353 488* 488 502* 510 sum 000115 automatic fixed bin(21,0) dcl 37 set ref 402* 408* 408 413 tab_width 61 based fixed bin(17,0) initial level 2 dcl 1-6 ref 235 238 238 tabsin_mode 52(10) based bit(1) initial level 2 packed unaligned dcl 1-6 ref 240 target_eof 000133 automatic bit(1) unaligned dcl 37 set ref 85* 339 450 476* 480* temp_ptr 000124 automatic pointer dcl 37 set ref 92* 93* toffset 000105 automatic fixed bin(21,0) dcl 37 set ref 117* 118 192 291 293 317 323 330 332* 334 383 383 432 433* 434 438* tpini 000116 automatic fixed bin(21,0) dcl 37 set ref 116* 217 437* type defined structure array level 1 packed unaligned dcl 1-70 white defined bit(1) array level 2 packed unaligned dcl 1-70 ref 298 298 323 323 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. baud_rate_110 internal static fixed bin(17,0) initial dcl 2-6 baud_rate_1200 internal static fixed bin(17,0) initial dcl 2-6 baud_rate_150_or_134 internal static fixed bin(17,0) initial dcl 2-6 baud_rate_300 internal static fixed bin(17,0) initial dcl 2-6 compression_in based structure level 1 dcl 2-59 compression_out based structure level 1 dcl 2-63 device_info based structure level 1 dcl 2-13 fixed builtin function dcl 65 n automatic fixed bin(17,0) dcl 2-3 read_back_names internal static char(16) initial array unaligned dcl 1-79 read_back_spaces internal static fixed bin(17,0) initial dcl 1-82 sequence based structure level 1 dcl 2-55 sequence_ptr automatic pointer dcl 2-3 NAMES DECLARED BY EXPLICIT CONTEXT. again 000161 constant label dcl 118 ref 218 apl_dim_read_ 000042 constant entry external dcl 22 bad_char_exit 000410 constant label dcl 201 ref 195 begin 000047 constant label dcl 85 ref 390 end_col 000572 constant label dcl 265 ref 225 227 233 246 250 255 260 escl 001302 constant label dcl 403 ref 411 getmore 001410 constant entry internal dcl 447 ref 108 128 151 498 haveascii 000241 constant label dcl 138 ref 177 iloop 000177 constant label dcl 124 ref 180 198 244 278 440 loop 001532 constant label dcl 498 ref 515 main_program_return 001407 constant label dcl 442 ref 461 new_col 000000 constant label array(0:7) dcl 223 ref 221 prefesc 000326 constant label dcl 163 ref 424 rdone 001025 constant label dcl 330 ref 124 450 477 shortn 001324 constant label dcl 413 ref 421 skip_specials 001531 constant entry internal dcl 495 ref 403 store 000607 constant label dcl 275 ref 173 189 283 288 309 315 399 416 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1700 1720 1616 1710 Length 2126 1616 20 171 61 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_dim_read_ 172 external procedure is an external procedure. getmore internal procedure shares stack frame of external procedure apl_dim_read_. skip_specials internal procedure shares stack frame of external procedure apl_dim_read_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_dim_read_ 000100 col apl_dim_read_ 000101 number_of_spaces apl_dim_read_ 000102 old_read_back_state apl_dim_read_ 000103 normal_read_n_transmitted apl_dim_read_ 000104 line apl_dim_read_ 000105 toffset apl_dim_read_ 000106 act apl_dim_read_ 000107 move apl_dim_read_ 000110 c apl_dim_read_ 000111 i apl_dim_read_ 000112 ini apl_dim_read_ 000113 outi apl_dim_read_ 000114 outimax apl_dim_read_ 000115 sum apl_dim_read_ 000116 tpini apl_dim_read_ 000120 outp apl_dim_read_ 000122 rbufp apl_dim_read_ 000124 temp_ptr apl_dim_read_ 000126 inchar apl_dim_read_ 000127 shift apl_dim_read_ 000130 oneshift apl_dim_read_ 000131 pass2 apl_dim_read_ 000132 prefsw apl_dim_read_ 000133 target_eof apl_dim_read_ 000134 real_time apl_dim_read_ 000144 status apl_dim_read_ 000146 conversion_ptr apl_dim_read_ 000150 device_ptr apl_dim_read_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return mod_fx1 signal ext_entry clock THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_dim_canonicalize_ iox_$control iox_$get_line iox_$put_chars NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 22 000034 85 000047 88 000053 89 000060 91 000065 92 000067 93 000075 94 000114 95 000121 96 000130 98 000131 99 000133 100 000136 101 000141 102 000142 103 000144 104 000146 106 000150 108 000152 109 000153 116 000154 117 000156 118 000161 120 000163 121 000171 122 000173 123 000175 124 000177 128 000202 132 000211 135 000222 136 000240 138 000241 141 000245 143 000251 145 000256 147 000263 149 000270 151 000272 154 000301 158 000312 160 000323 161 000324 163 000326 166 000335 171 000353 173 000356 177 000361 179 000362 180 000364 182 000366 183 000367 185 000371 187 000373 189 000375 192 000376 195 000406 198 000407 201 000410 204 000417 207 000434 209 000440 212 000455 216 000475 217 000477 218 000501 221 000502 223 000504 225 000505 227 000506 230 000507 233 000513 235 000514 238 000525 239 000534 240 000535 242 000540 243 000546 244 000550 246 000551 248 000552 250 000553 252 000554 254 000555 255 000556 257 000557 259 000560 260 000561 262 000562 265 000572 268 000574 270 000576 272 000606 275 000607 277 000615 278 000616 281 000617 283 000621 285 000627 287 000631 288 000633 291 000634 293 000637 297 000645 298 000647 303 000715 305 000720 307 000721 309 000723 312 000731 314 000733 315 000735 317 000736 318 000740 319 000742 321 000743 323 000745 327 001013 328 001016 329 001024 330 001025 332 001031 334 001050 335 001055 338 001064 339 001066 341 001070 342 001072 343 001074 350 001100 352 001103 353 001105 355 001112 356 001113 358 001116 359 001117 361 001121 362 001125 363 001127 364 001131 367 001133 369 001136 370 001140 371 001142 372 001145 375 001146 377 001200 380 001224 381 001231 383 001233 387 001257 388 001264 390 001266 393 001267 397 001270 399 001272 401 001300 402 001301 403 001302 405 001303 408 001310 410 001320 411 001321 413 001324 416 001331 418 001332 420 001334 421 001336 423 001337 424 001340 426 001341 428 001343 429 001351 430 001352 432 001354 433 001360 434 001375 435 001401 437 001402 438 001404 440 001406 442 001407 447 001410 450 001411 453 001413 454 001415 455 001417 457 001445 458 001454 460 001456 461 001462 464 001463 471 001472 474 001476 476 001500 477 001502 480 001503 483 001510 485 001512 488 001516 490 001523 491 001525 493 001530 495 001531 498 001532 502 001541 505 001552 506 001567 508 001570 510 001574 511 001600 513 001605 515 001611 518 001612 ----------------------------------------------------------- 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