COMPILATION LISTING OF SEGMENT plio2_get_util_ Compiled by: Multics PL/I Compiler, Release 28d, of September 14, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 10/03/83 1413.6 mst Mon 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 plio2_get_util_:proc options(support); 11 12 /* updated 73-12-6 */ 13 /* 76-09-08: changed to use iox_$get_line call forwarder */ 14 /* 73-12-6: updated to replace ios_ with iox_ */ 15 16 /* 73-10-25: 17* changed to comply with BASIS. 18* Check how our guesses are when BASIS/1-12 comes out. 19* */ 20 /* 9-13-72: AG94 redefines the scanning for list 21* and data-directed fields. We implement these 22* changes here. */ 23 24 25 /* 7-26-71: brought SKIP and COLUMN into the fold by 26* adding them to the table-driven department. 27* 28* made eob = blc for a one-level rather than a two-level 29* scanning strategy. */ 30 31 /* 5-20-71: fixed get_prep to call get_value_data when appropriate. 32* there will thus only have to be the one call to terminate. */ 33 34 /* 5-18-71: fixed get_edit so that it does not count 35* or transmit NL characters. */ 36 37 38 /* 39* This is the only procedure in the stream-directed input package 40* which actually touches the input stream itself, hence does actual 41* reads. 42* */ 43 44 45 dcl (addr, addrel, divide, index, mod, null, string, substr) builtin; 46 dcl based_int fixed bin (35) based; 47 dcl p_vector (100) ptr based; 48 dcl ( off_end_sw init(0),return_sw ,i,erno,gcn,gsn, 49 lout,gsi,count ) fixed bin(15); 50 51 dcl (psp,pspp,fsbp) ptr; 52 53 dcl condition char(10) init("ERROR"); 54 dcl ermsg char(9) init("plio2_get_util_"); 55 56 dcl ( ctl_char$np,ctl_char$nl,ctl_char$ht ) char(1) aligned external static; 57 58 dcl x char(1) aligned; 59 dcl 1 fakeinteger aligned based(addr(xint)), 60 2 xx char(3) unaligned, 61 2 intchar char(1) unaligned; 62 dcl xint fixed bin(15) init(0); 63 64 dcl ( iaction,iactstate,istate,itype,last_space) fixed bin(15); 65 66 67 dcl 1 getfab2 aligned internal static, 68 2 gfs bit(36) init("001001001"b), 69 2 gfn char(32) init(""), 70 2 ( gfbs,gfls,gfps) fixed bin(15) init(0); 71 72 dcl 1 gu_data aligned based(ps.auxp), 73 2 ii fixed bin(15), 74 2 char256al char(256) aligned, 75 2 first_non_space fixed bin(15); 76 77 dcl plio2_get_util_$get_prep_ ext entry(ptr); 78 dcl iox_$get_line entry (ptr, ptr, fixed bin(21), fixed bin(21), fixed bin(35)); 79 dcl plio2_open_$open_implicit_ ext entry(ptr); 80 dcl put_copy_ ext entry(ptr,fixed bin(21)); 81 dcl plio2_gvd_ ext entry(ptr); 82 dcl plio2_signal_$s_r_ ext entry(ptr,char(*),char(*),fixed bin(15)); 83 dcl ioa_ ext entry options(variable); 84 85 dcl iocb_p ptr; 86 dcl iocb_status fixed bin(35); 87 dcl error_table_$short_record fixed bin(35) external; 88 dcl error_table_$long_record fixed bin(35) external; 1 1 /* BEGIN INCLUDE FILE ... plio2_fsb.incl.pl1 */ 1 2 /* format: style3,idind30 */ 1 3 1 4 declare 1 fsb aligned based (fsbp), 1 5 2 switch aligned, 1 6 3 zot (2) bit (1) unaligned, 1 7 3 version_2 bit (1) unaligned, 1 8 3 open bit (1) unaligned, 1 9 3 print bit (1) unaligned, 1 10 3 input bit (1) unaligned, 1 11 3 output bit (1) unaligned, 1 12 3 update bit (1) unaligned, 1 13 3 stream bit (1) unaligned, 1 14 3 notkeyed bit (1) unaligned, 1 15 3 record bit (1) unaligned, 1 16 3 sequential bit (1) unaligned, 1 17 3 direct bit (1) unaligned, 1 18 3 interactive bit (1) unaligned, 1 19 3 not_used_1 bit (1) unaligned, 1 20 3 not_used_2 bit (1) unaligned, 1 21 3 stringvalue bit (1) unaligned, 1 22 3 keyed bit (1) unaligned, 1 23 3 namelist bit (1) unaligned, 1 24 3 implementation bit (1) unaligned, 1 25 3 not_used_4 bit (1) unaligned, /* old get-input eof flag */ 1 26 3 transmit_error bit (1) unaligned, 1 27 3 buffer_in_use bit (1) unaligned, 1 28 3 copy bit (1) unaligned, 1 29 3 detach bit (1) unaligned, 1 30 3 te_hold bit (1) unaligned, 1 31 3 not_used_5 bit (1) unaligned, 1 32 3 internal bit (1) unaligned, 1 33 3 threaded bit (1) unaligned, 1 34 3 fsb_in_use bit (1) unaligned, 1 35 3 console bit (1) unaligned, 1 36 3 emptyline bit (1) unaligned, 1 37 3 iox_close bit (1) unaligned, 1 38 3 xxx4 bit (1) unaligned, 1 39 3 xxx5 bit (1) unaligned, 1 40 3 xxx6 bit (1) unaligned, 1 41 2 nono aligned, 1 42 3 bit_string bit (1) unaligned, 1 43 3 not_used_3 bit (1) unaligned, 1 44 3 read bit (1) unaligned, 1 45 3 write bit (1) unaligned, 1 46 3 rewrite bit (1) unaligned, 1 47 3 delete bit (1) unaligned, 1 48 3 locate bit (1) unaligned, 1 49 3 key bit (1) unaligned, 1 50 3 keyto bit (1) unaligned, 1 51 3 keyfrom bit (1) unaligned, 1 52 3 set bit (1) unaligned, 1 53 3 into bit (1) unaligned, 1 54 3 ignore bit (1) unaligned, 1 55 3 from bit (1) unaligned, 1 56 3 nofrom bit (1) unaligned, 1 57 3 nokey bit (1) unaligned, 1 58 3 nokeyfrom bit (1) unaligned, 1 59 3 nolock bit (1) unaligned, 1 60 2 lsep fixed bin (15), /* (1,COMMA)(2,BL)(3,TAB)(4,NL)(5,SEMI) */ 1 61 2 iocb_p ptr unaligned, /* identifies data_set to iox_ */ 1 62 2 blc fixed bin (21), /* buffer's last character (input) */ 1 63 2 bsize fixed bin (21), /* size of buffer */ 1 64 2 bptr ptr, /* address of buffer */ 1 65 2 bnc fixed bin (15), /* next character in buffer */ 1 66 2 kol fixed bin (15), /* last column read from or written into */ 1 67 2 lsize fixed bin (15), /* line size (output) */ 1 68 2 lineno fixed bin (15), /* current line (output) - starts at 1 on each new page */ 1 69 2 psize fixed bin (35), /* page size (output) */ 1 70 2 pageno fixed bin (15), /* current page number, starts at 1 */ 1 71 2 limit fixed bin (15), 1 72 2 lnzc fixed bin (35), 1 73 2 filename char (32) aligned, /* declared file name */ 1 74 2 title char (32) unaligned,/* Multics I/O switch */ 1 75 2 fsb_thread ptr, 1 76 2 buffer (212) fixed bin (15), 1 77 2 path_name char (168) unal, /* title option */ 1 78 2 declared_attributes (2) bit (36) aligned; 1 79 1 80 declare xbuf char (1000) unaligned based (fsb.bptr); 1 81 1 82 /* END INCLUDE FILE ... plio2_fsb.incl.pl1 */ 89 2 1 /* BEGIN INCLUDE FILE ... plio2_ps.incl.pl1 */ 2 2 /* Stream I/O data block used by PL/I I/O runtime routines. 2 3* 2 4* Modified: 31 January 1978 by RAB to change plio2_data_$fsb_thread to plio2_data_fsb_thread_ 2 5**/ 2 6 /* format: style3,idind30 */ 2 7 2 8 /* based */ 2 9 2 10 declare 1 ps aligned based (psp),/* items set NORMALLY by compiled procedures */ 2 11 2 stack_frame_p ptr, /* items set in block prologue */ 2 12 2 ST_top_p ptr, 2 13 2 ST_block_p ptr, 2 14 2 format_area_p ptr, 2 15 2 ss_list_p ptr, 2 16 2 ab_return, /* items set in prep call */ 2 17 3 abret (3) ptr, 2 18 2 source_p ptr, /* addr(fakefsb) for string option, 2 19* addr(file) for explicit file option */ 2 20 2 special_list_p ptr, /* addr(OKlist) for get data, addr(format_list) for edit */ 2 21 2 copy_file_p ptr, 2 22 2 job aligned, 2 23 3 explicit_file bit (1) unal, 2 24 3 string bit (1) unal, 2 25 3 varying_string bit (1) unal, 2 26 3 data bit (1) unal, 2 27 3 edit bit (1) unal, 2 28 3 list bit (1) unal, 2 29 3 get bit (1) unal, 2 30 3 put bit (1) unal, 2 31 3 page bit (1) unal, 2 32 3 line bit (1) unal, 2 33 3 skip bit (1) unal, 2 34 3 copy bit (1) unal, 2 35 3 p1p2 bit (1) unal, 2 36 3 bit_string bit (1) unal, /* for environment(stringvalue) */ 2 37 3 char_string bit (1) unal, 2 38 3 read bit (1) unal, 2 39 3 write bit (1) unal, 2 40 3 rewrite bit (1) unal, 2 41 3 delete bit (1) unal, 2 42 3 locate bit (1) unal, 2 43 3 key bit (1) unal, 2 44 3 keyto bit (1) unal, 2 45 3 keyfrom bit (1) unal, 2 46 3 set bit (1) unal, 2 47 3 into bit (1) unal, 2 48 3 ignore bit (1) unal, 2 49 3 from bit (1) unal, 2 50 3 version bit (6) unal, 2 51 3 not_byte_buffer bit (1) unal, 2 52 3 pad1 bit (1) unal, 2 53 3 packed_ptr bit (1) unal, 2 54 2 number fixed bin (15), 2 55 2 value_p ptr, /* items set NORMALLY by compiled procedures per transmission */ 2 56 2 descriptor bit (36) aligned, 2 57 2 length fixed bin (15), /* may be swallowed into descriptor */ 2 58 2 top_half bit (18) unal, 2 59 2 offset bit (18) unal, 2 60 2 prep fixed bin (15), /* items treated ABNORMALLY, written by user and PLIO */ 2 61 2 new_format fixed bin (15), 2 62 2 switch aligned, /* items used by PLIO and not touched by compiled procedures */ 2 63 3 first_field bit (1) unal, 2 64 3 file bit (1) unal, 2 65 3 transmit_error bit (1) unal, 2 66 3 semi_sep bit (1) unal, 2 67 3 pad2 bit (32) unal, 2 68 2 file_p ptr, 2 69 2 fsbp ptr, 2 70 2 auxp ptr, /* used as addr(ldidata) for GETs */ 2 71 2 fabp ptr, 2 72 2 fab2p ptr, 2 73 2 vp ptr, 2 74 2 descr bit (36) aligned, 2 75 2 start_copy fixed bin (15), 2 76 2 quick_stream_storage, 2 77 3 a_stored fixed bin (35), 2 78 3 q_stored fixed bin (35); 2 79 2 80 /* external static */ 2 81 2 82 declare ( 2 83 plio2_data_$pspstat, 2 84 plio2_data_$fsbpstat, 2 85 plio2_data_$badfsbp, 2 86 plio2_data_$fabpstat, 2 87 plio2_data_$fab2pstat, 2 88 plio2_data_$pliostringfsbp 2 89 ) ptr external static; 2 90 2 91 dcl plio2_data_fsb_thread_ ptr ext static initial (null); 2 92 /* *system var */ 2 93 2 94 declare ( 2 95 plio2_data_$badjob bit (36) aligned, 2 96 plio2_data_$undef_file_sw bit (1) aligned 2 97 ) external static; 2 98 2 99 /* END INCLUDE FILE ... plio2_ps.incl.pl1 */ 90 3 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 3 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 3 3* version number to IOX2. */ 3 4 /* format: style2 */ 3 5 3 6 dcl 1 iocb aligned based, /* I/O control block. */ 3 7 2 version character (4) aligned, /* IOX2 */ 3 8 2 name char (32), /* I/O name of this block. */ 3 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 3 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 3 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 3 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 3 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 3 14 2 reserved bit (72), /* Reserved for future use. */ 3 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 3 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 3 17 /* open(p,mode,not_used,s) */ 3 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 3 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 20 /* get_line(p,bufptr,buflen,actlen,s) */ 3 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 3 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 3 24 /* put_chars(p,bufptr,buflen,s) */ 3 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 3 26 /* modes(p,newmode,oldmode,s) */ 3 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 3 28 /* position(p,u1,u2,s) */ 3 29 2 control entry (ptr, char (*), ptr, fixed (35)), 3 30 /* control(p,order,infptr,s) */ 3 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 32 /* read_record(p,bufptr,buflen,actlen,s) */ 3 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 3 34 /* write_record(p,bufptr,buflen,s) */ 3 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 3 36 /* rewrite_record(p,bufptr,buflen,s) */ 3 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 3 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 3 39 /* seek_key(p,key,len,s) */ 3 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 3 41 /* read_key(p,key,len,s) */ 3 42 2 read_length entry (ptr, fixed (21), fixed (35)), 3 43 /* read_length(p,len,s) */ 3 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 3 45 /* open_file(p,mode,desc,not_used,s) */ 3 46 2 close_file entry (ptr, char (*), fixed bin (35)), 3 47 /* close_file(p,desc,s) */ 3 48 2 detach entry (ptr, char (*), fixed bin (35)); 3 49 /* detach(p,desc,s) */ 3 50 3 51 declare iox_$iocb_version_sentinel 3 52 character (4) aligned external static; 3 53 3 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 91 92 93 94 95 96 /* GET FIELD and SPACING ENTRIES */ 97 get_field_data_:entry(pspp); 98 /* will signal EOF unless field of length >0 of the form: 99* []...[] {;|=} 100* is scanned. MAY RETURN SHORT FIELD: {;|=} 101* leading s are NOT returned 102* no characters are returned. 103* For the sake of "onfield" included s are left, so 104* a field of the form: 105* "a(3, 5). b(88 , 99 ) =" 106* is possible. 107* */ 108 109 istate=2; 110 field_prep: 111 psp=pspp; 112 fsbp=ps.fsbp; 113 lout=0; 114 go to get_next_char; 115 116 117 118 119 get_field_edit_:entry(pspp); 120 return_sw=1; 121 edit_set_up: 122 psp=pspp; 123 istate=1; 124 count=ii; 125 if count>256 then goto err149; 126 go to field_prep; 127 128 129 130 131 get_field_list_:entry(pspp); 132 /* will signal EOF or ERROR. 133* lout=0 returned to indicate []... {EOF | ,} 134* leading s are required for "onfield", so 135* all s except s (which are removed) 136* are left in place. Thus, for example, a character representation 137* may not contain a (usefully, anyhow), for a 138* will not be returned. 139* 140* Sets first_non_space for ease of scanning. 141* */ 142 istate=4; 143 last_space=0; 144 go to field_prep; 145 146 147 148 149 get_x_format_:entry(pspp); 150 return_sw=0; 151 go to edit_set_up; 152 153 154 get_skip_:entry(pspp); 155 psp=pspp; 156 gsn=ii; 157 gsi=2; /* return*/ 158 fsbp=ps.fsbp; 159 go to do_skip; 160 161 162 get_column_:entry(pspp); 163 psp=pspp; 164 gcn=ii-1; /* we shall skip to and over the column 165* preceding the named column so that the 166* NEXT get will be from the numbered column */ 167 if gcn<0 then gcn=0; 168 fsbp=ps.fsbp; 169 go to do_column; 170 171 172 173 /* ******************************** */ 174 175 return_field: 176 ii=lout; 177 first_non_space=last_space+1; 178 179 check_transmission_error: 180 if fsb.switch.transmit_error then go to set_trans_error; 181 if fsb.switch.te_hold then 182 do; 183 fsb.switch.te_hold="0"b; 184 set_trans_error: 185 ps.switch.transmit_error="1"b; 186 end; 187 188 place(2): 189 gc_exit: 190 return; 191 192 /* plio2_get_util_ character class table */ 193 194 dcl gu_cc(0:61) fixed bin(3) internal static init( 195 (9)0, /* 000 ... 010 */ 196 3,4, /* TAB,NL */ 197 0,4,(19)0, /* 013, NP, 015 ... 037 */ 198 2,0,7, /* BLANK, 041, QUOTE */ 199 (9)0, /* 043 ... 053 */ 200 1, /* COMMA */ 201 (14)0, /* 055 ... 072 */ 202 5,0,6); /* SEMI, 074 , EQUAL */ 203 204 /* ACTIONS and STATES - look O.K. 12-21-70 */ 205 206 dcl gu_matrix(9,0:8) fixed bin(9) static internal init( 207 208 /* STATE OTHER COMMA BLANK TAB NPNL SEMI EQUAL QUOTE OFFEND */ 209 /* 0 1 2 3 4 5 6 7 8 */ 210 211 /* 1-edit */ 61, 61, 61, 61, 11, 61, 61, 61, 51, 212 /* 2-data prep */ 23, 12, 12, 12, 12, 32, 32, 23, 52, 213 /* 3-data loop */ 23, 23, 23, 23, 13, 33, 33, 23, 53, 214 215 /* 4-list prep */ 29, 44, 24, 24, 14, 74, 29, 25, 54, 216 /* 5-list odd quote*/ 25, 25, 25, 25, 25, 25, 25, 26, 55, 217 /* 6-list even quote */29, 76, 76, 76, 76, 76, 29, 25, 76, 218 /* 7-skip */ (8)87,57, 219 /* 8-column */ (8)98,58, 220 /* 9-unquoted */ 29, 76, 76, 76, 76, 76, 29, 29, 79); 221 222 /* (action code, next state code ) */ 223 224 225 /* actions: 226* 1-get 2-move 3-move,exit 227* 4-list's comma 5-off the end 6-count for edit 228* 7-eo_list 8-skip 9-column */ 229 230 action(3): 231 /* returns terminating EQ or SEMI 232* that character must be re-scanned and then 233* removed in the calling program */ 234 lout=lout+1; 235 if lout<257 then substr(char256al,lout,1)=x; 236 go to return_field; 237 238 action(4): 239 /* list-prep sees []...{EOF|,} */ 240 lout=0; 241 if fsb.lsep=1 | ^ps.job.list then goto return_field; /* this is a second comma */ 242 fsb.lsep=1; /* this is a first comma - mark it */ 243 go to get_next_char; 244 /* lout=0 insures that the comma will not be passed 245* since there is nothing to move, "get next character" */ 246 247 248 action(5): 249 /* off-end may be either ENDFILE or ERROR depending 250* on file/string 251* and on stoppage DURING meaningful scan or before (or after) 252* meaningful scan. BASIS is unclear about purposes, but 253* generally says that EOF or EOS before the s have 254* been scanned leads to EOF, but in the midst of a scan leads 255* to ERROR. */ 256 257 if istate=2 then condition="ENDFILE"; 258 if istate=4 then if lout=0 then condition="ENDFILE"; 259 else goto action(4); 260 if istate=1 then if lout=0 then condition="ENDFILE"; 261 262 goto err162; 263 264 action(6): 265 /* count for edit and get_x_format_ */ 266 lout=lout+1; 267 if return_sw^=0 then substr(char256al,lout,1)=x; 268 if lout=count then go to check_transmission_error; 269 go to action(1); 270 271 action(7): 272 /* we seem to have found an */ 273 if itype=8 /* off-end */ 274 then goto return_field; 275 276 if x=";" then if ps.job.list then 277 do; 278 istate=9; 279 goto action(2); 280 end; 281 else if istate=4 then lout=0; 282 283 fsb.lsep=index(", "||" 284 ;",x); 285 if x=";" then 286 ps.switch.semi_sep="1"b; 287 go to return_field; 288 289 /* */ 290 err149: 291 /* will not extract field of length over 256 */ 292 erno=149; 293 goto sandr; 294 295 err162: 296 /* string of string-option too short */ 297 if ^ps.job.string then goto err163; 298 erno=162; 299 goto sandr; 300 301 err163: 302 /* EOF while scanning */ 303 erno=163; 304 goto signal_endfile; 305 306 /* 307*err164: 308* /* EOF already encountered 309* erno=164; 310* goto signal_endfile; 311**/ 312 313 err165: 314 /* get requires input,stream */ 315 erno=165; 316 goto sandr; 317 318 err166: 319 /* target of COLUMN lies inside a TAB */ 320 erno=166; 321 goto sandr; 322 323 signal_endfile: 324 condition="endfile"; 325 goto sandr; 326 327 sandr: 328 if ps.job.string then condition="ERROR"; 329 330 call plio2_signal_$s_r_(psp,condition,ermsg,erno); 331 /* signals and causes abnormal return */ 332 333 /* */ 334 move: 335 action(2): /* is never made part of the string to be returned */ 336 if x=ctl_char$nl then goto get_next_char; 337 338 lout=lout+1; 339 if istate=4 then last_space=lout; 340 if lout>256 then go to return_field; 341 substr(char256al,lout,1)=x; 342 343 get_next_char: 344 action(1): 345 if bnc>blc then 346 do; 347 get_replenish: 348 bnc=1; /* we will attempt to fill up the buffer 349* and we start at position 1 */ 350 if ps.job.copy then 351 do; 352 call put_copy_(psp,fsb.blc); 353 ps.start_copy=1; 354 end; 355 356 if ps.job.string then goto string_is_empty; 357 if fsb.switch.not_used_4 then goto file_at_eof; /* OLD EOF FLAG */ 358 if fsb.switch.transmit_error then 359 do; 360 fsb.switch.transmit_error="0"b; 361 fsb.switch.te_hold="1"b; 362 end; 363 364 iocb_p=fsb.iocb_p; 365 call iox_$get_line(iocb_p,fsb.bptr,fsb.bsize,fsb.blc,iocb_status); 366 if iocb_status ^=0 then 367 do; 368 if iocb_status=error_table_$long_record then; else 369 if iocb_status=error_table_$short_record then; else 370 fsb.transmit_error = "1"b; 371 end; 372 373 if fsb.blc^=0 then go to buffer_replenished; 374 file_at_eof: 375 fsb.switch.not_used_4="1"b; /* EOF ACTION */ 376 string_is_empty: 377 off_end_sw=1; 378 buffer_replenished: 379 if off_end_sw^=0 then 380 do; 381 itype=8; 382 go to re_act; 383 end; 384 end; 385 386 x=substr(xbuf,bnc,1); 387 bnc=bnc+1; 388 389 if x=ctl_char$nl then 390 /* new line character . . . */ 391 do; 392 kol=0; 393 go to get_itype; 394 end; 395 396 if x=ctl_char$ht then 397 /* horizontal tab character */ 398 do; 399 kol=10+10*(divide(kol,10,15,0)); 400 go to get_itype; 401 end; 402 403 if x=ctl_char$np then goto get_itype; 404 /* new page character */ 405 406 kol=kol+1; 407 408 get_itype: 409 intchar=x; 410 if xint>61 then itype=0; /* other */ 411 else itype=gu_cc(xint); 412 413 re_act: 414 iactstate=gu_matrix(istate,itype); 415 iaction=divide(iactstate,10,15,0); 416 istate=mod(iactstate,10); 417 go to action(iaction); 418 419 420 /* */ 421 /* CODE for SKIP and COLUMN */ 422 423 424 425 426 do_column: 427 if kol=gcn then go to gc_exit; 428 if kol > gcn then 429 do; 430 gsi=4; 431 gsn=1; 432 go to do_skip; /* try to find column in next line */ 433 place(4): go to do_column; 434 end; 435 istate=8; 436 go to get_next_char; 437 action(9): 438 if kol=0 then go to gc_exit; 439 if kol=gcn then go to gc_exit; 440 if kol gcn : a tab has carried us over the desired column */ 443 goto err166; 444 445 446 do_skip: 447 istate=7; 448 449 if fsb.lsep=4 /* NL */ then gsn=gsn-1; 450 451 do i= 1 to gsn; 452 go to get_next_char; 453 action(8): 454 if x=ctl_char$nl then go to dse; /* kol=0 doesn't work now that there is NP */ 455 go to get_next_char; 456 dse: end; 457 458 if gsi=6 then goto return_from_prep_skip; 459 go to place(gsi); 460 461 /* TERMINATE and PREP for GET */ 462 get_terminate_:entry(pspp); 463 psp=pspp; 464 if ps.prep^=0 then call plio2_get_util_$get_prep_(psp); 465 /* Due to a change in pl1_operator_'s 466* entry stream_prep, the prep work will 467* be done prior to the first transmission 468* or terminate call. */ 469 fsbp=ps.fsbp; 470 if ps.job.copy then call put_copy_(psp,fsb.bnc-1); 471 if ^ps.job.list then fsb.lsep=1; /* so that following comma 472* will be 2nd comma */ 473 return; 474 475 get_prep_:entry(pspp); 476 plio2_data_$pspstat, 477 psp=pspp; 478 ps.prep=0; 479 480 string(ps.switch)="0"b; 481 /* STRING OPTION */ 482 if ps.job.string then 483 do; 484 plio2_data_$pliostringfsbp, 485 plio2_data_$fsbpstat, 486 ps.fsbp, 487 fsbp= ps.source_p; /* for STRING OPTION 488* source_p points to the fake FSB 489* and fake FSB's bptr is addr(string). 490* length(string) is in ps.number */ 491 492 bnc=1; 493 kol=0; 494 495 if ps.varying_string then i=addrel(bptr,-1)->based_int; 496 else i=ps.number; 497 498 bsize,blc=i; 499 500 fsb.title,fsb.filename="""get_string_option"""; 501 /* for string option, 502* fsb.buffer, 503* fsb.path_name, 504* fsb.declared_attributes(2) 505* must not be used - fake_fsb is too short */ 506 507 508 string(fsb.switch)="001101001"b; 509 ps.file_p=null; 510 go to prep_exit; 511 end; 512 513 /* FILE OPTION - EXPLICIT OR IMPLICIT */ 514 if ps.job.explicit_file then 515 ps.file_p=ps.source_p; 516 else do; 517 call ioa_("error in get prep: no explicit file"); 518 ps.file_p=addr_sysin(); 519 ps.job.explicit_file="1"b; 520 end; 521 522 ps.fsbp,fsbp,plio2_data_$fsbpstat=ps.file_p->p_vector(2); 523 if fsb.switch.open then go to open1; 524 plio2_data_$fab2pstat,ps.fab2p=addr(getfab2); 525 call plio2_open_$open_implicit_(psp); 526 open1: 527 /* if fsb.switch.eof then goto err164; */ 528 if fsb.switch.input="0"b|fsb.switch.stream="0"b then goto err165; 529 prep_exit: 530 if ps.job.copy then 531 do; 532 ps.start_copy=bnc; 533 call put_copy_(psp,-1); /* SIGNAL to OPEN the COPY-FILE */ 534 end; 535 if ps.job.skip then 536 do; 537 gsi=6; /* and then return */ 538 gsn=ps.number; 539 go to do_skip; 540 return_from_prep_skip: 541 place(6): 542 end; 543 544 if ps.job.data then call plio2_gvd_(psp); 545 546 return; 547 548 addr_sysin:proc returns(ptr); 549 dcl sysin file input stream; 550 return(addr(sysin)); 551 end addr_sysin; 552 553 end plio2_get_util_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/03/83 1005.4 plio2_get_util_.pl1 >spec>on>pl128d>plio2_get_util_.pl1 89 1 08/13/81 2043.5 plio2_fsb.incl.pl1 >ldd>include>plio2_fsb.incl.pl1 90 2 08/13/81 2043.5 plio2_ps.incl.pl1 >ldd>include>plio2_ps.incl.pl1 91 3 05/20/83 1846.4 iocb.incl.pl1 >ldd>include>iocb.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 45 ref 408 524 550 addrel builtin function dcl 45 ref 495 auxp 44 based pointer level 2 dcl 2-10 ref 124 156 164 175 177 235 267 341 based_int based fixed bin(35,0) dcl 46 ref 495 blc 4 based fixed bin(21,0) level 2 dcl 1-4 set ref 343 352* 365* 373 498* bnc 10 based fixed bin(15,0) level 2 dcl 1-4 set ref 343 347* 386 387* 387 470 492* 532 bptr 6 based pointer level 2 dcl 1-4 set ref 365* 386 495 bsize 5 based fixed bin(21,0) level 2 dcl 1-4 set ref 365* 498* char256al 1 based char(256) level 2 dcl 72 set ref 235* 267* 341* condition 000116 automatic char(10) initial unaligned dcl 53 set ref 53* 248* 258* 260* 323* 327* 330* copy 26(11) based bit(1) level 3 packed unaligned dcl 2-10 ref 350 470 529 count 000110 automatic fixed bin(15,0) dcl 48 set ref 124* 125 268 ctl_char$ht 000032 external static char(1)QComm Bdp Comm Office O؟) Oӏ6N[MacDonald ĘfJ MacDonald mac SysMaint SJ|TT@ noneVIP7400_DTR R!STBhkHeimrich RĺB RĺB Heimrich MSGD Qj0K6 283 input 0(05) based bit(1) level 3 packed unaligned dcl 1-4 set ref 526 intchar 0(27) based char(1) level 2 packed unaligned dcl 59 set ref 408* ioa_ 000050 constant entry external dcl 83 ref 517 iocb_p 000134 automatic pointer dcl 85 in procedure "plio2_get_util_" set ref 364* 365* iocb_p 3 based pointer level 2 in structure "fsb" packed unaligned dcl 1-4 in procedure "plio2_get_util_" ref 364 iocb_status 000136 automatic fixed bin(35,0) dcl 86 set ref 365* 366 368 368 iox_$get_line 000036 constant entry external dcl 78 ref 365 istate 000130 automatic fixed bin(15,0) dcl 64 set ref 109* 123* 142* 248 258 260 278* 281 339 413 416* 435* 446* itype 000131 automatic fixed bin(15,0) dcl 64 set ref 271 381* 410* 411* 413 job 26 based structure level 2 dcl 2-10 kol 11 based fixed bin(15,0) level 2 dcl 1-4 set ref 392* 399* 399 406* 406 426 428 437 439 440 493* last_space 000132 automatic fixed bin(15,0) dcl 64 set ref 143* 177 339* list 26(05) based bit(1) level 3 packed unaligned dcl 2-10 ref 241 276 471 lout 000106 automatic fixed bin(15,0) dcl 48 set ref 113* 175 230* 230 235 235 238* 258 260 264* 264 267 268 281* 338* 338 339 340 341 lsep 2 based fixed bin(15,0) level 2 dcl 1-4 set ref 241 242* 283* 449 471* mod builtin function dcl 45 ref 416 not_used_4 0(20) based bit(1) level 3 packed unaligned dcl 1-4 set ref 357 374* null builtin function dcl 45 ref 509 number 27 based fixed bin(15,0) level 2 dcl 2-10 ref 496 538 off_end_sw 000100 automatic fixed bin(15,0) initial dcl 48 set ref 48* 376* 378 open 0(03) based bit(1) level 3 packed unaligned dcl 1-4 set ref 523 p_vector based pointer array dcl 47 ref 522 plio2_data_$fab2pstat 000062 external static pointer dcl 2-82 set ref 524* plio2_data_$fsbpstat 000060 external static pointer dcl 2-82 set ref 484* 522* plio2_data_$pliostringfsbp 000064 external static pointer dcl 2-82 set ref 484* plio2_data_$pspstat 000056 external static pointer dcl 2-82 set ref 476* plio2_get_util_$get_prep_ 000034 constant entry external dcl 77 ref 464 plio2_gvd_ 000044 constant entry external dcl 81 ref 544 plio2_open_$open_implicit_ 000040 constant entry external dcl 79 ref 525 plio2_signal_$s_r_ 000046 constant entry external dcl 82 ref 330 prep 35 based fixed bin(15,0) level 2 dcl 2-10 set ref 464 478* ps based structure level 1 dcl 2-10 psp 000112 automatic pointer dcl 51 set ref 110* 112 121* 124 155* 156 158 163* 164 168 175 177 184 235 241 267 276 285 295 327 330* 341 350 352* 353 356 463* 464 464* 469 470 470* 471 476* 478 480 482 484 484 495 496 509 514 514 514 518 519 522 522 524 525* 529 532 533* 535 538 544 544* pspp parameter pointer dcl 51 ref 97 110 119 121 131 149 154 155 162 163 462 463 475 476 put_copy_ 000042 constant entry external dcl 80 ref 352 470 533 return_sw 000101 automatic fixed bin(15,0) dcl 48 set ref 120* 150* 267 semi_sep 37(03) based bit(1) level 3 packed unaligned dcl 2-10 set ref 285* skip 26(10) based bit(1) level 3 packed unaligned dcl 2-10 ref 535 source_p 20 based pointer level 2 dcl 2-10 ref 484 514 start_copy 55 based fixed bin(15,0) level 2 dcl 2-10 set ref 353* 532* stream 0(08) based bit(1) level 3 packed unaligned dcl 1-4 set ref 526 string builtin function dcl 45 in procedure "plio2_get_util_" set ref 480* 508* string 26(01) based bit(1) level 3 in structure "ps" packed unaligned dcl 2-10 in procedure "plio2_get_util_" ref 295 327 356 482 substr builtin function dcl 45 set ref 235* 267* 341* 386 switch based structure level 2 in structure "fsb" dcl 1-4 in procedure "plio2_get_util_" set ref 508* switch 37 based structure level 2 in structure "ps" dcl 2-10 in procedure "plio2_get_util_" set ref 480* sysin 000066 constant file input stream dcl 549 set ref 550* te_hold 0(25) based bit(1) level 3 packed unaligned dcl 1-4 set ref 181 183* 361* title 30 based char(32) level 2 packed unaligned dcl 1-4 set ref 500* transmit_error 37(02) based bit(1) level 3 in structure "ps" packed unaligned dcl 2-10 in procedure "plio2_get_util_" set ref 184* transmit_error 0(21) based bit(1) level 3 in structure "fsb" packed unaligned dcl 1-4 in procedure "plio2_get_util_" set ref 179 358 360* 369* varying_string 26(02) based bit(1) level 3 packed unaligned dcl 2-10 ref 495 x 000124 automatic char(1) dcl 58 set ref 235 267 276 283 285 334 341 386* 389 396 403 408 453 xbuf based char(1000) unaligned dcl 1-80 ref 386 xint 000125 automatic fixed bin(15,0) initial dcl 62 set ref 62* 408 410 411 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. iocb based structure level 1 dcl 3-6 iox_$iocb_version_sentinel external static char(4) dcl 3-51 plio2_data_$badfsbp external static pointer dcl 2-82 plio2_data_$badjob external static bit(36) dcl 2-94 plio2_data_$fabpstat external static pointer dcl 2-82 plio2_data_$undef_file_sw external static bit(1) dcl 2-94 plio2_data_fsb_thread_ external static pointer initial dcl 2-91 NAMES DECLARED BY EXPLICIT CONTEXT. action 000005 constant label array(9) dcl 230 ref 258 269 279 417 addr_sysin 001556 constant entry internal dcl 548 ref 518 buffer_replenished 001107 constant label dcl 378 ref 373 check_transmission_error 000522 constant label dcl 179 ref 268 do_column 001174 constant label dcl 426 ref 169 433 do_skip 001221 constant label dcl 446 ref 159 432 539 dse 001247 constant label dcl 456 ref 453 edit_set_up 000377 constant label dcl 121 ref 151 err149 000671 constant label dcl 290 ref 125 err162 000674 constant label dcl 295 ref 262 err163 000703 constant label dcl 301 ref 295 err165 000706 constant label dcl 313 ref 526 err166 000711 constant label dcl 318 ref 443 field_prep 000354 constant label dcl 110 set ref 126 144 file_at_eof 001103 constant label dcl 374 ref 357 gc_exit 000535 constant label dcl 188 ref 426 437 439 get_column_ 000470 constant entry external dcl 162 get_field_data_ 000343 constant entry external dcl 97 get_field_edit_ 000366 constant entry external dcl 119 get_field_list_ 000414 constant entry external dcl 131 get_itype 001145 constant label dcl 408 ref 393 400 403 get_next_char 000776 constant label dcl 343 ref 114 243 334 436 440 452 455 get_prep_ 001340 constant entry external dcl 475 get_replenish 001002 constant label dcl 347 get_skip_ 000444 constant entry external dcl 154 get_terminate_ 001257 constant entry external dcl 462 get_x_format_ 000431 constant entry external dcl 149 move 000754 constant label dcl 334 open1 001501 constant label dcl 526 ref 523 place 000000 constant label array(2:6) dcl 188 ref 459 plio2_get_util_ 000330 constant entry external dcl 10 prep_exit 001507 constant label dcl 529 ref 510 re_act 001157 constant label dcl 413 ref 382 return_field 000513 constant label dcl 175 set ref 236 241 271 287 340 return_from_prep_skip 001542 constant label dcl 540 ref 458 sandr 000720 constant label dcl 327 ref 293 299 316 321 325 set_trans_error 000532 constant label dcl 184 ref 179 signal_endfile 000714 constant label dcl 323 ref 304 string_is_empty 001105 constant label dcl 376 ref 356 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2106 2200 1603 2116 Length 2464 1603 72 247 303 16 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME plio2_get_util_ 134 external procedure is an external procedure. addr_sysin internal procedure shares stack frame of external procedure plio2_get_util_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 getfab2 plio2_get_util_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME plio2_get_util_ 000100 off_end_sw plio2_get_util_ 000101 return_sw plio2_get_util_ 000102 i plio2_get_util_ 000103 erno plio2_get_util_ 000104 gcn plio2_get_util_ 000105 gsn plio2_get_util_ 000106 lout plio2_get_util_ 000107 gsi plio2_get_util_ 000110 count plio2_get_util_ 000112 psp plio2_get_util_ 000114 fsbp plio2_get_util_ 000116 condition plio2_get_util_ 000121 ermsg plio2_get_util_ 000124 x plio2_get_util_ 000125 xint plio2_get_util_ 000126 iaction plio2_get_util_ 000127 iactstate plio2_get_util_ 000130 istate plio2_get_util_ 000131 itype plio2_get_util_ 000132 last_space plio2_get_util_ 000134 iocb_p plio2_get_util_ 000136 iocb_status plio2_get_util_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return mod_fx1 ext_entry set_support THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_ iox_$get_line plio2_get_util_$get_prep_ plio2_gvd_ plio2_open_$open_implicit_ plio2_signal_$s_r_ put_copy_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. ctl_char$ht ctl_char$nl ctl_char$np error_table_$long_record error_table_$short_record plio2_data_$fab2pstat plio2_data_$fsbpstat plio2_data_$pliostringfsbp plio2_data_$pspstat sysin sysin.fsb LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 48 000313 53 000314 54 000317 62 000324 10 000327 97 000337 109 000352 110 000354 112 000360 113 000362 114 000363 119 000364 120 000375 121 000377 123 000403 124 000405 125 000407 126 000411 131 000412 142 000423 143 000425 144 000426 149 000427 150 000440 151 000441 154 000442 155 000453 156 000457 157 000461 158 000463 159 000465 162 000466 163 000477 164 000503 167 000506 168 000510 169 000512 175 000513 177 000516 179 000522 181 000525 183 000530 184 000532 188 000535 230 000536 235 000537 236 000547 238 000550 241 000551 242 000561 243 000563 248 000564 258 000572 260 000601 262 000611 264 000612 267 000613 268 000623 269 000626 271 000627 276 000632 278 000641 279 000643 281 000644 283 000650 285 000662 287 000670 290 000671 293 000673 295 000674 298 000700 299 000702 301 000703 304 000705 313 000706 316 000710 318 000711 321 000713 323 000714 325 000717 327 000720 330 000727 334 000754 338 000760 339 000761 340 000766 341 000771 343 000776 347 001002 350 001004 352 001010 353 001021 356 001024 357 001030 358 001033 360 001036 361 001040 364 001042 365 001045 366 001065 368 001067 368 001073 369 001076 373 001100 374 001103 376 001105 378 001107 381 001111 382 001113 386 001114 387 001123 389 001124 392 001130 393 001131 396 001132 399 001134 400 001141 403 001142 406 001144 408 001145 410 001150 411 001155 413 001157 415 001164 416 001166 417 001172 426 001174 428 001200 430 001201 431 001203 432 001205 433 001206 435 001207 436 001211 437 001212 439 001215 440 001217 443 001220 446 001221 449 001223 451 001231 452 001241 453 001242 455 001246 456 001247 458 001251 459 001254 462 001255 463 001266 464 001272 469 001303 470 001306 471 001326 473 001335 475 001336 476 001347 478 001355 480 001356 482 001357 484 001362 492 001367 493 001371 495 001372 496 001402 498 001404 500 001406 508 001414 509 001416 510 001420 514 001421 517 001427 518 001442 519 001451 522 001454 523 001464 524 001467 525 001473 526 001501 529 001507 532 001513 533 001516 535 001531 537 001535 538 001537 539 001541 544 001542 546 001555 548 001556 549 001560 550 001575 ----------------------------------------------------------- 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