COMPILATION LISTING OF SEGMENT form_dim_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1658.8 mst Mon 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 12 form_dim_: procedure; 13 14 return; /* this is not a legal entry point */ 15 16 /* Splicing dim to control the printing of forms on the IO daemon driver control terminal. 17* This dim accepts a page length and line length as order calls and keeps track of the current line 18* number on the terminal so that it can output enough line feeds to bring the form to the top of the 19* page when a form feed character is written. The read entry also updates the current line position. */ 20 21 /* Originally coded by J. Whitmore, Jan 1975, based on an old ttydim */ 22 23 24 dcl (sdb_p, sp, vp, p) ptr, /* temporary storage */ 25 (k, i) fixed bin; 26 27 dcl 1 first_sdb int static aligned like sdb; /* first allocation of an SDB */ 28 29 dcl 1 sdb based (sdb_p) aligned, /* one entry in list of stream data control blocks */ 30 2 dim_name char (32), /* the name of this DIM */ 31 2 device_name_list ptr, /* ptr to threaded list of device names for ios_ */ 32 2 next_device ptr, /* this should be null..device_name_list points here */ 33 2 device_name_size fixed bin, /* number of chars in device name */ 34 2 device_name char (32) unal, /* stream or device attached to */ 35 2 n_attached fixed bin, /* number of different streams using this SDB */ 36 2 active bit (1) unal, /* "1" means this entry is active */ 37 2 aligned bit (1) unal, /* "1" means paper is aligned on terminal */ 38 2 pad bit (34) unal, 39 2 page_size fixed bin, /* number of lines on the form */ 40 2 line_length fixed bin, /* number of print positions per line */ 41 2 carg_pos fixed bin, /* last known carriage position */ 42 2 line_no fixed bin, /* current line on the page */ 43 2 nextp ptr; /* pointer to next entry in sdb list */ 44 45 dcl 1 st based (sp) aligned, /* breakdown of I/O system status word */ 46 2 code fixed bin (35), /* error status code (0 = OK) */ 47 2 comp bit (4) unaligned, /* completion status, LI, LC, PI, PC */ 48 2 end bit (1) unaligned, /* end-of-file */ 49 2 pad1 bit (4) unaligned, 50 2 eod bit (1) unaligned, /* end of physical data */ 51 2 pad2 bit (4) unaligned, 52 2 abs bit (1) unaligned, 53 2 det bit (1) unaligned, /* detach flag */ 54 2 quit bit (1) unaligned, /* quit flag */ 55 2 abort bit (1) unaligned, /* abort flag */ 56 2 callx bit (18) unaligned; /* rel pointer to last transaction */ 57 58 dcl hcs_$assign_linkage ext entry (fixed bin, ptr, fixed bin (35)); 59 60 dcl form_dim_$form_changemode entry (ptr, char (*), char (*), bit (72) aligned); 61 62 dcl onechar char (1), /* temp for compares */ 63 code fixed bin (35), 64 init bit (1) int static init ("0"b), /* sdb initialization flag */ 65 bel char (1) init (""), /* a bel char */ 66 space char (1) int static init (" "), /* a space char */ 67 spaces char (12) int static init (" "), /* string of spaces */ 68 nl char (1) int static init (" 69 "), 70 ht char (1) int static init (" "), 71 bs char (1) int static init (""); 72 73 dcl (addr, null, mod, index, substr, search, length) builtin; 74 75 dcl any_other condition; 76 77 dcl error_table_$ionmat fixed bin (35) ext static; /* code indicating stream already attached */ 78 79 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); 80 81 dcl ios_$order entry (char (*), char (*), ptr, bit (72)aligned); 82 dcl ios_$read entry (char (*), ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); 83 dcl ios_$write entry (char (*), ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); 84 dcl ios_$abort entry (char (*), bit (72) aligned, bit (72) aligned); 85 dcl ios_$resetread entry (char (*), bit (72) aligned); 86 dcl ios_$resetwrite entry (char (*), bit (72) aligned); 87 dcl ios_$changemode entry (char (*), char (*), char (*), bit (72) aligned); 88 89 dcl VT char (1) int static init (" "); /* a vertical tab character */ 90 91 dcl ff char (1) int static init (" "); /* form feed char */ 92 93 form_attach: entry (from_stream, dim_name, to_stream, mode, status, sdb_ptr); 94 95 dcl from_stream char (*), /* stream name (e.g. user_i/o) */ 96 dim_name char (*), /* IOSIM name used to get here */ 97 to_stream char (*), /* stream we are attaching to */ 98 mode char (*), /* attachment mode */ 99 status bit (72) aligned, /* I/O system status code (returned) */ 100 sdb_ptr ptr; /* device attachment pointer (returned) */ 101 102 status = "0"b; /* clear status code */ 103 sp = addr (status); /* pick up pointer to status code argument */ 104 if sdb_ptr ^= null then do; /* this is a multiple attachment from the same source */ 105 st.code = error_table_$ionmat; /* no good, so return error code */ 106 return; /* return */ 107 end; 108 sdb_p = addr (first_sdb); /* get pointer to first entry in SDB list */ 109 if ^init then do; /* be sure we initialize sdb first in the process */ 110 sdb.active = "0"b; /* not active yet */ 111 sdb.nextp = null; /* list ends here */ 112 init = "1"b; /* we are now initialized for sdb search */ 113 end; 114 vp = null; /* use vp to locate first vacant entry (if any) */ 115 do while (sdb_p ^= null); /* search entire SDB list */ 116 p = sdb_p; /* keep track of last entry in temp ptr p */ 117 if ^sdb.active then do; /* is this entry an unused (vacant) entry? */ 118 if vp = null then vp = sdb_p; /* record first vacant entry found in list */ 119 end; 120 else if sdb.device_name = to_stream then do; /* not vacant, is stream already attached? */ 121 sdb_ptr = sdb_p; /* if so, return attachment ptr to this entry */ 122 sdb.n_attached = sdb.n_attached + 1; /* allow multiple sources */ 123 go to attrtn; /* and return to caller */ 124 end; 125 sdb_p = sdb.nextp; /* get pointer to next entry (if any) in list */ 126 end; 127 if vp = null then do; /* if no vacant entry found in sdb list, */ 128 call hcs_$assign_linkage (32, vp, code); /* then we must allocate space for a new entry */ 129 if code ^= 0 then go to atterr; 130 vp -> sdb.active = "0"b; /* initialize new sdb list entry */ 131 vp -> sdb.nextp = null; /* indicate new entry is last entry in list */ 132 p -> sdb.nextp = vp; /* thread new entry into sdb list */ 133 end; 134 sdb_p, sdb_ptr = vp; /* set caller's attachment pointer */ 135 sdb.active = "1"b; /* initialize remainder of sdb list entry */ 136 sdb.n_attached = 1; /* this is the first source for this SDB */ 137 sdb.device_name = to_stream; /* save stream we will do I/O on */ 138 sdb.dim_name = dim_name; /* initialize name of DIM */ 139 sdb.device_name_list = addr (sdb.next_device); /* get pointer to list of device names */ 140 sdb.next_device = null; /* this is last entry in list */ 141 sdb.device_name_size = index (to_stream, " ") - 1; /* there should be a trailing space */ 142 if sdb.device_name_size < 1 then sdb.device_name_size = length (to_stream); 143 sdb.page_size = 66; /* default is 66 lines per page */ 144 sdb.line_length = 79; /* assume 79 as a default */ 145 sdb.carg_pos = 1; /* assume carrage in col 1 */ 146 sdb.line_no = 1; /* assume top of page */ 147 sdb.aligned = "0"b; /* but, that paper is not aligned */ 148 /* we can't assume that "to_stream" is attached yet, but */ 149 call ios_$changemode (sdb.device_name, "edited", "", status); /* set edited mode if possible */ 150 151 attrtn: if mode ^= "" then 152 call ios_$changemode (sdb.device_name, mode, "", status); 153 /* if mode is specified then establish it */ 154 call set_line_length; /* get ll from device or take default */ 155 status = "0"b; /* all is well even if other stream not there */ 156 st.end = "1"b; /* indicate stream at "end of file" */ 157 return; /* and return to caller */ 158 159 atterr: st.code = code; /* here on error, return status code to caller */ 160 st.det = "1"b; /* indicate stream not attached */ 161 return; 162 /* */ 163 form_write: entry (sdb_ptr, wp, offset, ne, net, status); /* entry to write */ 164 165 dcl wp ptr, /* pointer to base of user's workspace */ 166 offset fixed bin, /* character offset from wp */ 167 ne fixed bin, /* number of elements (characters) to write (or read) */ 168 net fixed bin; /* number of elements actually written (or read) */ 169 170 dcl source char (512) based (wp); /* input buffer */ 171 172 dcl next_char fixed bin, /* index of next unprocessed char from user */ 173 last_char fixed bin, /* index of the last char to write */ 174 write_flag bit (1), /* flag to write after nl unless space gets tight */ 175 out_pos fixed bin, /* index of next available slot in out_buf */ 176 out_buf char (640); /* output buffer built from user's workspace */ 177 178 dcl fold char (3) int static init (" 179 \*"); /* line folding char sequence nl||\||* */ 180 181 182 sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ 183 status = "0"b; /* initialize status code to zero */ 184 sp = addr (status); /* get pointer to status code argument */ 185 if ne = 0 then go to wrtn; /* skip to return if nothing to write */ 186 net = 0; /* initialize elements-written to zero */ 187 next_char = offset + 1; /* index of first char to write */ 188 last_char = offset + ne; /* index of last char to write */ 189 190 outer_loop: do while (next_char <= last_char); /* write all chars requested */ 191 192 out_pos = 1; /* start a new output string */ 193 write_flag = "0"b; /* indicate that we want to buffer */ 194 195 inner_loop: do while (^write_flag & (next_char <= last_char) & (out_pos < 638)); /* write in small blocks */ 196 onechar = substr (source, next_char, 1); /* get next input character */ 197 if onechar < space then do; /* check for ctl char */ 198 199 if onechar = nl then do; /* it was a new line */ 200 substr (out_buf, out_pos, 1) = nl; /* put out and count */ 201 out_pos = out_pos + 1; /* update output index */ 202 sdb.carg_pos = 1; /* carriage now in column 1 */ 203 sdb.line_no = sdb.line_no + 1; /* count the line position on the form */ 204 if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* top of form */ 205 write_flag = "1"b; /* if buffer full we will write */ 206 end; 207 208 else if onechar = ff then do; /* it was a form feed */ 209 if sdb.aligned then do; /* if alignment set, go to top */ 210 if ^((sdb.line_no = 1) & (sdb.carg_pos = 1)) then do; /* are we there? */ 211 do i = 1 to (sdb.page_size - sdb.line_no + 1); /* put out enough new lines */ 212 substr (out_buf, out_pos, 1) = nl; 213 out_pos = out_pos + 1; 214 end; 215 sdb.carg_pos = 1; /* carriage position is now 1 */ 216 sdb.line_no = 1; /* now at top */ 217 write_flag = "1"b; /* we can write if needed */ 218 end; 219 end; 220 else do; 221 substr (out_buf, out_pos, 1) = ff; /* put it out when not aligned */ 222 out_pos = out_pos + 1; 223 end; 224 end; 225 226 else if onechar = VT then do; /* it was a vertical tab */ 227 if sdb.aligned then do; /* if alignment is set we simulate */ 228 k = 10 - mod (sdb.line_no + 9, 10); /* how far to 1, 11, 21, 31, ... */ 229 if sdb.line_no + k > sdb.page_size then /* but don't overflow a page */ 230 k = sdb.page_size - sdb.line_no + 1; /* go to top of form */ 231 232 do i = 1 to k; 233 234 substr (out_buf, out_pos, 1) = nl; /* write out "k" new lines */ 235 out_pos = out_pos + 1; 236 237 end; 238 239 sdb.carg_pos = 1; /* back to column 1 */ 240 sdb.line_no = sdb.line_no + k; /* update the line count */ 241 if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* we didn't go past line 1 */ 242 write_flag = "1"b; /* this is a good time to write */ 243 244 end; 245 else do; /* not aligned, just put it out */ 246 247 substr (out_buf, out_pos, 1) = VT; 248 out_pos = out_pos + 1; 249 250 end; 251 end; 252 253 else if onechar = ht then do; /* it was a tab */ 254 i = mod (sdb.carg_pos, 10); /* locate position in tab field */ 255 if i = 0 then sdb.carg_pos = sdb.carg_pos + 1; 256 else sdb.carg_pos = sdb.carg_pos + 11 - i; /* indicate new carriage position */ 257 if sdb.carg_pos <= sdb.line_length then do; /* check for end of carriage */ 258 substr (out_buf, out_pos, 1) = ht; /* ok, put it out */ 259 out_pos = out_pos + 1; 260 end; 261 else do; /* must fold the line */ 262 substr (out_buf, out_pos, 3) = fold; /* put in nl||\||c */ 263 out_pos = out_pos + 3; 264 sdb.line_no = sdb.line_no + 1; 265 if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* top of form */ 266 i = sdb.carg_pos - sdb.line_length - 1; /* how much overhang? */ 267 if i > 0 then do; 268 substr (out_buf, out_pos, i) = substr (spaces, 1, i); /* pad out */ 269 out_pos = out_pos + i; 270 end; 271 sdb.carg_pos = 3 + i; 272 write_flag = "1"b; /* write if buffer full */ 273 end; 274 end; 275 276 else if onechar = bs then do; /* it was a back space */ 277 substr (out_buf, out_pos, 1) = bs; /* put it out */ 278 out_pos = out_pos + 1; 279 sdb.carg_pos = sdb.carg_pos - 1; /* back up the carriage position */ 280 end; 281 282 else if onechar = bel then do; /* it was a bel char, thats OK. */ 283 substr (out_buf, out_pos, 1) = bel; 284 out_pos = out_pos + 1; /* this will not move the carriage */ 285 end; 286 287 /* otherwise drop the character */ 288 289 next_char = next_char + 1; /* either way, get ready for next char */ 290 291 end; 292 293 else do; /* printable char, so put it out */ 294 295 substr (out_buf, out_pos, 1) = onechar; 296 out_pos = out_pos + 1; 297 sdb.carg_pos = sdb.carg_pos + 1; 298 next_char = next_char + 1; /* move the source index */ 299 if next_char <= last_char then /* is the next char legal? */ 300 if sdb.carg_pos > sdb.line_length then do; /* may need to fold */ 301 if substr (source, next_char, 1) ^= nl then do; /* fold if next char not nl */ 302 substr (out_buf, out_pos, 3) = fold; /* insert fold sequence */ 303 out_pos = out_pos + 3; 304 sdb.carg_pos = 3; 305 write_flag = "1"b; 306 sdb.line_no = sdb.line_no + 1; 307 if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* at the top */ 308 end; 309 310 else do; /* just put in new line */ 311 substr (out_buf, out_pos, 1) = nl; 312 out_pos = out_pos + 1; 313 sdb.line_no = sdb.line_no + 1; 314 if sdb.line_no > sdb.page_size then sdb.line_no = 1; 315 sdb.carg_pos = 1; 316 next_char = next_char + 1; /* already checked it */ 317 write_flag = "1"b; 318 end; 319 end; 320 end; 321 322 if out_pos < 512 then write_flag = "0"b; /* then write after nl if 512 chars buffered */ 323 324 end; /* end of inner do while loop */ 325 call ios_$write (sdb.device_name, addr (out_buf), 0, out_pos - 1, i, status); 326 if st.code ^= 0 then do; /* on error, throw it back to caller */ 327 net = i; /* tell him how many written */ 328 return; 329 end; 330 331 end outer_loop; 332 wrtn: st.end = "1"b; /* indicate stream at "end-of-file" */ 333 st.comp = "1110"b; /* return I/O completion indicators */ 334 net = ne; /* indicate that all elements were transferred */ 335 return; 336 337 /* */ 338 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 339 340 form_read: entry (sdb_ptr, wp, offset, ne, net, status); /* entry to read from attachment */ 341 342 sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ 343 status = "0"b; /* initialize status code to zero */ 344 345 call ios_$read (sdb.device_name, wp, offset, ne, net, status); /* pass it on */ 346 if substr (source, offset + net, 1) = nl then do; /* adjust for manual nl's */ 347 sdb.line_no = sdb.line_no + 1; /* increment the line count */ 348 if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* top of page? */ 349 sdb.carg_pos = 1; /* he had to give a nl char */ 350 end; 351 352 return; /* and return control to caller */ 353 354 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 355 356 form_resetread: entry (sdb_ptr, stat2); /* entry to reset read-ahead data */ 357 358 dcl stat2 bit (72) aligned; /* I/O system status code (returned) */ 359 360 sdb_p = sdb_ptr; 361 sdb.aligned = "0"b; /* form alignment is gone */ 362 363 call ios_$resetread (sdb.device_name, stat2); /* pass it along */ 364 365 return; 366 367 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 368 369 form_resetwrite: entry (sdb_ptr, stat2); /* entry to reset write-behind buffers */ 370 371 sdb_p = sdb_ptr; 372 sdb.aligned = "0"b; /* form alignment is gone */ 373 374 call ios_$resetwrite (sdb.device_name, stat2); /* pass it along for now */ 375 376 return; 377 378 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 379 380 form_abort: entry (sdb_ptr, stat2, stat3); /* entry to reset read, write and quit condition */ 381 382 dcl stat3 bit (72) aligned; /* I/O system status code (returned) */ 383 384 sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ 385 sdb.aligned = "0"b; /* form alignment is gone */ 386 387 call ios_$abort (sdb.device_name, stat2, stat3); /* call other DIM to do the work */ 388 389 return; /* and return */ 390 391 /* */ 392 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 393 394 form_order: entry (sdb_ptr, request, argptr, stat4); /* entry to issue attachment orders */ 395 396 dcl request char (*), /* symbol attachment request order code */ 397 argptr ptr, /* pointer to additional arguments (if any) */ 398 stat4 bit (72) aligned; /* I/O system status code (returned) */ 399 400 dcl 1 form aligned based (argptr), /* structure for reading form data */ 401 2 page_size fixed bin, 402 2 line_length fixed bin, 403 2 line_no fixed bin, 404 2 carg_pos fixed bin, 405 2 aligned bit (1) unal, 406 2 pad bit (35) unal; 407 408 dcl error_table_$undefined_order_request fixed bin (35) ext static; 409 410 dcl 1 modes based (argptr), 411 2 len fixed bin, 412 2 string char (len); 413 414 dcl argnum fixed bin based (argptr); 415 416 on any_other go to order_err; /* in case some fool gives a bad argptr */ 417 sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ 418 stat4 = "0"b; /* initialize status code to zero */ 419 sp = addr (stat4); /* get pointer to status code argument */ 420 421 if request = "page_length" then do; 422 if (argnum > 5) & (argnum < 133) then /* a "page" may be from 6 to 132 lines long */ 423 sdb.page_size = argnum; /* if in range save it */ 424 else st.code = error_table_$undefined_order_request; /* out of range */ 425 return; /* we handled it, don't pass it along */ 426 end; 427 428 else if request = "form_aligned" then do; /* get ready to simulate form feeds */ 429 sdb.aligned = "1"b; 430 sdb.line_no = 1; 431 sdb.carg_pos = 1; 432 return; 433 end; 434 435 else if request = "form_status" then do; /* give back everything..in case */ 436 form.page_size = sdb.page_size; 437 form.line_length = sdb.line_length; 438 form.line_no = sdb.line_no; 439 form.carg_pos = sdb.carg_pos; 440 form.aligned = sdb.aligned; 441 return; 442 end; 443 444 passon: call ios_$order (sdb.device_name, request, argptr, stat4); /* pass order call to other DIM */ 445 446 call set_line_length; /* the "modes" order could change ll */ 447 448 return; /* and return to caller */ 449 450 order_err: st.code = error_table_$undefined_order_request; 451 return; 452 453 454 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 455 456 form_changemode: entry (sdb_ptr, mode, omode, stat4); /* entry to modify the attachment mode */ 457 458 dcl omode char (*); /* returned mode prior to this call */ 459 460 sdb_p = sdb_ptr; /* get pointer to SDB for this attachment */ 461 stat4 = "0"b; /* initialize status to OK */ 462 sp = addr (stat4); /* pick up pointer to status argument */ 463 call ios_$changemode (sdb.device_name, mode, omode, stat4); /* call other DIM to change modes */ 464 465 call set_line_length; /* see if there is a new line length */ 466 467 return; 468 469 470 /* */ 471 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 472 473 form_getsize: entry (sdb_ptr, size, stat3); /* entry to return current element size */ 474 475 dcl size fixed bin; /* current element size (returned) */ 476 477 size = 9; /* element size for consoles is always 9 */ 478 stat3 = "0"b; 479 return; /* so return the constant 9 to the caller */ 480 481 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 482 483 form_detach: entry (sdb_ptr, ch2, disposal, stat4); /* entry to detach one input stream */ 484 485 dcl (ch2, disposal) char (*); /* these arguments ignored in this implementation */ 486 487 sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ 488 stat4 = "0"b; /* initialize status code to zero */ 489 sp = addr (stat4); /* get pointer to status code argument */ 490 st.det = "1"b; /* set code to detach this ioname */ 491 sdb.n_attached = sdb.n_attached - 1; /* count one less source */ 492 if sdb.n_attached < 1 then sdb.active = "0"b; /* indicate sdb list entry no longer in use */ 493 return; /* and return */ 494 495 /* ********************************************************************** */ 496 497 /* ** internal procedure to set internal line length ** */ 498 499 set_line_length: proc; 500 501 dcl ec fixed bin (35); 502 dcl v char (12) var; 503 dcl k fixed bin; 504 dcl status bit (72) aligned; 505 dcl get_line_length_$stream entry (char (*), fixed bin (35)) returns (fixed bin); 506 dcl convert_binary_integer_$decimal_string entry (fixed bin) returns (char (12) var); 507 508 k = get_line_length_$stream (sdb.device_name, ec); /* see what ll is set on output stream */ 509 if ec ^= 0 then do; /* it must not be there, take default */ 510 sdb.line_length = 79; 511 return; 512 end; 513 if k < 11 | k > 132 then do; /* must be a mistake, keep current value */ 514 v = convert_binary_integer_$decimal_string (sdb.line_length); 515 v = "ll" || v; /* make a mode string out of it */ 516 517 call ios_$changemode (sdb.device_name, (v), "", status); /* this is the best we can do */ 518 return; 519 end; 520 521 sdb.line_length = k; /* record the new line length so we are in sync */ 522 523 return; 524 525 end set_line_length; 526 527 end form_dim_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1507.8 form_dim_.pl1 >dumps>old>recomp>form_dim_.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. VT constant char(1) initial unaligned dcl 89 ref 226 247 active 26 based bit(1) level 2 packed unaligned dcl 29 set ref 110* 117 130* 135* 492* addr builtin function dcl 73 ref 103 108 139 184 325 325 419 462 489 aligned 4 based bit(1) level 2 in structure "form" packed unaligned dcl 400 in procedure "form_dim_" set ref 440* aligned 26(01) based bit(1) level 2 in structure "sdb" packed unaligned dcl 29 in procedure "form_dim_" set ref 147* 209 227 361* 372* 385* 429* 440 any_other 000116 stack reference condition dcl 75 ref 416 argnum based fixed bin(17,0) dcl 414 ref 422 422 422 argptr parameter pointer dcl 396 set ref 394 422 422 422 436 437 438 439 440 444* bel 000114 automatic char(1) initial unaligned dcl 62 set ref 62* 282 283 bs constant char(1) initial unaligned dcl 62 ref 276 277 carg_pos 31 based fixed bin(17,0) level 2 in structure "sdb" dcl 29 in procedure "form_dim_" set ref 145* 202* 210 215* 239* 254 255* 255 256* 256 257 266 271* 279* 279 297* 297 299 304* 315* 349* 431* 439 carg_pos 3 based fixed bin(17,0) level 2 in structure "form" dcl 400 in procedure "form_dim_" set ref 439* ch2 parameter char unaligned dcl 485 ref 483 code based fixed bin(35,0) level 2 in structure "st" dcl 45 in procedure "form_dim_" set ref 105* 159* 326 424* 450* code 000113 automatic fixed bin(35,0) dcl 62 in procedure "form_dim_" set ref 128* 129 159 comp 1 based bit(4) level 2 packed unaligned dcl 45 set ref 333* convert_binary_integer_$decimal_string 000076 constant entry external dcl 506 ref 514 det 1(15) based bit(1) level 2 packed unaligned dcl 45 set ref 160* 490* device_name 15 based char(32) level 2 packed unaligned dcl 29 set ref 120 137* 149* 151* 325* 345* 363* 374* 387* 444* 463* 508* 517* device_name_list 10 based pointer level 2 dcl 29 set ref 139* device_name_size 14 based fixed bin(17,0) level 2 dcl 29 set ref 141* 142 142* dim_name based char(32) level 2 in structure "sdb" dcl 29 in procedure "form_dim_" set ref 138* dim_name parameter char unaligned dcl 95 in procedure "form_dim_" ref 93 138 disposal parameter char unaligned dcl 485 ref 483 ec 000410 automatic fixed bin(35,0) dcl 501 set ref 508* 509 end 1(04) based bit(1) level 2 packed unaligned dcl 45 set ref 156* 332* error_table_$ionmat 000052 external static fixed bin(35,0) dcl 77 ref 105 error_table_$undefined_order_request 000072 external static fixed bin(35,0) dcl 408 ref 424 450 ff constant char(1) initial unaligned dcl 91 ref 208 221 first_sdb 000010 internal static structure level 1 dcl 27 set ref 108 fold 000000 constant char(3) initial unaligned dcl 178 ref 262 302 form based structure level 1 dcl 400 from_stream parameter char unaligned dcl 95 ref 93 get_line_length_$stream 000074 constant entry external dcl 505 ref 508 hcs_$assign_linkage 000050 constant entry external dcl 58 ref 128 ht constant char(1) initial unaligned dcl 62 ref 253 258 i 000111 automatic fixed bin(17,0) dcl 24 set ref 211* 232* 254* 255 256 266* 267 268 268 269 271 325* 327 index builtin function dcl 73 ref 141 init 000046 internal static bit(1) initial unaligned dcl 62 set ref 109 112* ios_$abort 000062 constant entry external dcl 84 ref 387 ios_$changemode 000070 constant entry external dcl 87 ref 149 151 463 517 ios_$order 000054 constant entry external dcl 81 ref 444 ios_$read 000056 constant entry external dcl 82 ref 345 ios_$resetread 000064 constant entry external dcl 85 ref 363 ios_$resetwrite 000066 constant entry external dcl 86 ref 374 ios_$write 000060 constant entry external dcl 83 ref 325 k 000415 automatic fixed bin(17,0) dcl 503 in procedure "set_line_length" set ref 508* 513 513 521 k 000110 automatic fixed bin(17,0) dcl 24 in procedure "form_dim_" set ref 228* 229 229* 232 240 last_char 000125 automatic fixed bin(17,0) dcl 172 set ref 188* 190 195 299 length builtin function dcl 73 ref 142 line_length 30 based fixed bin(17,0) level 2 in structure "sdb" dcl 29 in procedure "form_dim_" set ref 144* 257 266 299 437 510* 514* 521* line_length 1 based fixed bin(17,0) level 2 in structure "form" dcl 400 in procedure "form_dim_" set ref 437* line_no 2 based fixed bin(17,0) level 2 in structure "form" dcl 400 in procedure "form_dim_" set ref 438* line_no 32 based fixed bin(17,0) level 2 in structure "sdb" dcl 29 in procedure "form_dim_" set ref 146* 203* 203 204 204* 210 211 216* 228 229 229 240* 240 241 241* 264* 264 265 265* 306* 306 307 307* 313* 313 314 314* 347* 347 348 348* 430* 438 mod builtin function dcl 73 ref 228 254 mode parameter char unaligned dcl 95 set ref 93 151 151* 456 463* n_attached 25 based fixed bin(17,0) level 2 dcl 29 set ref 122* 122 136* 491* 491 492 ne parameter fixed bin(17,0) dcl 165 set ref 163 185 188 334 340 345* net parameter fixed bin(17,0) dcl 165 set ref 163 186* 327* 334* 340 345* 346 next_char 000124 automatic fixed bin(17,0) dcl 172 set ref 187* 190 195 196 289* 289 298* 298 299 301 316* 316 next_device 12 based pointer level 2 dcl 29 set ref 139 140* nextp 34 based pointer level 2 dcl 29 set ref 111* 125 131* 132* nl 002145 constant char(1) initial unaligned dcl 62 ref 199 200 212 234 301 311 346 null builtin function dcl 73 ref 104 111 114 115 118 127 131 140 offset parameter fixed bin(17,0) dcl 165 set ref 163 187 188 340 345* 346 omode parameter char unaligned dcl 458 set ref 456 463* onechar 000112 automatic char(1) unaligned dcl 62 set ref 196* 197 199 208 226 253 276 282 295 out_buf 000130 automatic char(640) unaligned dcl 172 set ref 200* 212* 221* 234* 247* 258* 262* 268* 277* 283* 295* 302* 311* 325 325 out_pos 000127 automatic fixed bin(17,0) dcl 172 set ref 192* 195 200 201* 201 212 213* 213 221 222* 222 234 235* 235 247 248* 248 258 259* 259 262 263* 263 268 269* 269 277 278* 278 283 284* 284 295 296* 296 302 303* 303 311 312* 312 322 325 p 000106 automatic pointer dcl 24 set ref 116* 132 page_size 27 based fixed bin(17,0) level 2 in structure "sdb" dcl 29 in procedure "form_dim_" set ref 143* 204 211 229 229 241 265 307 314 348 422* 436 page_size based fixed bin(17,0) level 2 in structure "form" dcl 400 in procedure "form_dim_" set ref 436* request parameter char unaligned dcl 396 set ref 394 421 428 435 444* sdb based structure level 1 dcl 29 sdb_p 000100 automatic pointer dcl 24 set ref 108* 110 111 115 116 117 118 120 121 122 122 125* 125 134* 135 136 137 138 139 139 140 141 142 142 143 144 145 146 147 149 151 182* 202 203 203 204 204 204 209 210 210 211 211 215 216 227 228 229 229 229 229 239 240 240 241 241 241 254 255 255 256 256 257 257 264 264 265 265 265 266 266 271 279 279 297 297 299 299 304 306 306 307 307 307 313 313 314 314 314 315 325 342* 345 347 347 348 348 348 349 360* 361 363 371* 372 374 384* 385 387 417* 422 429 430 431 436 437 438 439 440 444 460* 463 487* 491 491 492 492 508 510 514 517 521 sdb_ptr parameter pointer dcl 95 set ref 93 104 121* 134* 163 182 340 342 356 360 369 371 380 384 394 417 456 460 473 483 487 size parameter fixed bin(17,0) dcl 475 set ref 473 477* source based char(512) unaligned dcl 170 ref 196 301 346 sp 000102 automatic pointer dcl 24 set ref 103* 105 156 159 160 184* 326 332 333 419* 424 450 462* 489* 490 space constant char(1) initial unaligned dcl 62 ref 197 spaces 002146 constant char(12) initial unaligned dcl 62 ref 268 st based structure level 1 dcl 45 stat2 parameter bit(72) dcl 358 set ref 356 363* 369 374* 380 387* stat3 parameter bit(72) dcl 382 set ref 380 387* 473 478* stat4 parameter bit(72) dcl 396 set ref 394 418* 419 444* 456 461* 462 463* 483 488* 489 status 000416 automatic bit(72) dcl 504 in procedure "set_line_length" set ref 517* status parameter bit(72) dcl 95 in procedure "form_dim_" set ref 93 102* 103 149* 151* 155* 163 183* 184 325* 340 343* 345* substr builtin function dcl 73 set ref 196 200* 212* 221* 234* 247* 258* 262* 268* 268 277* 283* 295* 301 302* 311* 346 to_stream parameter char unaligned dcl 95 ref 93 120 137 141 142 v 000411 automatic varying char(12) dcl 502 set ref 514* 515* 515 517 vp 000104 automatic pointer dcl 24 set ref 114* 118 118* 127 128* 130 131 132 134 wp parameter pointer dcl 165 set ref 163 196 301 340 345* 346 write_flag 000126 automatic bit(1) unaligned dcl 172 set ref 193* 195 205* 217* 242* 272* 305* 317* 322* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. cv_dec_check_ 000000 constant entry external dcl 79 form_dim_$form_changemode 000000 constant entry external dcl 60 modes based structure level 1 unaligned dcl 410 search builtin function dcl 73 NAMES DECLARED BY EXPLICIT CONTEXT. atterr 000413 constant label dcl 159 ref 129 attrtn 000343 constant label dcl 151 ref 123 form_abort 001363 constant entry external dcl 380 form_attach 000057 constant entry external dcl 93 form_changemode 001622 constant entry external dcl 456 form_detach 001736 constant entry external dcl 483 form_dim_ 000042 constant entry external dcl 12 form_getsize 001713 constant entry external dcl 473 form_order 001430 constant entry external dcl 394 form_read 001156 constant entry external dcl 340 form_resetread 001263 constant entry external dcl 356 form_resetwrite 001322 constant entry external dcl 369 form_write 000426 constant entry external dcl 163 inner_loop 000472 constant label dcl 195 order_err 001611 constant label dcl 450 ref 416 outer_loop 000464 constant label dcl 190 passon 001561 constant label dcl 444 set_line_length 002006 constant entry internal dcl 499 ref 154 446 465 wrtn 001141 constant label dcl 332 ref 185 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2440 2540 2153 2450 Length 2752 2153 100 175 264 40 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME form_dim_ 368 external procedure is an external procedure. on unit on line 416 64 on unit set_line_length internal procedure shares stack frame of external procedure form_dim_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 first_sdb form_dim_ 000046 init form_dim_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME form_dim_ 000100 sdb_p form_dim_ 000102 sp form_dim_ 000104 vp form_dim_ 000106 p form_dim_ 000110 k form_dim_ 000111 i form_dim_ 000112 onechar form_dim_ 000113 code form_dim_ 000114 bel form_dim_ 000124 next_char form_dim_ 000125 last_char form_dim_ 000126 write_flag form_dim_ 000127 out_pos form_dim_ 000130 out_buf form_dim_ 000410 ec set_line_length 000411 v set_line_length 000415 k set_line_length 000416 status set_line_length THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return tra_ext mod_fx1 enable shorten_stack ext_entry ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. convert_binary_integer_$decimal_string get_line_length_$stream hcs_$assign_linkage ios_$abort ios_$changemode ios_$order ios_$read ios_$resetread ios_$resetwrite ios_$write THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$ionmat error_table_$undefined_order_request LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 62 000035 12 000041 14 000050 93 000051 102 000116 103 000122 104 000124 105 000130 106 000133 108 000134 109 000137 110 000141 111 000143 112 000145 114 000147 115 000151 116 000155 117 000157 118 000162 119 000167 120 000170 121 000177 122 000200 123 000201 125 000202 126 000204 127 000205 128 000211 129 000226 130 000230 131 000233 132 000235 134 000237 135 000242 136 000245 137 000247 138 000255 139 000262 140 000264 141 000266 142 000277 143 000303 144 000305 145 000307 146 000311 147 000312 149 000314 151 000343 154 000402 155 000403 156 000407 157 000412 159 000413 160 000414 161 000417 163 000420 182 000441 183 000444 184 000450 185 000452 186 000455 187 000456 188 000461 190 000464 192 000467 193 000471 195 000472 196 000502 197 000512 199 000515 200 000517 201 000522 202 000523 203 000526 204 000527 205 000534 206 000536 208 000537 209 000541 210 000545 211 000553 212 000564 213 000570 214 000571 215 000573 216 000576 217 000577 219 000601 221 000602 222 000605 224 000606 226 000607 227 000611 228 000615 229 000625 232 000634 234 000643 235 000647 237 000650 239 000652 240 000655 241 000657 242 000664 244 000666 247 000667 248 000672 251 000673 253 000674 254 000676 255 000703 256 000706 257 000712 258 000715 259 000721 260 000722 262 000723 263 000727 264 000731 265 000732 266 000737 267 000743 268 000744 269 000750 271 000751 272 000753 274 000755 276 000756 277 000760 278 000763 279 000764 280 000767 282 000770 283 000772 284 000775 289 000776 291 000777 295 001000 296 001003 297 001004 298 001006 299 001007 301 001015 302 001022 303 001026 304 001030 305 001032 306 001034 307 001035 308 001042 311 001043 312 001047 313 001050 314 001051 315 001056 316 001060 317 001061 322 001063 324 001067 325 001070 326 001132 327 001134 328 001137 331 001140 332 001141 333 001144 334 001150 335 001153 340 001154 342 001171 343 001174 345 001200 346 001234 347 001245 348 001247 349 001254 352 001256 356 001257 360 001274 361 001277 363 001301 365 001317 369 001320 371 001333 372 001336 374 001340 376 001356 380 001357 384 001374 385 001377 387 001401 389 001422 394 001423 416 001447 417 001466 418 001471 419 001476 421 001500 422 001506 424 001517 425 001522 428 001523 429 001527 430 001531 431 001533 432 001534 435 001535 436 001541 437 001544 438 001547 439 001551 440 001553 441 001560 444 001561 446 001607 448 001610 450 001611 451 001614 456 001615 460 001645 461 001650 462 001655 463 001657 465 001705 467 001706 473 001707 477 001724 478 001727 479 001733 483 001734 487 001762 488 001765 489 001772 490 001774 491 001776 492 002000 493 002005 499 002006 508 002007 509 002031 510 002033 511 002036 513 002037 514 002044 515 002056 517 002077 518 002136 521 002140 523 002142 ----------------------------------------------------------- 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