COMPILATION LISTING OF SEGMENT ibm3270_io_call_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1645.5 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 /* IBM3270_IO_CALL_ - Handles the io_call order for the ibm3270_ i/o module */ 12 /* Written October 1977 by Larry Johnson */ 13 14 ibm3270_io_call_: proc (arg_iocbp, arg_info_ptr, arg_code); 15 16 /* Parameters */ 17 18 dcl arg_iocbp ptr; 19 dcl arg_info_ptr ptr; 20 dcl arg_code fixed bin (35); 21 22 /* Automatic */ 23 24 dcl code fixed bin (35); 25 dcl iocbp ptr; 26 dcl order char (32); 27 dcl ev_chan fixed bin (71); 28 dcl i fixed bin; 29 dcl (err, rpt) entry variable options (variable); 30 dcl caller char (32); 31 dcl free_areap ptr; 32 dcl arg_no fixed bin; 33 dcl carg char (io_call_info.max_arglen) based (addr (io_call_info.args (arg_no))) var; 34 dcl segp ptr; 35 dcl segl fixed bin (21); 36 dcl seg char (segl) based (segp); 37 dcl bit_count fixed bin (24); 38 dcl dir char (168); 39 dcl ename char (32); 40 41 dcl free_area area based (free_areap); 42 43 dcl 1 auto_read_ctl like read_ctl aligned automatic; 44 45 /* External */ 46 47 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); 48 dcl get_system_free_area_ entry returns (ptr); 49 dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)); 50 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 51 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 52 53 dcl error_table_$noarg ext fixed bin (35); 54 dcl error_table_$badopt ext fixed bin (35); 55 56 dcl conversion condition; 57 58 dcl (addr, bin, bit, length, null, rtrim, substr, unspec) builtin; 59 60 /* Constants */ 61 62 dcl write_help (5) char (256) var int static options (constant) init ( 63 "Usage: io_call control switchname write DEV {control_args} 64 Command control_args: 65 -write, -wr 66 -erase_write, -erwr 67 -copy DEV, -cp DEV (DEV is from device) 68 -erase_unprotected, -erun 69 -read_modified, -rdm 70 -read_buffer, -rdb", 71 "Write control char control_args: 72 -print_format BB, -pf BB 73 -start_printer, -sp 74 -sound_alarm, -sa 75 -keyboard_restore, -kr 76 -reset_mdt, -rm 77 -copy_bits BB, -cb BB", 78 "Order control_args: 79 -set_buffer_addr POS, -sba POS 80 -start_field, -sf 81 -insert_cursor, -ic 82 -program_tab, -pt 83 -repeat_to_addr POS, -rta POS 84 -erase_to_addr POS, -eta POS", 85 "Attribute control_args (-start_field implied): 86 -protected, -pr 87 -numeric, -num 88 -display_form BB, -df BB 89 -mdt", 90 "Other args: 91 ""data"" (arg with no '-' is stuff to write) 92 -string data (for when data starts with -) 93 -segment path, -sm path (when data is in segment) 94 -next (to start new write_info.data when no data)"); 95 1 1 /* Begin include file ..... io_call_info.incl.pl1 */ 1 2 1 3 /* This include file defines the info_structure used by an I/O module to perform an "io_call" order 1 4* on behalf of the io_call command. */ 1 5 /* Coded April 1976 by Larry Johnson */ 1 6 /* Changed June 1977 by Larry Johnson for "io_call_af" order */ 1 7 1 8 dcl io_call_infop ptr; 1 9 1 10 dcl 1 io_call_info aligned based (io_call_infop), 1 11 2 version fixed bin, 1 12 2 caller_name char (32), /* Caller name for error messages */ 1 13 2 order_name char (32), /* Actual name of the order to be performed */ 1 14 2 report entry variable options (variable), 1 15 /* Entry to ioa_ like procedure to report results */ 1 16 2 error entry variable options (variable), 1 17 /* Entry to com_err_ like procedure to report results */ 1 18 2 af_returnp ptr, /* Pointer to return string if "io_call_af" order */ 1 19 2 af_returnl fixed bin, /* Length of string */ 1 20 2 fill (5) bit (36) aligned, 1 21 2 nargs fixed bin, /* Number of additional command arguments provided */ 1 22 2 max_arglen fixed bin, /* Length of longest argument (used to define array) */ 1 23 2 args (0 refer (io_call_info.nargs)) char (0 refer (io_call_info.max_arglen)) varying; 1 24 1 25 dcl io_call_af_ret char (io_call_info.af_returnl) based (io_call_info.af_returnp) varying; 1 26 /* Return string for active function */ 1 27 1 28 /* End include file ..... io_call_info.incl.pl1 */ 96 97 2 1 /* Begin include file ..... ibm3270_io_info.incl.pl1 */ 2 2 2 3 /* 3270 input/output information structure */ 2 4 /* Initially constructed 09/08/77 by Larry Johnson and Warren Johnson */ 2 5 2 6 /* Following structure must be supplied for "read" order */ 2 7 2 8 dcl read_ctlp ptr; 2 9 2 10 dcl 1 read_ctl aligned based (read_ctlp), 2 11 2 version fixed bin, /* Currently one */ 2 12 2 areap ptr, /* Pointer to area where "read_info" is allocated */ 2 13 2 read_infop ptr, /* Pointer to read_info structure, allocatd by I/O module */ 2 14 2 max_len fixed bin, /* Max character length */ 2 15 2 max_fields fixed bin; /* Max number of fields in array */ 2 16 2 17 /* The following structure is allocate by the I/O module on a read order */ 2 18 /* It must be freed by the caller when no longer needed */ 2 19 2 20 dcl 1 read_info aligned based (read_ctl.read_infop), 2 21 2 version fixed bin, /* Currently 1 */ 2 22 2 next_read_infop ptr, /* Used by I/O module internally for chaining blocks */ 2 23 2 controller fixed bin, /* Controller which data is for */ 2 24 2 device fixed bin, /* Which device on that controller */ 2 25 2 reason, /* Reason for this data */ 2 26 3 key fixed bin, /* Indicates which key pressed, see codes below */ 2 27 3 sub_key fixed bin, /* For PF or PA, which one */ 2 28 3 code fixed bin (35), /* If reason is error, an error code */ 2 29 2 status, /* If reason STATUS, the status data */ 2 30 3 bits bit (12) unal, 2 31 3 fill bit (24) unal, 2 32 2 cursor_position fixed bin, /* Current cursor position */ 2 33 2 max_fields fixed bin, /* Used to define array */ 2 34 2 max_len fixed bin, /* Used to define array */ 2 35 2 mod_fields fixed bin, /* Number of elements in array actually filled in */ 2 36 2 data (read_ctl.max_fields refer (read_info.max_fields)), 2 37 3 field_position fixed bin, /* Address of field */ 2 38 3 contents char (read_ctl.max_len refer (read_info.max_len)) var; 2 39 2 40 /* Possible values for read_info.key */ 2 41 2 42 dcl (ERROR init (1), /* Serious error, see read_info.code */ 2 43 STATUS init (2), /* Device reported status */ 2 44 ENTER init (3), /* Entry key hit */ 2 45 PF_KEY init (4), /* One of PF keys hit, see read_info.sub_key */ 2 46 PA_KEY init (5), /* One of PA keys hit, see read_info.sub_key */ 2 47 CLEAR init (6), /* Clear key hit */ 2 48 ID_READER init (7), /* Operatior identification card reader */ 2 49 LIGHT_PEN init (8), /* Light pen used */ 2 50 TEST_REQ init (9)) /* Test request key hit */ 2 51 int static options (constant); 2 52 2 53 dcl write_infop ptr; 2 54 dcl max_write_fields fixed bin; 2 55 dcl max_write_len fixed bin; 2 56 2 57 dcl 1 write_info aligned based (write_infop), 2 58 2 version fixed bin, 2 59 2 controller fixed bin, 2 60 2 device fixed bin, 2 61 2 from_device fixed bin, /* used with COPY command */ 2 62 2 command fixed bin, /* write, erase/write, copy, etc. */ 2 63 2 write_ctl_char, 2 64 3 bits unal, 2 65 4 print_format bit (2) unal, /* 00 = use NL order, 01 = 40, 10 = 60, 11 = 80 */ 2 66 4 start_printer bit (1) unal, 2 67 4 sound_alarm bit (1) unal, 2 68 4 keyboard_restore bit (1) unal, 2 69 4 reset_mdt bit (1) unal, 2 70 3 copy_bits bit (2) unal, /* which fields to copy */ 2 71 3 pad bit (28) unal, 2 72 2 max_fields fixed bin, 2 73 2 max_len fixed bin, /* max length of data.contents */ 2 74 2 mod_fields fixed bin, /* number of fields actually filled in */ 2 75 2 data (max_write_fields refer (write_info.max_fields)), 2 76 3 orders unal, /* orders to precede this block of data */ 2 77 4 set_buffer_addr bit (1), /* defines starting address */ 2 78 4 start_field bit (1), /* define field, using attribute char */ 2 79 4 insert_cursor bit (1), 2 80 4 program_tab bit (1), 2 81 4 repeat_to_addr bit (1), /* repeat supplied char */ 2 82 4 erase_to_addr bit (1), 2 83 3 attributes unal, /* used in field definition if start_field = "1"b */ 2 84 4 protected bit (1), 2 85 4 numeric bit (1), 2 86 4 display_form bit (2), /* 00 = display, ^pen, 01 = display,pen, 10 = intensified */ 2 87 /* 11 = invisible */ 2 88 4 reserved bit (1), 2 89 4 mdt bit (1), /* modified data tag */ 2 90 3 pad1 bit (12) unal, 2 91 3 field_position fixed bin, 2 92 3 contents char (max_write_len refer (write_info.max_len)) varying; 2 93 2 94 /* possible values for write_info.command */ 2 95 2 96 dcl (WRITE init (1), 2 97 ERASE_WRITE init (2), 2 98 COPY init (3), 2 99 ERASE_UNPROTECTED init (4), 2 100 READ_MODIFIED init (5), 2 101 READ_BUFFER init (6)) 2 102 fixed bin int static options (constant); 2 103 2 104 /* End include file ..... ibm3270_io_info.incl.pl1 */ 98 99 100 101 iocbp = arg_iocbp; 102 io_call_infop = arg_info_ptr; 103 order = io_call_info.order_name; 104 err = io_call_info.error; 105 rpt = io_call_info.report; 106 caller = io_call_info.caller_name; 107 arg_no = 1; 108 109 if order = "event_info" then do; /* Return event channel */ 110 call iox_$control (iocbp, "event_info", addr (ev_chan), code); 111 if code = 0 then call rpt ("Event channel = ^.3b", unspec (ev_chan)); 112 end; 113 114 else if order = "poll" then do; 115 i = bin_arg ("device"); 116 call iox_$control (iocbp, "poll", addr (i), code); 117 end; 118 119 else if order = "read" then do; 120 read_ctlp = addr (auto_read_ctl); 121 read_ctl.version = 1; 122 call iox_$control (iocbp, "read", addr (read_ctl), code); /* Get the data */ 123 if code = 0 then do; /* It worked, print results */ 124 call rpt ("Device:^-^d ^d Cursor: ^d", read_info.controller, read_info.device, 125 read_info.cursor_position); 126 call rpt ("Reason:^-^d ^d Code ^o", read_info.key, read_info.sub_key, read_info.code); 127 if read_info.key = STATUS then call rpt ("Status:^-^b", read_info.bits); 128 do i = 1 to read_info.mod_fields; 129 call rpt ("^4d^5d ^a", read_info.field_position (i), length (read_info.contents (i)), 130 read_info.contents (i)); 131 end; 132 free read_info; 133 end; 134 end; 135 136 else if order = "write" then do; 137 if io_call_info.nargs = 0 then do; /* Help */ 138 do i = 1 to 5; 139 call rpt ("^a", write_help (i)); 140 end; 141 code = 0; 142 go to control_return; 143 end; 144 free_areap = get_system_free_area_ (); 145 max_write_fields = io_call_info.nargs; 146 max_write_len = io_call_info.max_arglen; 147 do arg_no = 2 to io_call_info.nargs; /* Gent length of longest -sm arg */ 148 if carg = "-segment" | carg = "-sm" then do; 149 call path_next_arg; 150 max_write_len = max (max_write_len, segl); 151 call hcs_$terminate_noname (segp, code); 152 end; 153 end; 154 allocate write_info in (free_area); /* Probably too large, but thats ok */ 155 unspec (write_info) = "0"b; /* Start clean */ 156 write_info.version = 1; 157 write_info.max_fields = max_write_fields; 158 write_info.max_len = max_write_len; 159 write_info.command = WRITE; 160 arg_no = 1; 161 write_info.device = bin_arg ("device"); 162 i = 0; 163 do arg_no = 2 to io_call_info.nargs; 164 if carg = "-write" | carg = "-wr" then write_info.command = WRITE; 165 else if carg = "-erase_write" | carg = "-erwr" then write_info.command = ERASE_WRITE; 166 else if carg = "-copy" | carg = "-cp" then do; 167 write_info.command = COPY; 168 write_info.from_device = bin_next_arg (); 169 end; 170 else if carg = "-erase_unprotected" | carg = "-erun" then write_info.command = ERASE_UNPROTECTED; 171 else if carg = "-read_modified" | carg = "-rdm" then write_info.command = READ_MODIFIED; 172 else if carg = "-read_buffer" | carg = "-rdb" then write_info.command = READ_BUFFER; 173 174 else if carg = "-print_format" | carg = "-pf" then write_info.print_format = bit2_next_arg (); 175 else if carg = "-start_printer" | carg = "-sp" then write_info.start_printer = "1"b; 176 else if carg = "-sound_alarm" | carg = "-sa" then write_info.sound_alarm = "1"b; 177 else if carg = "-keyboard_restore" | carg = "-kr" then write_info.keyboard_restore = "1"b; 178 else if carg = "-reset_mdt" | carg = "-rm" then write_info.reset_mdt = "1"b; 179 else if carg = "-copy_bits" | carg = "-cb" then write_info.copy_bits = bit2_next_arg (); 180 else if carg = "-next" then i, write_info.mod_fields = i+1; 181 else go to continue_write_scan; /* Other args require array setup */ 182 go to end_write_scan; /* Processed args not releated to data array */ 183 continue_write_scan: 184 if i = 0 then i, write_info.mod_fields = 1; /* Must be in at least first array */ 185 186 if carg = "-set_buffer_addr" | carg = "-sba" then do; 187 write_info.set_buffer_addr (i) = "1"b; 188 write_info.field_position (i) = bin_next_arg (); 189 end; 190 else if carg = "-start_field" | carg = "-sf" then write_info.start_field (i) = "1"b; 191 else if carg = "-insert_cursor" | carg = "-ic" then write_info.insert_cursor (i) = "1"b; 192 else if carg = "-program_tab" | carg = "-pt" then write_info.program_tab (i) = "1"b; 193 else if carg = "-repeat_to_addr" | carg = "-rta" then do; 194 write_info.repeat_to_addr (i) = "1"b; 195 write_info.field_position (i) = bin_next_arg (); 196 end; 197 else if carg = "-erase_to_addr" | carg = "-eta" then do; 198 write_info.erase_to_addr (i) = "1"b; 199 write_info.field_position (i) = bin_next_arg (); 200 end; 201 202 else if carg = "-protected" | carg = "-pr" then 203 write_info.protected (i), write_info.start_field (i) = "1"b; 204 else if carg = "-numeric" | carg = "-num" then 205 write_info.numeric (i), write_info.start_field (i) = "1"b; 206 else if carg = "-display_form" | carg = "-df" then do; 207 write_info.start_field (i) = "1"b; 208 write_info.display_form (i) = bit2_next_arg (); 209 end; 210 else if carg = "-mdt" then write_info.mdt (i) = "1"b; 211 212 else if carg = "-string" then do; 213 if arg_no = io_call_info.nargs then do; 214 call err (error_table_$noarg, caller, "After ^a", carg); 215 code = 0; 216 go to control_return; 217 end; 218 arg_no = arg_no+1; 219 write_info.contents (i) = carg; 220 if arg_no < io_call_info.nargs then i, write_info.mod_fields = i+1; 221 end; 222 else if carg = "-segment" | carg = "-sm" then do; 223 call path_next_arg; 224 write_info.contents (i) = seg; 225 call hcs_$terminate_noname (segp, code); 226 if arg_no < io_call_info.nargs then i, write_info.mod_fields = i+1; 227 end; 228 else if substr (carg, 1, 1) = "-" then do; 229 call err (error_table_$badopt, caller, "^a", carg); 230 code = 0; 231 go to control_return; 232 end; 233 else do; 234 write_info.contents (i) = carg; 235 if arg_no < io_call_info.nargs then i, write_info.mod_fields = i+1; 236 end; 237 end_write_scan: 238 end; 239 call iox_$control (iocbp, "write", write_infop, code); 240 free write_info; 241 end; 242 243 else call iox_$control (iocbp, rtrim (order), null, code); 244 245 control_return: 246 arg_code = code; 247 return; 248 249 /* Argument converting routines */ 250 251 bin_arg: proc (s) returns (fixed bin); 252 253 dcl s char (*); 254 255 on conversion go to bin_arg_err; 256 return (bin (carg)); 257 bin_arg_err: 258 call err (0, caller, "Invalid ^a: ^a", s, carg); 259 code = 0; 260 go to control_return; 261 262 end bin_arg; 263 264 bin_next_arg: proc returns (fixed bin); 265 266 if arg_no ^< io_call_info.nargs then do; 267 call err (error_table_$noarg, caller, "After ^a", carg); 268 code = 0; 269 go to control_return; 270 end; 271 arg_no = arg_no + 1; 272 return (bin_arg ((io_call_info.args (arg_no-1)))); 273 274 end bin_next_arg; 275 276 bit2_arg: proc (s) returns (bit (2)); 277 278 dcl s char (*); 279 280 on conversion go to bit2_arg_err; 281 return (bit (carg)); 282 bit2_arg_err: 283 call err (0, caller, "Invalid ^a: ^a", s, carg); 284 code = 0; 285 go to control_return; 286 287 end bit2_arg; 288 289 bit2_next_arg: proc returns (bit (2)); 290 291 if arg_no ^< io_call_info.nargs then do; 292 call err (error_table_$noarg, caller, "After ^a", carg); 293 code = 0; 294 go to control_return; 295 end; 296 arg_no = arg_no + 1; 297 return (bit2_arg ((io_call_info.args (arg_no-1)))); 298 299 end bit2_next_arg; 300 301 /* For pathname args */ 302 303 path_next_arg: proc; 304 305 if arg_no ^< io_call_info.nargs then do; 306 call err (error_table_$noarg, caller, "After ^a", carg); 307 code = 0; 308 go to control_return; 309 end; 310 arg_no = arg_no + 1; 311 call expand_pathname_ ((carg), dir, ename, code); 312 if code ^= 0 then do; 313 call err (code, caller, "^a", carg); 314 code = 0; 315 go to control_return; 316 end; 317 call hcs_$initiate_count (dir, ename, "", bit_count, 0, segp, code); 318 if segp = null then do; 319 call err (code, caller, "^a^[>^]^a", dir, (dir ^= ">"), ename); 320 code = 0; 321 go to control_return; 322 end; 323 segl = divide (bit_count, 9, 21, 0); 324 return; 325 326 end path_next_arg; 327 328 end ibm3270_io_call_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1506.4 ibm3270_io_call_.pl1 >dumps>old>recomp>ibm3270_io_call_.pl1 96 1 07/19/79 1547.1 io_call_info.incl.pl1 >ldd>include>io_call_info.incl.pl1 98 2 02/17/78 1339.8 ibm3270_io_info.incl.pl1 >ldd>include>ibm3270_io_info.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. COPY constant fixed bin(17,0) initial dcl 2-96 ref 167 ERASE_UNPROTECTED constant fixed bin(17,0) initial dcl 2-96 ref 170 ERASE_WRITE constant fixed bin(17,0) initial dcl 2-96 ref 165 READ_BUFFER constant fixed bin(17,0) initial dcl 2-96 ref 172 READ_MODIFIED constant fixed bin(17,0) initial dcl 2-96 ref 171 STATUS constant fixed bin(17,0) initial dcl 2-42 ref 127 WRITE constant fixed bin(17,0) initial dcl 2-96 ref 159 164 addr builtin function dcl 58 ref 110 110 116 116 120 122 122 148 148 164 164 165 165 166 166 170 170 171 171 172 172 174 174 175 175 176 176 177 177 178 178 179 179 180 186 186 190 190 191 191 192 192 193 193 197 197 202 202 204 204 206 206 210 212 214 219 222 222 228 229 234 256 257 267 281 282 292 306 311 313 arg_code parameter fixed bin(35,0) dcl 20 set ref 14 245* arg_info_ptr parameter pointer dcl 19 ref 14 102 arg_iocbp parameter pointer dcl 18 ref 14 101 arg_no 000142 automatic fixed bin(17,0) dcl 32 set ref 107* 147* 148 148* 160* 163* 164 164 165 165 166 166 170 170 171 171 172 172 174 174 175 175 176 176 177 177 178 178 179 179 180 186 186 190 190 191 191 192 192 193 193 197 197 202 202 204 204 206 206 210 212 213 214 218* 218 219 220 222 222 226 228 229 234 235* 256 257 266 267 271* 271 272 281 282 291 292 296* 296 297 305 306 310* 310 311 313 args 44 based varying char array level 2 dcl 1-10 set ref 148 148 164 164 165 165 166 166 170 170 171 171 172 172 174 174 175 175 176 176 177 177 178 178 179 179 180 186 186 190 190 191 191 192 192 193 193 197 197 202 202 204 204 206 206 210 212 214 219 222 222 228 229 234 256 257 267 272 281 282 292 297 306 311 313 attributes 11(06) based structure array level 3 packed unaligned dcl 2-57 auto_read_ctl 000232 automatic structure level 1 dcl 43 set ref 120 bin builtin function dcl 58 ref 256 bit builtin function dcl 58 ref 281 bit_count 000147 automatic fixed bin(24,0) dcl 37 set ref 317* 323 bits 5 based structure level 3 in structure "write_info" packed unaligned dcl 2-57 in procedure "ibm3270_io_call_" bits 11 based bit(12) level 3 in structure "read_info" packed unaligned dcl 2-20 in procedure "ibm3270_io_call_" set ref 127* caller 000130 automatic char(32) unaligned dcl 30 set ref 106* 214* 229* 257* 267* 282* 292* 306* 313* 319* caller_name 1 based char(32) level 2 dcl 1-10 ref 106 carg based varying char dcl 33 set ref 148 148 164 164 165 165 166 166 170 170 171 171 172 172 174 174 175 175 176 176 177 177 178 178 179 179 180 186 186 190 190 191 191 192 192 193 193 197 197 202 202 204 204 206 206 210 212 214* 219 222 222 228 229* 234 256 257* 267* 281 282* 292* 306* 311 313* code 10 based fixed bin(35,0) level 3 in structure "read_info" dcl 2-20 in procedure "ibm3270_io_call_" set ref 126* code 000100 automatic fixed bin(35,0) dcl 24 in procedure "ibm3270_io_call_" set ref 110* 111 116* 122* 123 141* 151* 215* 225* 230* 239* 243* 245 259* 268* 284* 293* 307* 311* 312 313* 314* 317* 319* 320* command 4 based fixed bin(17,0) level 2 dcl 2-57 set ref 159* 164* 165* 167* 170* 171* 172* contents 17 based varying char array level 3 in structure "read_info" dcl 2-20 in procedure "ibm3270_io_call_" set ref 129 129 129* contents 13 based varying char array level 3 in structure "write_info" dcl 2-57 in procedure "ibm3270_io_call_" set ref 219* 224* 234* controller 4 based fixed bin(17,0) level 2 dcl 2-20 set ref 124* conversion 000000 stack reference condition dcl 56 ref 255 280 copy_bits 5(06) based bit(2) level 3 packed unaligned dcl 2-57 set ref 179* cursor_position 12 based fixed bin(17,0) level 2 dcl 2-20 set ref 124* data 16 based structure array level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_io_call_" data 11 based structure array level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_io_call_" device 2 based fixed bin(17,0) level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_io_call_" set ref 161* device 5 based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_io_call_" set ref 124* dir 000150 automatic char(168) unaligned dcl 38 set ref 311* 317* 319* 319 display_form 11(08) based bit(2) array level 4 packed unaligned dcl 2-57 set ref 208* ename 000222 automatic char(32) unaligned dcl 39 set ref 311* 317* 319* erase_to_addr 11(05) based bit(1) array level 4 packed unaligned dcl 2-57 set ref 198* err 000120 automatic entry variable dcl 29 set ref 104* 214 229 257 267 282 292 306 313 319 error 26 based entry variable level 2 dcl 1-10 ref 104 error_table_$badopt 000024 external static fixed bin(35,0) dcl 54 set ref 229* error_table_$noarg 000022 external static fixed bin(35,0) dcl 53 set ref 214* 267* 292* 306* ev_chan 000114 automatic fixed bin(71,0) dcl 27 set ref 110 110 111 111 expand_pathname_ 000020 constant entry external dcl 51 ref 311 field_position 16 based fixed bin(17,0) array level 3 in structure "read_info" dcl 2-20 in procedure "ibm3270_io_call_" set ref 129* field_position 12 based fixed bin(17,0) array level 3 in structure "write_info" dcl 2-57 in procedure "ibm3270_io_call_" set ref 188* 195* 199* free_area based area(1024) dcl 41 ref 154 free_areap 000140 automatic pointer dcl 31 set ref 144* 154 from_device 3 based fixed bin(17,0) level 2 dcl 2-57 set ref 168* get_system_free_area_ 000012 constant entry external dcl 48 ref 144 hcs_$initiate_count 000014 constant entry external dcl 49 ref 317 hcs_$terminate_noname 000016 constant entry external dcl 50 ref 151 225 i 000116 automatic fixed bin(17,0) dcl 28 set ref 115* 116 116 128* 129 129 129 129* 138* 139* 162* 180 180* 183 183* 187 188 190 191 192 194 195 198 199 202 202 204 204 207 208 210 219 220 220* 224 226 226* 234 235 235* insert_cursor 11(02) based bit(1) array level 4 packed unaligned dcl 2-57 set ref 191* io_call_info based structure level 1 dcl 1-10 io_call_infop 000242 automatic pointer dcl 1-8 set ref 102* 103 104 105 106 137 145 146 147 148 148 163 164 164 165 165 166 166 170 170 171 171 172 172 174 174 175 175 176 176 177 177 178 178 179 179 180 186 186 190 190 191 191 192 192 193 193 197 197 202 202 204 204 206 206 210 212 213 214 214 219 220 222 222 226 228 229 229 234 235 256 257 257 266 267 267 272 281 282 282 291 292 292 297 305 306 306 311 313 313 iocbp 000102 automatic pointer dcl 25 set ref 101* 110* 116* 122* 239* 243* iox_$control 000010 constant entry external dcl 47 ref 110 116 122 239 243 key 6 based fixed bin(17,0) level 3 dcl 2-20 set ref 126* 127 keyboard_restore 5(04) based bit(1) level 4 packed unaligned dcl 2-57 set ref 177* length builtin function dcl 58 ref 129 129 max_arglen 43 based fixed bin(17,0) level 2 dcl 1-10 ref 146 148 148 148 148 164 164 164 164 165 165 165 165 166 166 166 166 170 170 170 170 171 171 171 171 172 172 172 172 174 174 174 174 175 175 175 175 176 176 176 176 177 177 177 177 178 178 178 178 179 179 179 179 180 180 186 186 186 186 190 190 190 190 191 191 191 191 192 192 192 192 193 193 193 193 197 197 197 197 202 202 202 202 204 204 204 204 206 206 206 206 210 210 212 212 214 214 214 219 219 222 222 222 222 228 228 229 229 229 234 234 256 256 257 257 257 267 267 267 272 272 281 281 282 282 282 292 292 292 297 297 306 306 306 311 311 313 313 313 max_fields 6 based fixed bin(17,0) level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_io_call_" set ref 154* 155 157* 240 max_fields 13 based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_io_call_" ref 132 max_len 7 based fixed bin(17,0) level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_io_call_" set ref 154* 155 158* 187 187 188 188 190 190 191 191 192 192 194 194 195 195 198 198 199 199 202 202 202 202 204 204 204 204 207 207 208 208 210 210 219 219 219 224 224 224 234 234 234 240 max_len 14 based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_io_call_" ref 129 129 129 129 129 129 129 129 129 132 max_write_fields 000250 automatic fixed bin(17,0) dcl 2-54 set ref 145* 154 154 157 max_write_len 000251 automatic fixed bin(17,0) dcl 2-55 set ref 146* 150* 150 154 154 158 mdt 11(11) based bit(1) array level 4 packed unaligned dcl 2-57 set ref 210* mod_fields 10 based fixed bin(17,0) level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_io_call_" set ref 180* 183* 220* 226* 235* mod_fields 15 based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_io_call_" ref 128 nargs 42 based fixed bin(17,0) level 2 dcl 1-10 ref 137 145 147 163 213 220 226 235 266 291 305 null builtin function dcl 58 ref 243 243 318 numeric 11(07) based bit(1) array level 4 packed unaligned dcl 2-57 set ref 204* order 000104 automatic char(32) unaligned dcl 26 set ref 103* 109 114 119 136 243 243 order_name 11 based char(32) level 2 dcl 1-10 ref 103 orders 11 based structure array level 3 packed unaligned dcl 2-57 print_format 5 based bit(2) level 4 packed unaligned dcl 2-57 set ref 174* program_tab 11(03) based bit(1) array level 4 packed unaligned dcl 2-57 set ref 192* protected 11(06) based bit(1) array level 4 packed unaligned dcl 2-57 set ref 202* read_ctl based structure level 1 dcl 2-10 set ref 122 122 read_ctlp 000244 automatic pointer dcl 2-8 set ref 120* 121 122 122 124 124 124 126 126 126 127 127 128 129 129 129 129 132 read_info based structure level 1 dcl 2-20 set ref 132 read_infop 4 based pointer level 2 dcl 2-10 set ref 124 124 124 126 126 126 127 127 128 129 129 129 129 132 reason 6 based structure level 2 dcl 2-20 repeat_to_addr 11(04) based bit(1) array level 4 packed unaligned dcl 2-57 set ref 194* report 22 based entry variable level 2 dcl 1-10 ref 105 reset_mdt 5(05) based bit(1) level 4 packed unaligned dcl 2-57 set ref 178* rpt 000124 automatic entry variable dcl 29 set ref 105* 111 124 126 127 129 139 rtrim builtin function dcl 58 ref 243 243 s parameter char unaligned dcl 253 in procedure "bin_arg" set ref 251 257* s parameter char unaligned dcl 278 in procedure "bit2_arg" set ref 276 282* seg based char unaligned dcl 36 ref 224 segl 000146 automatic fixed bin(21,0) dcl 35 set ref 150 224 323* segp 000144 automatic pointer dcl 34 set ref 151* 224 225* 317* 318 set_buffer_addr 11 based bit(1) array level 4 packed unaligned dcl 2-57 set ref 187* sound_alarm 5(03) based bit(1) level 4 packed unaligned dcl 2-57 set ref 176* start_field 11(01) based bit(1) array level 4 packed unaligned dcl 2-57 set ref 190* 202* 204* 207* start_printer 5(02) based bit(1) level 4 packed unaligned dcl 2-57 set ref 175* status 11 based structure level 2 dcl 2-20 sub_key 7 based fixed bin(17,0) level 3 dcl 2-20 set ref 126* substr builtin function dcl 58 ref 228 unspec builtin function dcl 58 set ref 111 111 155* version based fixed bin(17,0) level 2 in structure "read_ctl" dcl 2-10 in procedure "ibm3270_io_call_" set ref 121* version based fixed bin(17,0) level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_io_call_" set ref 156* write_ctl_char 5 based structure level 2 dcl 2-57 write_help 000000 constant varying char(256) initial array dcl 62 set ref 139* write_info based structure level 1 dcl 2-57 set ref 154 155* 240 write_infop 000246 automatic pointer dcl 2-53 set ref 154* 155 156 157 158 159 161 164 165 167 168 170 171 172 174 175 176 177 178 179 180 183 187 188 190 191 192 194 195 198 199 202 202 204 204 207 208 210 219 220 224 226 234 235 239* 240 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. CLEAR internal static fixed bin(17,0) initial dcl 2-42 ENTER internal static fixed bin(17,0) initial dcl 2-42 ERROR internal static fixed bin(17,0) initial dcl 2-42 ID_READER internal static fixed bin(17,0) initial dcl 2-42 LIGHT_PEN internal static fixed bin(17,0) initial dcl 2-42 PA_KEY internal static fixed bin(17,0) initial dcl 2-42 PF_KEY internal static fixed bin(17,0) initial dcl 2-42 TEST_REQ internal static fixed bin(17,0) initial dcl 2-42 io_call_af_ret based varying char dcl 1-25 NAMES DECLARED BY EXPLICIT CONTEXT. bin_arg 003171 constant entry internal dcl 251 ref 115 161 272 bin_arg_err 003252 constant label dcl 257 ref 255 bin_next_arg 003336 constant entry internal dcl 264 ref 168 188 195 199 bit2_arg 003456 constant entry internal dcl 276 ref 297 bit2_arg_err 003553 constant label dcl 282 ref 280 bit2_next_arg 003637 constant entry internal dcl 289 ref 174 179 208 continue_write_scan 002171 constant label dcl 183 ref 180 control_return 003163 constant label dcl 245 ref 142 216 231 260 269 285 294 308 315 321 end_write_scan 003054 constant label dcl 237 ref 182 ibm3270_io_call_ 000773 constant entry external dcl 14 path_next_arg 003763 constant entry internal dcl 303 ref 149 223 NAMES DECLARED BY CONTEXT OR IMPLICATION. divide builtin function ref 323 max builtin function ref 150 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4446 4474 4277 4456 Length 4720 4277 26 207 146 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ibm3270_io_call_ 362 external procedure is an external procedure. bin_arg 260 internal procedure is called during a stack extension, and enables or reverts conditions. on unit on line 255 64 on unit bin_next_arg internal procedure shares stack frame of external procedure ibm3270_io_call_. bit2_arg 260 internal procedure is called during a stack extension, and enables or reverts conditions. on unit on line 280 64 on unit bit2_next_arg internal procedure shares stack frame of external procedure ibm3270_io_call_. path_next_arg internal procedure shares stack frame of external procedure ibm3270_io_call_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ibm3270_io_call_ 000100 code ibm3270_io_call_ 000102 iocbp ibm3270_io_call_ 000104 order ibm3270_io_call_ 000114 ev_chan ibm3270_io_call_ 000116 i ibm3270_io_call_ 000120 err ibm3270_io_call_ 000124 rpt ibm3270_io_call_ 000130 caller ibm3270_io_call_ 000140 free_areap ibm3270_io_call_ 000142 arg_no ibm3270_io_call_ 000144 segp ibm3270_io_call_ 000146 segl ibm3270_io_call_ 000147 bit_count ibm3270_io_call_ 000150 dir ibm3270_io_call_ 000222 ename ibm3270_io_call_ 000232 auto_read_ctl ibm3270_io_call_ 000242 io_call_infop ibm3270_io_call_ 000244 read_ctlp ibm3270_io_call_ 000246 write_infop ibm3270_io_call_ 000250 max_write_fields ibm3270_io_call_ 000251 max_write_len ibm3270_io_call_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as alloc_cs alloc_bs call_var_desc call_ext_out_desc call_ext_out call_int_this_desc return tra_ext enable shorten_stack ext_entry int_entry int_entry_desc any_to_any_tr alloc_based free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. expand_pathname_ get_system_free_area_ hcs_$initiate_count hcs_$terminate_noname iox_$control THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 14 000767 101 001000 102 001004 103 001007 104 001012 105 001016 106 001022 107 001025 109 001027 110 001033 111 001065 112 001110 114 001111 115 001115 116 001133 117 001163 119 001164 120 001170 121 001172 122 001173 123 001222 124 001224 126 001253 127 001306 128 001333 129 001344 131 001414 132 001416 134 001430 136 001431 137 001435 138 001437 139 001444 140 001463 141 001465 142 001466 144 001467 145 001475 146 001500 147 001502 148 001511 149 001536 150 001537 151 001544 153 001555 154 001557 155 001575 156 001610 157 001612 158 001614 159 001616 160 001620 161 001622 162 001641 163 001642 164 001652 165 001704 166 001722 167 001734 168 001737 169 001745 170 001746 171 001764 172 002002 174 002020 175 002042 176 002060 177 002076 178 002114 179 002132 180 002156 182 002170 183 002171 186 002177 187 002221 188 002234 189 002242 190 002243 191 002270 192 002315 193 002342 194 002354 195 002366 196 002377 197 002400 198 002412 199 002424 200 002435 202 002436 204 002465 206 002514 207 002526 208 002540 209 002550 210 002551 212 002571 213 002576 214 002601 215 002634 216 002635 218 002636 219 002637 220 002667 221 002676 222 002677 223 002711 224 002712 225 002736 226 002747 227 002760 228 002761 229 002765 230 003020 231 003021 234 003022 235 003045 237 003054 239 003056 240 003104 241 003115 243 003116 245 003163 247 003167 251 003170 255 003204 256 003223 257 003252 259 003331 260 003333 264 003336 266 003340 267 003344 268 003407 269 003410 271 003411 272 003412 276 003455 280 003471 281 003510 282 003553 284 003632 285 003634 289 003637 291 003641 292 003645 293 003710 294 003711 296 003712 297 003713 303 003763 305 003764 306 003770 307 004033 308 004034 310 004035 311 004036 312 004106 313 004111 314 004154 315 004155 317 004156 318 004220 319 004224 320 004270 321 004271 323 004272 324 004275 ----------------------------------------------------------- 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