ASSEMBLY LISTING OF SEGMENT >spec>install>MR12.3-1048>cobol_operators_.alm ASSEMBLED ON: 05/24/89 0933.3 mst Wed OPTIONS USED: -target l68 list symbols ASSEMBLED BY: ALM Version 8.13 September 1988 ASSEMBLER CREATED: 10/24/88 1635.1 mst Mon 1 " *********************************************************** 2 " * * 3 " * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4 " * * 5 " * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6 " * * 7 " * Copyright (c) 1972 by Massachusetts Institute of * 8 " * Technology and Honeywell Information Systems, Inc. * 9 " * * 10 " *********************************************************** 11 12 " HISTORY COMMENTS: 13 " 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8090), 14 " audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 15 " MCR8090 cobol_operators_.alm Disallow duplicate prime keys in Indexed 16 " Sequential files. 17 " END HISTORY COMMENTS 18 19 20 "Modified on 12/19/84 by FCH, [5.3-1], BUG573(phx16343), error detection can fail if ark used 21 "Modified on 10/29/82 by FCH, [5.1-1], set mcode ptr, BUG536(phx12688) 22 "Modified on 02/18/81 by FCH, [4.4-1], operator 93(alt_rewrite) added 23 " Modified on 12/14/79 by PRP, cause ipr for bad overpunch data. 24 "Modified on 11/05/79 by PRP, prevent close if file previously open 25 " Modified on 10/31/79 by PRP, pass more system error messages to user 26 "Modified on 09/06/79 by FCH, key of ref was being destroyed 27 "Modified on 08/24/79 by PrP, [4.0-3], alt_start_control added 28 " Modified on 07/10/79 by MHD, [4.0-2], fix linage problem 29 " Modified on 07/17/79 by PRP, [4.0-1], MPM standard for attach and detach files 30 "MODIFIED on 11/30/78 by FCH, [3.0-1], alternate record keys added 31 "Modified on 051678 by FCH, [3.0-1], save and restore $x6 32 " Modified on 09/20/77 by Peter Krupp to extend trace interface to COBOL programs 33 "Modified since Version 3.0 34 " 35 " 36 " 37 " 38 " 39 " /*{*/ 40 " cobol_operators_ segment 41 " Bob Chang 42 " March, 1976 43 " 44 " NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE 45 " 46 " To add a new operator: 47 " (1). Insert the "tra" instruction before the line with the comment: 48 " " Please insert the next "tra" instruction before theis line. 49 " (2). Put the operator calling sequence number on "tra" instruction. 50 " The number is obtained by incrementing the last operator calling sequence 51 " number by 1. 52 " (3). Insert the operator before the line with the comment: 53 " " Please insert the next operator before theis line. 54 " (4). Be sure that no "end" statement exists at the end of the operator segment 55 " which is to be inserted into cobol_operators_. 56 " (5). Please put some comment before the operator. 57 " 58 " NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE 59 " 000000 60 name cobol_operators_ 61 " /*}*/ 62 63 use text1 64 use text2 65 use text3 66 use text4 67 use text5 68 join /text/text1,text2,text3,text4,text5 69 use text1 70 include stack_header 1-1 " BEGIN INCLUDE FILE ... stack_header.incl.alm 3/72 Bill Silver 1-2 " 1-3 " modified 7/76 by M. Weaver for *system links and more system use of areas 1-4 " modified 3/77 by M. Weaver to add rnt_ptr 1-5 " modified 7/77 by S. Webber to add run_unit_depth and assign_linkage_ptr 1-6 " modified 6/83 by J. Ives to add trace_frames and in_trace. 1-7 1-8 " HISTORY COMMENTS: 1-9 " 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), 1-10 " audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206): 1-11 " added the heap_header_ptr definition 1-12 " 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473), 1-13 " audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206): 1-14 " Modified to support control point management. These changes were 1-15 " actually made in February 1985 by G. Palter. 1-16 " 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473), 1-17 " audit(86-10-22,Farley), install(86-11-03,MR12.0-1206): 1-18 " Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18 1-19 " bit pad after cur_lot_size for the cpm_enabled. This was done to save 1-20 " some space int the stack header and change the cpd_ptr unal to 1-21 " cpm_data_ptr (ITS pair). 1-22 " END HISTORY COMMENTS 1-23 000004 1-24 equ stack_header.cpm_data_ptr,4 ptr to control point for this stack 000006 1-25 equ stack_header.combined_stat_ptr,6 ptr to separate static area 1-26 000010 1-27 equ stack_header.clr_ptr,8 ptr to area containing linkage sections 000012 1-28 equ stack_header.max_lot_size,10 number of words allowed in lot (DU) 000012 1-29 equ stack_header.main_proc_invoked,10 nonzero if main proc was invoked in run unit (DL) 000012 1-30 equ stack_header.run_unit_depth,10 number of active run units stacked (DL) 000013 1-31 equ stack_header.cur_lot_size,11 DU number of words (entries) in lot 000013 1-32 equ stack_header.cpm_enabled,11 DL non-zero if control point management is enabled 000014 1-33 equ stack_header.system_free_ptr,12 ptr to system storage area 000016 1-34 equ stack_header.user_free_ptr,14 ptr to user storage area 1-35 000020 1-36 equ stack_header.parent_ptr,16 ptr to parent stack or null 000022 1-37 equ stack_header.stack_begin_ptr,18 ptr to first stack frame 000024 1-38 equ stack_header.stack_end_ptr,20 ptr to next useable stack frame 000026 1-39 equ stack_header.lot_ptr,22 ptr to the lot for the current ring 1-40 000030 1-41 equ stack_header.signal_ptr,24 ptr to signal proc for current ring 000032 1-42 equ stack_header.bar_mode_sp,26 value of sp before entering bar mode 000034 1-43 equ stack_header.pl1_operators_ptr,28 ptr: pl1_operators_$operator_table 000036 1-44 equ stack_header.call_op_ptr,30 ptr to standard call operator 1-45 000040 1-46 equ stack_header.push_op_ptr,32 ptr to standard push operator 000042 1-47 equ stack_header.return_op_ptr,34 ptr to standard return operator 000044 1-48 equ stack_header.ret_no_pop_op_ptr,36 ptr: stand. return/ no pop operator 000046 1-49 equ stack_header.entry_op_ptr,38 ptr to standard entry operator 1-50 000050 1-51 equ stack_header.trans_op_tv_ptr,40 ptr to table of translator operator ptrs 000052 1-52 equ stack_header.isot_ptr,42 pointer to ISOT 000054 1-53 equ stack_header.sct_ptr,44 pointer to System Condition Table 000056 1-54 equ stack_header.unwinder_ptr,46 pointer to unwinder for current ring 1-55 000060 1-56 equ stack_header.sys_link_info_ptr,48 ptr to *system link name table 000062 1-57 equ stack_header.rnt_ptr,50 ptr to reference name table 000064 1-58 equ stack_header.ect_ptr,52 ptr to event channel table 000066 1-59 equ stack_header.assign_linkage_ptr,54 ptr to area for hcs_$assign_linkage calls 000070 1-60 equ stack_header.heap_header_ptr,56 ptr to heap header. 000072 1-61 equ stack_header.trace_frames,58 stack of trace_catch_ frames 000073 1-62 equ stach_header.trace_top_ptr,59 trace pointer 000074 1-63 equ stack_header.in_trace,60 trace antirecurse bit 000100 1-64 equ stack_header_end,64 length of stack header 1-65 1-66 1-67 1-68 000000 1-69 equ trace_frames.count,0 number of trace frames on stack 000001 1-70 equ trace_frames.top_ptr,1 packed pointer to top one 1-71 1-72 " The following constant is an offset within the pl1 operators table. 1-73 " It references a transfer vector table. 1-74 000551 1-75 bool tv_offset,551 1-76 1-77 1-78 " The following constants are offsets within this transfer vector table. 1-79 001170 1-80 equ call_offset,tv_offset+271 001171 1-81 equ push_offset,tv_offset+272 001172 1-82 equ return_offset,tv_offset+273 001173 1-83 equ return_no_pop_offset,tv_offset+274 001174 1-84 equ entry_offset,tv_offset+275 1-85 1-86 1-87 " END INCLUDE FILE stack_header.incl.alm 71 include stack_frame 2-1 " 2-2 " BEGIN INCLUDE FILE ... stack_frame.incl.alm 6/72 RBS 2-3 " 2-4 " Modified: 16 Dec 1977, D. Levin - to add fio_ps_ptr 2-5 " Modified: 3 Feb 1978, P. Krupp - to add run_unit_manager_bit & main_proc_bit 2-6 " Modified: 21 March 1978, D. Levin - change fio_ps_ptr to support_ptr 2-7 " 000020 2-8 equ stack_frame.prev_sp,16 000020 2-9 equ stack_frame.condition_word,16 000022 2-10 equ stack_frame.next_sp,18 000022 2-11 equ stack_frame.signaller_word,18 000024 2-12 equ stack_frame.return_ptr,20 000026 2-13 equ stack_frame.entry_ptr,22 000030 2-14 equ stack_frame.operator_ptr,24 000030 2-15 equ stack_frame.lp_ptr,24 000032 2-16 equ stack_frame.arg_ptr,26 000034 2-17 equ stack_frame.static_ptr,28 000035 2-18 equ stack_frame.support_ptr,29 " only used by fortran I/O 000036 2-19 equ stack_frame.on_unit_rel_ptrs,30 000037 2-20 equ stack_frame.operator_ret_ptr,31 000037 2-21 equ stack_frame.translator_id,31 000040 2-22 equ stack_frame.regs,32 000060 2-23 equ stack_frame.min_length,48 000020 2-24 equ stack_frame.flag_word,16 020000 2-25 bool stack_frame.main_proc_bit,020000 (DL) 010000 2-26 bool stack_frame.run_unit_manager,010000 (DL) 004000 2-27 bool stack_frame.signal_bit,004000 (DL) 002000 2-28 bool stack_frame.crawl_out_bit,002000 (DL) 001000 2-29 bool stack_frame.signaller_bit,001000 (DL) 000400 2-30 bool stack_frame.link_trap_bit,000400 (DL) 000200 2-31 bool stack_frame.support_bit,000200 (DL) 000100 2-32 bool stack_frame.condition_bit,000100 (DL) 2-33 2-34 " 2-35 " END INCLUDE FILE ... stack_frame.incl.alm 2-36 " 72 include eis_bits 000100 3-1 bool ar,100 000040 3-2 bool rl,40 000020 3-3 bool id,20 3-4 " 000001 3-5 bool au,01 000002 3-6 bool qu,02 000003 3-7 bool du,03 000004 3-8 bool ic,04 000005 3-9 bool a,05 000005 3-10 bool al,05 000006 3-11 bool q,06 000006 3-12 bool ql,06 000010 3-13 bool x0,10 000011 3-14 bool x1,11 000012 3-15 bool x2,12 000013 3-16 bool x3,13 000014 3-17 bool x4,14 000015 3-18 bool x5,15 000016 3-19 bool x6,16 000017 3-20 bool x7,17 3-21 " 000003 3-22 bool move,03 000001 3-23 bool and,01 000007 3-24 bool or,07 000016 3-25 bool nand,16 000006 3-26 bool xor,6 000000 3-27 bool clear,0 000014 3-28 bool invert,14 3-29 " 000001 3-30 equ round,1 000001 3-31 equ truncate,1 73 " 000000 74 segdef operator_table 000000 75 segdef cobol_operators_ 76 " 77 " Definitions of variables used by operators. Since all 78 " of the operators execute using the stack frame of the 79 " cobol program for their temporary storage, locations 32-61 80 " of the cobol stack frame are reserved for operator use. 81 " 82 " sp|6 has been reserved for probe. 83 " 000001 84 equ cobol_code,1 code identifying cobol compiled prog 000107 85 equ maxpr,71 max precision of double fixed 86 " 000040 87 equ display_ptr,32 000042 88 equ descriptor_ptr,34 000044 89 equ linkage_ptr,36 000036 90 equ on_unit_ptr,30 000037 91 equ op_return_offset,31 000046 92 equ text_base_ptr,38 000047 93 equ text_base_off,39 000050 94 equ mcode,40 000051 95 equ icode,41 000052 96 equ status12,42 000053 97 equ status3,43 000054 98 equ retrycode,44 000100 99 equ return_to_main_ptr,64 000101 100 equ return_to_main_off,65 000102 101 equ rts_code_ptr,66 000110 102 equ rts_code,72 000131 103 equ cobol_error_code,89 104 " 105 " Definitions for cobol linkage variables used by operators. 106 " 000010 107 equ cobol_data_ptr,8 000012 108 equ control_ptr,10 000164 109 equ ind_mask,116 000014 110 equ file_info_ptr,12 000016 111 equ call_cnt,14 000144 112 equ x6_save,100 [3.0-1] 000152 113 equ subr_return_save,106 000153 114 equ subr_return_save_off,107 000154 115 equ pr4_save,108 000162 116 equ rts_save,114 000156 117 equ pr3_save,110 000160 118 equ pr5_save,112 119 " 000000 120 equ ap,0 TEMP 000001 121 equ ab,1 TEMP 000002 122 equ bp,2 TEMP 000003 123 equ bb,3 TEMP 000006 124 equ sp,6 TEMP 125 " 000040 126 bool blank,40 127 " 000000 128 cobol_operators_: 129 " 130 " THE FOLLOWING SECTION IS DIRECTLY REFERENCED FROM cobol PROGRAMS BY MEANS OF 131 " ap|offset. FOR THIS REASON, THE ORDER OF THE FOLLOWING INSTRUCTIONS MUST 132 " NOT BE CHANGED. 133 " 134 even 000000 135 operator_table: 136 " 137 " transfer vector for operators not referenced directly 138 " by the cobol program. new operators may be added at the 139 " end of the list only. 140 " 000000 141 op_vector: 000000 142 entry_operators: 000000 0a 000141 7100 00 143 tra call_ent_var_desc 0 000001 0a 000142 7100 00 144 tra call_ent_var 1 000002 0a 000154 7100 00 145 tra call_ext_in_desc 2 000003 0a 012143 7100 00 146 tra return_mac 3 000004 0a 000155 7100 00 147 tra call_ext_in 4 000005 0a 000154 7100 00 148 tra call_ext_out_desc 5 000006 0a 000155 7100 00 149 tra call_ext_out 6 000007 0a 000654 7100 00 150 tra opch 7 000010 0a 012152 7100 00 151 tra enable 8 000011 0a 012152 7100 00 152 tra enable_1 9 000012 0a 000361 7100 00 153 tra sort_entry_seq 10 000013 0a 012221 7100 00 154 tra sort_release 11 000014 0a 012750 7100 00 155 tra runtime_check 12 000015 0a 012237 7100 00 156 tra sort_return 13 000016 0a 012253 7100 00 157 tra sort_initiate 14 000017 0a 012504 7100 00 158 tra real_to_real 15 000020 0a 012312 7100 00 159 tra establish_cleanup 16 000021 0a 012344 7100 00 160 tra sort_terminate 17 000022 0a 012362 7100 00 161 tra revert_cleanup 18 000023 0a 012474 7100 00 162 tra sort_comp 19 000024 0a 013521 7100 00 163 tra accept_line 20 000025 0a 014566 7100 00 164 tra init_start 21 000026 0a 012206 7100 00 165 tra sort_commence 22 000027 0a 014600 7100 00 166 tra start_control 23 000030 0a 012575 7100 00 167 tra set_lin_file_status 24 000031 0a 012615 7100 00 168 tra set_file_status 25 000032 0a 000347 7100 00 169 tra dsply_user_output 26 000033 0a 012651 7100 00 170 tra close_file 27 000034 0a 000342 7100 00 171 tra dsply_error_output 28 000035 0a 013155 7100 00 172 tra close_op_file 29 000036 0a 013042 7100 00 173 tra open_ext_file 30 000037 0a 013070 7100 00 174 tra open_int_file 31 000040 0a 013110 7100 00 175 tra find_iocb 32 000041 0a 013140 7100 00 176 tra check_attach 33 000042 0a 013166 7100 00 177 tra attach_iocb 34 000043 0a 013215 7100 00 178 tra open_file 35 000044 0a 013243 7100 00 179 tra open_close_file 36 000045 0a 013254 7100 00 180 tra check_file 37 000046 0a 012665 7100 00 181 tra close_file_only 38 000047 0a 000412 7100 00 182 tra init_write 39 000050 0a 000424 7100 00 183 tra write_stream 40 000051 0a 000472 7100 00 184 tra seek_key 41 000052 0a 000551 7100 00 185 tra write_record 42 000053 0a 012673 7100 00 186 tra stop_literal 43 000054 0a 013560 7100 00 187 tra accept_date 44 000055 0a 013564 7100 00 188 tra accept_day 45 000056 0a 013601 7100 00 189 tra accept_time 46 000057 0a 013632 7100 00 190 tra accept_day_of_week 47 000060 0a 012677 7100 00 191 tra stop_run 48 000061 0a 012713 7100 00 192 tra cancel 49 000062 0a 012724 7100 00 193 tra inspect_tally 50 000063 0a 012721 7100 00 194 tra inspect_replace 51 000064 0a 000607 7100 00 195 tra linage 52 000065 0a 013770 7100 00 196 tra delete 53 000066 0a 013657 7100 00 197 tra delete_error 54 000067 0a 013664 7100 00 198 tra read_key 55 000070 0a 013645 7100 00 199 tra init_delete 56 000071 0a 014014 7100 00 200 tra special_delete 57 000072 0a 014076 7100 00 201 tra special_rewrite 58 000073 0a 014132 7100 00 202 tra rewrite 59 000074 0a 012513 7100 00 203 tra merge_init 60 000075 0a 012545 7100 00 204 tra merge_comp 61 000076 0a 012550 7100 00 205 tra merge_return 62 000077 0a 014147 7100 00 206 tra init_read 63 000100 0a 014175 7100 00 207 tra get_line 64 000101 0a 014525 7100 00 208 tra read_record 65 000102 0a 014521 7100 00 209 tra nonseq_read_record 66 000103 0a 000466 7100 00 210 tra read_seek_key 67 000104 0a 000432 7100 00 211 tra write_stream_linage 68 000105 0a 013727 7100 00 212 tra read_key_for_read 69 000106 0a 012553 7100 00 213 tra receive_comm 70 000107 0a 012556 7100 00 214 tra accept_comm 71 000110 0a 012561 7100 00 215 tra purge_comm 72 000111 0a 012564 7100 00 216 tra send_comm 73 000112 0a 012567 7100 00 217 tra enable_comm 74 000113 0a 012572 7100 00 218 tra disable_comm 75 000114 0a 014627 7100 00 219 tra close_reel 76 000115 0a 012731 7100 00 220 tra init_cd 77 000116 0a 013225 7100 00 221 tra alt_open_file 78 [3.0-1] 000117 0a 014232 7100 00 222 tra alt_start 79 [3.0-1] 000120 0a 014242 7100 00 223 tra alt_read_next 80 [3.0-1] 000121 0a 014252 7100 00 224 tra alt_read_record 81 [3.0-1] 000122 0a 014262 7100 00 225 tra alt_seek_key 82 [3.0-1] 000123 0a 014274 7100 00 226 tra alt_start_control 83 [4.0-3] 000124 0a 014323 7100 00 227 tra alt_read_key 84 [3.0-1] 000125 0a 014335 7100 00 228 tra alt_special_delete 85 [3.0-1] 000126 0a 014354 7100 00 229 tra alt_delete 86 [3.0-1] 000127 0a 014363 7100 00 230 tra alt_key_delete 87 [3.0-1] 000130 0a 014403 7100 00 231 tra alt_rewrite_add 88 [3.0-1] 000131 0a 012655 7100 00 232 tra alt_close_file 89 [3.0-1] 000132 0a 014423 7100 00 233 tra alt_add_write_keys 90 [3.0-1] 000133 0a 014444 7100 00 234 tra alt_write_seek_key 91 [3.0-1] 000134 0a 014472 7100 00 235 tra alt_find_rec 92 [3.0-1] 000135 0a 014507 7100 00 236 tra alt_rewrite 93 [4.4-1] 000136 0a 012705 7100 00 237 tra stop_cd_run 94 [4.4-3] 238 " Please insert the next tra instruction before this line. 239 " 240 " 241 242 " **************************************** 243 " 244 " The following operators are high used operators. 245 " 246 " **************************************** 247 " 248 249 250 " operators to call an entry variable 251 " entered with pointer to entry in bp and number 252 " of arguments in position in a, offset of arg list is in x0 253 " 000137 254 call_ent_var_desc_from_op: 000137 aa 000000 6360 01 255 eaq 0,au there are descriptors 000140 0a 000143 7100 00 256 tra call_ent_var_from_op do not use x0 000141 257 call_ent_var_desc: 000141 aa 000000 6360 01 258 eaq 0,au there are descriptors 259 " 000142 260 call_ent_var: 000142 261 inhibit on 000142 aa 6 00101 7403 00 262 stx0 pr6|return_to_main_off 000143 263 inhibit off 000143 264 call_ent_var_from_op: 000143 aa 000004 2750 07 265 ora 4,dl insert cobol code 000144 aa 6 00000 3731 00 266 epbpsb sp|0 get ptr to base of stack 000145 aa 7 00000 7571 11 267 staq sb|0,1 save at head of list 000146 aa 2 00000 3521 20 268 eppbp bp|0,* and ptr to entry 000147 269 save_display: 000147 aa 7 00000 3501 11 270 eppap sb|0,1 get ptr to arg list 000150 271 var_call: 000150 aa 6 00025 7541 00 272 sti sp|stack_frame.return_ptr+1 000151 aa 2 00000 7131 00 273 callsp bp|0 and transfer to entry 274 " 275 " operator to call an external procedure (same or diff seg). 276 " entered with pointer to entry in bp and number of args 277 " in position in a, offset of arg list is in x0 278 " 000152 279 call_ext_in_desc_from_op: 000152 280 call_ext_out_desc_from_op: 000152 aa 000000 6360 01 281 eaq 0,au there are descriptors 000153 0a 000156 7100 00 282 tra call_ext_in_from_op do not use x0 000154 283 call_ext_in_desc: 000154 284 call_ext_out_desc: 000154 aa 000000 6360 01 285 eaq 0,au there are descriptors 286 " 000155 287 call_ext_in: 000155 288 call_ext_out: 000155 289 inhibit on 000155 aa 6 00101 7403 00 290 stx0 pr6|return_to_main_off 000156 291 inhibit off 000156 292 call_ext_in_from_op: 000156 293 call_ext_out_from_op: 000156 aa 6 00000 3731 00 294 epbpsb sp|0 get ptr to base of stack 000157 aa 000004 2750 07 295 ora 4,dl insert cobol code (do this for now) 000160 aa 7 00000 7571 11 296 staq sb|0,1 save at head of list 000161 aa 7 00000 3501 11 297 eppap sb|0,1 get pointer to arg list 298 " 299 " This label is 'segdef'ed but is never transfered to directly. The segdef is 300 " merely to allow default_error_handler to see if a fault occured as a result 301 " of this particular instruction so that it can print a more informative 302 " error message. 303 " 000162 304 forward_call: 000162 aa 6 00025 7541 00 305 sti sp|stack_frame.return_ptr+1 000163 aa 2 00000 7131 00 306 callsp bp|0 transfer to entry 307 " 308 " 309 310 " Macro to generate the calling sequence for |[catch_pl1_]. When 311 " invoked by the COBOL entry operator it will allow trace to monitor COBOL calls 312 " to external procedures. (P. Krupp 09/20/77) 313 314 macro trace 1 315 " BEGIN MACRO trace 2 316 ife &1,trace_ 3 317 epaq * get segment number of cobol_operators_ 4 318 lprp4 7|stack_header.lot_ptr,*au cobol_operators_ linkage pointer 5 319 sprp2 7|stack_header.stack_end_ptr,* save entry pointer 6 320 tsp2 |[catch_pl1_] invoke trace 7 321 lprp2 7|stack_header.stack_end_ptr,* restore entry pointer 8 322 ldx0 2|3 restore relocation offset 9 323 ifend 10 324 " END MACRO trace 11 325 &end 326 327 " Macro to generate code for the COBOL entry operator. The macro will generate 328 " code for two entry operators. One for normal use and the other for using trace 329 " in conjunction with COBOL programs. (P. Krupp 09/20/77) 330 macro cobol_entry 1 331 " BEGIN MACRO cobol_entry 2 332 " 3 333 " 4 334 " entry for entry_version_1. 5 335 " entry for setting up the pr0 for cobol operators_ and initializing 6 336 " the stack frame and/or header. 7 337 segdef &1entry_version_1 8 338 &1entry_version_1: 9 339 ldx0 bp|0 get the relocation offset 10 340 eppbp bp|-3 set pr2 to cobol entry location 11 341 trace &1 12 342 epaq bp|0 get segment number of text 13 343 lprplp sb|stack_header.lot_ptr,*au get seg no, offset of linkage from packed ptr 14 344 eppbb sb|stack_header.stack_end_ptr,* get ptr to next stack frame 15 345 sprisp bb|stack_frame.prev_sp set back ptr of new frame 16 346 spriap bb|stack_frame.arg_ptr save arg pointer 17 347 eppab bb|0,7 get pointer to end of new frame 18 348 spriab bb|stack_frame.next_sp set next pointer of new frame 19 349 spriab sb|stack_header.stack_end_ptr set new stack end ptr 20 350 eppsp bb|0 update sp 21 351 " END MACRO cobol_entry 22 352 &end 353 cobol_entry trace_ " BEGIN MACRO cobol_entry " " " entry for entry_version_1. " entry for setting up the pr0 for cobol operators_ and initializing " the stack frame and/or header. 000164 segdef trace_entry_version_1 000164 trace_entry_version_1: 000164 aa 2 00000 2201 00 ldx0 bp|0 get the relocation offset 000165 aa 2 77775 3521 00 eppbp bp|-3 set pr2 to cobol entry location trace trace_ " BEGIN MACRO trace 000166 0a 000166 2130 00 epaq * get segment number of cobol_operators_ 000167 aa 7 00026 7641 61 lprp4 7|stack_header.lot_ptr,*au cobol_operators_ linkage pointer 000170 aa 7 00024 5421 20 sprp2 7|stack_header.stack_end_ptr,* save entry pointer 000171 4a 4 00010 2721 20 tsp2 |[catch_pl1_] invoke trace 000172 aa 7 00024 7621 20 lprp2 7|stack_header.stack_end_ptr,* restore entry pointer 000173 aa 2 00003 2201 00 ldx0 2|3 restore relocation offset " END MACRO trace 000174 aa 2 00000 2131 00 epaq bp|0 get segment number of text 000175 aa 7 00026 7641 61 lprplp sb|stack_header.lot_ptr,*au get seg no, offset of linkage from packed ptr 000176 aa 7 00024 3535 20 eppbb sb|stack_header.stack_end_ptr,* get ptr to next stack frame 000177 aa 3 00020 6521 00 sprisp bb|stack_frame.prev_sp set back ptr of new frame 000200 aa 3 00032 2501 00 spriap bb|stack_frame.arg_ptr save arg pointer 000201 aa 3 00000 3515 17 eppab bb|0,7 get pointer to end of new frame 000202 aa 3 00022 2515 00 spriab bb|stack_frame.next_sp set next pointer of new frame 000203 aa 7 00024 2515 00 spriab sb|stack_header.stack_end_ptr set new stack end ptr 000204 aa 3 00000 3721 00 eppsp bb|0 update sp " END MACRO cobol_entry 000205 0a 000221 7100 00 354 tra eed trace has been invoked, finish rest of entry operator 355 cobol_entry " BEGIN MACRO cobol_entry " " " entry for entry_version_1. " entry for setting up the pr0 for cobol operators_ and initializing " the stack frame and/or header. 000206 segdef entry_version_1 000206 entry_version_1: 000206 aa 2 00000 2201 00 ldx0 bp|0 get the relocation offset 000207 aa 2 77775 3521 00 eppbp bp|-3 set pr2 to cobol entry location trace " BEGIN MACRO trace " END MACRO trace 000210 aa 2 00000 2131 00 epaq bp|0 get segment number of text 000211 aa 7 00026 7641 61 lprplp sb|stack_header.lot_ptr,*au get seg no, offset of linkage from packed ptr 000212 aa 7 00024 3535 20 eppbb sb|stack_header.stack_end_ptr,* get ptr to next stack frame 000213 aa 3 00020 6521 00 sprisp bb|stack_frame.prev_sp set back ptr of new frame 000214 aa 3 00032 2501 00 spriap bb|stack_frame.arg_ptr save arg pointer 000215 aa 3 00000 3515 17 eppab bb|0,7 get pointer to end of new frame 000216 aa 3 00022 2515 00 spriab bb|stack_frame.next_sp set next pointer of new frame 000217 aa 7 00024 2515 00 spriab sb|stack_header.stack_end_ptr set new stack end ptr 000220 aa 3 00000 3721 00 eppsp bb|0 update sp " END MACRO cobol_entry 000221 356 eed: 000221 aa 0 00000 2351 00 357 lda ap|0 get 2*n_args in au, code in al 000222 aa 000010 3150 07 358 cana 8,dl is there an extra arg 000223 aa 000002 6000 04 359 tze 2,ic no 000224 aa 000002 0750 03 360 ada 2,du yes, allow for it 000225 aa 0 00002 3535 01 361 eppbb ap|2,au get ptr to descriptors 000226 aa 6 00042 2535 00 362 spribb sp|descriptor_ptr set ptr in stack frame 000227 363 save_link: 000227 aa 6 00044 6501 00 364 sprilp sp|linkage_ptr save ptr to linkage in stack head 000230 aa 6 00026 2521 00 365 spribp sp|stack_frame.entry_ptr save ptr to entry point 000231 366 init_stack_join: 000231 aa 6 00046 2525 00 367 spbpbp sp|text_base_ptr save ptr to base of text segment 000232 aa 6 00100 2525 00 368 spbpbp sp|return_to_main_ptr set the segment number for cobol return location 000233 aa 6 00037 4501 00 369 stz sp|stack_frame.operator_ret_ptr init operator return offset 370 " 000234 0a 000000 3500 00 371 eppap operator_table and pointer to operators 000235 aa 6 00030 2501 00 372 spriap sp|stack_frame.operator_ptr save pointer to operator segment 000236 aa 6 00004 2515 00 373 spriab sp|4 save pointer to end of frame for temp extensions 374 " set the parameter for cobol_rts 375 " pr6|68 and pr6|70 are reserved for cobol_rts_ 000237 aa 6 00102 3501 00 376 epp0 pr6|rts_code_ptr 000240 aa 6 00106 2501 00 377 spri0 pr6|70 point to the storage for rts_code_ptr 000241 aa 6 00110 3501 00 378 epp0 pr6|rts_code 000242 aa 6 00102 2501 00 379 spri0 pr6|rts_code_ptr point to the base of rts stack 000243 aa 2 00006 2351 00 380 lda pr2|6 get the cobol_rts_ 000244 aa 4 00000 3515 21 381 epp1 pr4|0,au* obtain the link of cobol_rts_ 000245 aa 6 00162 2515 00 382 spri1 pr6|rts_save store the rts_save 000246 aa 004000 4310 07 383 fld 2048,dl 000247 aa 000004 2750 07 384 ora 4,dl 000250 aa 6 00104 7571 00 385 staq pr6|68 000251 aa 6 00111 4501 00 386 stz pr6|73 set 0 for the use_code on error_stack 000252 aa 4 00000 3701 10 387 epp4 pr4|0,0 get pr4 for operator 000253 aa 6 00100 2521 00 388 spri2 pr6|return_to_main_ptr 000254 aa 6 00154 6501 00 389 spri4 pr6|pr4_save save for future use 000255 aa 4 00020 2521 00 390 spri2 pr4|16 store stat.entry_ptr 000256 aa 4 00016 2351 00 391 lda pr4|call_cnt get the call_cnt 000257 0a 000266 6050 00 392 tpl return_from_control data already initialized 000260 aa 6 00112 6501 00 393 spri4 pr6|74 store the parameter 000261 0a 000266 3500 00 394 epp0 return_from_control preset the return point 000262 aa 6 00024 2501 00 395 spri0 pr6|stack_frame.return_ptr 000263 aa 000002 2350 07 396 lda 2,dl load rts_code for cobol_control 000264 aa 6 00110 7551 00 397 sta pr6|rts_code 000265 0a 000336 7100 00 398 tra call_rts_from_op call cobol_control 399 even 000266 400 return_from_control: 000266 0a 000320 3534 00 401 epp3 return_from_call reset the return_ptr to cobol operators_ 000267 aa 6 00024 2535 00 402 spri3 pr6|stack_frame.return_ptr 000270 aa 6 00154 3515 20 403 epp1 pr6|pr4_save,* load pr4 000271 aa 1 00012 3535 20 404 epp3 pr1|control_ptr,* 000272 aa 3 00033 7211 00 405 lxl1 pr3|27 000273 aa 000001 3610 03 406 anx1 1,du 000274 aa 000000 6350 11 407 eaa 0,x1 000275 aa 000007 7710 00 408 arl 7 000276 aa 6 00164 7551 00 409 sta pr6|ind_mask 000277 aa 6 00164 6341 00 410 ldi pr6|ind_mask 000300 aa 1 00010 3535 20 411 epp3 pr1|cobol_data_ptr,* 000301 aa 040000 0530 03 412 adwp3 16384,du 000302 aa 6 00156 2535 00 413 spri3 pr6|pr3_save 000303 aa 1 00010 3715 20 414 epp5 pr1|cobol_data_ptr,* 000304 aa 140000 1510 03 415 adwp5 49152,du 000305 aa 6 00160 6515 00 416 spri5 pr6|pr5_save 000306 aa 6 00030 3501 20 417 epp0 pr6|stack_frame.operator_ptr,* 000307 aa 6 00152 2501 00 418 spri0 pr6|subr_return_save set for subroutine calls within operators 000310 aa 6 00044 3701 20 419 epp4 pr6|linkage_ptr,* 000311 aa 6 00026 3521 20 420 epp2 pr6|stack_frame.entry_ptr,* 000312 aa 1 00016 0541 00 421 aos pr1|call_cnt update the call_cnt 000313 aa 1 00016 2351 00 422 lda pr1|call_cnt check the call_cnt 000314 aa 2 00006 6011 00 423 tnz bp|6 skip one instruction, data already initialized. 000315 aa 2 00005 7101 00 424 tra bp|5 425 " 426 " 427 " The operator for saveing the pointer register pr0, pr3 and pr5 428 " 429 even 000316 430 return_from_pl1_op: 000316 aa 6 00100 3505 20 431 epbp0 pr6|return_to_main_ptr,* reset the text base ptr to normal 000317 aa 6 00046 2501 00 432 spri0 pr6|text_base_ptr 433 even 000320 434 return_from_call: 000320 aa 6 00164 6341 00 435 ldi pr6|ind_mask 000321 aa 6 00044 3701 20 436 epp4 pr6|linkage_ptr,* reload pr4 000322 aa 6 00156 3535 20 437 epp3 pr6|pr3_save,* reload pr3 000323 aa 6 00160 3715 20 438 epp5 pr6|pr5_save,* reload pr5 000324 aa 6 00030 3501 20 439 epp0 pr6|stack_frame.operator_ptr,* reload pr0 000325 aa 6 00100 7101 20 440 tra pr6|return_to_main_ptr,* return to the cobol program 441 " 442 " The label for io return. 443 " It skip one instruction in cobol program and reset return_ptr to normal 444 " 445 even 000326 446 io_return_to_reset: 000326 aa 000001 2350 03 447 lda 1,du skip one instruction for io return 000327 aa 6 00101 0551 00 448 asa pr6|return_to_main_off 449 " 450 " The label for reset the return_ptr before return. 451 " 452 even 000330 453 return_to_reset: 000330 0a 000320 3500 00 454 epp0 return_from_call reset return_ptr back to normal 000331 aa 6 00024 2501 00 455 spri0 pr6|stack_frame.return_ptr 000332 0a 000320 7100 00 456 tra return_from_call 457 " 458 " 459 " 460 " 461 " The operator for calling the cobol_rts_ routine. 462 " 463 " 000333 464 call_rts: 000333 aa 6 00110 3521 00 465 epp2 pr6|rts_code get the stack pointer for rts 000334 466 call_rts_special: 000334 aa 6 00102 2521 00 467 spri2 pr6|rts_code_ptr sotre the cobol_rts parameter 000335 468 call_rts_load_code: 000335 aa 6 00110 7551 00 469 sta pr6|rts_code 470 " call from cobol operator and the parameter is set already 000336 471 call_rts_from_op: 000336 aa 6 00162 3521 20 472 epp2 pr6|rts_save,* get cobol_rts_ 000337 aa 6 00000 3731 00 473 epbp7 pr6|0 set the stack header pointer 000340 aa 6 00104 3501 00 474 epp0 pr6|68 set the argument pointer 000341 aa 2 00000 7131 00 475 callsp bp|0 476 " 477 " 478 " 479 " 480 " 481 " 482 " The operator for the DISPLAY. 483 " PR5 set to display area info. 484 " 485 " 486 " main line code tsx0 pr0|32 = dsply_user_output, and 487 " tsx0 pr0|34 = dsply_error_output. 000342 488 dsply_error_output: 000342 489 inhibit on 000342 aa 6 00101 7403 00 490 stx0 pr6|return_to_main_off 000343 491 inhibit off 000343 aa 6 00154 3701 20 492 epp4 pr6|pr4_save,* 000344 aa 4 00062 3515 00 493 epp1 pr4|50 pointer to iox_$error_output 000345 aa 000004 2350 07 494 lda 4,dl use retrycode as error switch 000346 0a 000353 7100 00 495 tra display_op 000347 496 dsply_user_output: 000347 497 inhibit on 000347 aa 6 00101 7403 00 498 stx0 pr6|return_to_main_off 000350 499 inhibit off 000350 aa 6 00154 3701 20 500 epp4 pr6|pr4_save,* 000351 aa 4 00060 3515 00 501 epp1 pr4|48 pointer to iox_$user_output 000352 aa 000003 2350 07 502 lda 3,dl use retrycode as error switch 000353 503 display_op: 000353 aa 0 00566 7061 00 504 tsx6 pr0|subr_put_chars 000354 aa 6 00050 2341 00 505 szn pr6|mcode 000355 0a 000326 6000 00 506 tze io_return_to_reset display good, NO retry 000356 aa 6 00054 2351 00 507 lda pr6|retrycode 000357 aa 6 00131 7551 00 508 sta pr6|cobol_error_code 000360 0a 012134 7100 00 509 tra cobol_error_from_op output error message, and retry 510 " 511 " 512 " 513 " The sort entry for compare procedure. 514 " 000361 515 sort_entry_seq: 000361 aa 2 77774 3521 00 516 eppbp bp|-4 000362 aa 7 00024 3535 20 517 eppbb sb|stack_header.stack_end_ptr,* get ptr to next stack frame 000363 aa 3 00020 6521 00 518 sprisp bb|stack_frame.prev_sp set back ptr of new frame 000364 aa 3 00032 2501 00 519 spriap bb|stack_frame.arg_ptr save arg pointer 000365 aa 3 00000 3515 17 520 eppab bb|0,7 get pointer to end of new frame 000366 aa 3 00022 2515 00 521 spriab bb|stack_frame.next_sp set next pointer of new frame 000367 aa 7 00024 2515 00 522 spriab sb|stack_header.stack_end_ptr set new stack end ptr 000370 aa 3 00000 3721 00 523 eppsp bb|0 update sp 000371 0a 000320 3534 00 524 epp3 return_from_call reset the return_ptr to cobol operators_ 000372 aa 6 00024 2535 00 525 spri3 pr6|stack_frame.return_ptr 000373 aa 6 00156 2535 00 526 spri3 pr6|pr3_save save any pointer in case of restoration 000374 aa 6 00160 2535 00 527 spri3 pr6|pr5_save save any pointer in case of restoration 000375 aa 6 00154 2535 00 528 spri3 pr6|pr4_save save any pointer in case of restoration 000376 aa 6 00044 2535 00 529 spri3 pr6|linkage_ptr 000377 aa 0 00000 2351 00 530 lda ap|0 get 2*n_args in au, code in al 000400 aa 000010 3150 07 531 cana 8,dl is there an extra arg 000401 aa 000002 6000 04 532 tze 2,ic no 000402 aa 000002 0750 03 533 ada 2,du yes, allow for it 000403 aa 0 00002 3535 01 534 eppbb ap|2,au get ptr to descriptors 000404 aa 6 00042 2535 00 535 spribb sp|descriptor_ptr set ptr in stack frame 000405 aa 6 00026 2521 00 536 spribp sp|stack_frame.entry_ptr save ptr to entry point 000406 aa 6 00046 2525 00 537 spbpbp sp|text_base_ptr save ptr to base of text segment 000407 0a 000000 3500 00 538 eppap operator_table and pointer to operators 000410 aa 6 00030 2501 00 539 spriap sp|stack_frame.operator_ptr save pointer to operator segment 000411 aa 2 00005 7101 00 540 tra bp|5 541 " 542 " 543 " init_write check file condition 544 " 545 " 000412 546 init_write: 000412 547 inhibit on 000412 aa 6 00101 7403 00 548 stx0 pr6|return_to_main_off 000413 549 inhibit off 000413 aa 6 00126 2515 00 550 spri1 pr6|86 set pr 1 000414 aa 6 00051 4501 00 551 stz pr6|icode reset on each entry to zero 000415 aa 1 00002 2341 00 552 szn pr1|2 is file opened 000416 aa 6 00046 6011 70 553 tnz pr6|text_base_ptr,*0 YES, 554 " set status 000417 0a 012003 2350 00 555 lda io30_con 000420 0a 012020 2360 00 556 ldq s4031con 000421 aa 6 00052 7571 00 557 staq pr6|status12 000422 aa 000030 2210 03 558 ldx1 24,du attempt to perform io on an unopened file 000423 0a 013066 7100 00 559 tra return_thru_text_base_pone 560 " 561 " 562 " write_stream call iox_$put_chars OPERATOR(40)********** 563 " 564 " 000424 565 write_stream: 000424 566 inhibit on 000424 aa 6 00101 7403 00 567 stx0 pr6|return_to_main_off 000425 568 inhibit off 000425 aa 6 00126 2515 00 569 spri1 pr6|86 set iocb_ptr 000426 aa 0 00566 7061 00 570 tsx6 pr0|subr_put_chars 000427 aa 6 00050 2341 00 571 szn pr6|mcode 000430 0a 000330 6000 00 572 tze return_to_reset 000431 0a 000461 7100 00 573 tra write_stream_error 574 " 575 " **********OPERATOR(68)********** 576 " 577 " 000432 578 write_stream_linage: 000432 579 inhibit on 000432 aa 6 00101 7403 00 580 stx0 pr6|return_to_main_off 000433 581 inhibit off 000433 aa 6 00126 2515 00 582 spri1 pr6|86 set iocb_ptr 000434 aa 0 00566 7061 00 583 tsx6 pr0|subr_put_chars 000435 aa 6 00126 3515 20 584 epp1 pr6|86,* reset pr 1 000436 aa 6 00057 2351 00 585 lda pr6|47 load A with advancing value 000437 aa 0 00100 3055 00 586 dtb (pr),(pr) store cobol_fsb.linage_counter into stack word 000440 aa 100130 030006 587 desc9ns pr1|88,6,0 000441 aa 600056 000004 588 desc9a pr6|46,4 589 " lxl3 0,dl 590 " szn pr6|46 if linage counter zero then set to one 591 " tnz 8,ic NOT zero then bypass 592 " aos pr6|46 set linage counter to one start of new page 593 " lxl3 1,dl 594 " stz pr6|icode reset, as linage counter is 1 595 " btd (pr),(pr) 596 " desc9a pr6|46,4 597 " desc9ns pr1|88,6,0 598 " tra 8,ic 000442 aa 6 00056 2341 00 599 szn pr6|46 [4.0-2], by MHD 000443 aa 000002 6010 04 600 tnz 2,ic [4.0-2], by MHD 000444 aa 000001 2350 07 601 lda 1,dl [4.0-2], by MHD 000445 aa 6 00056 0751 00 602 ada pr6|46 increment linage counter by advancing value 000446 aa 6 00056 7551 00 603 sta pr6|46 store new linage_counter 000447 aa 0 00100 3015 00 604 btd (pr),(pr) store stack word into cobol_fsb.linage_counter 000450 aa 600056 000004 605 desc9a pr6|46,4 000451 aa 100130 030006 606 desc9ns pr1|88,6,0 000452 aa 1 00135 1151 00 607 cmpa pr1|93 is new linage_counter >= footing 000453 0a 000457 6040 00 608 tmi cont_write_stream 000454 aa 6 00051 2351 00 609 lda pr6|41 000455 0a 000330 6000 00 610 tze return_to_reset 000456 0a 000326 7100 00 611 tra io_return_to_reset 000457 612 cont_write_stream: 000457 aa 6 00050 2341 00 613 szn pr6|mcode 000460 0a 000330 6000 00 614 tze return_to_reset 615 " set status 000461 616 write_stream_error: 000461 0a 012003 2350 00 617 lda io30_con 000462 0a 012021 2360 00 618 ldq s4430con 000463 aa 6 00052 7571 00 619 staq pr6|status12 000464 aa 000025 2210 03 620 ldx1 21,du unable to write record 000465 0a 000326 7100 00 621 tra io_return_to_reset 622 " 623 " 624 " seek_key call iox_$seek_key OPERATOR(67)********** 625 " 626 " 000466 627 read_seek_key: 000466 628 inhibit on 000466 aa 6 00101 7403 00 629 stx0 pr6|return_to_main_off 000467 630 inhibit off 000467 aa 000001 2350 07 631 lda 1,dl 000470 aa 6 00066 7551 00 632 sta pr6|54 000471 0a 000474 7100 00 633 tra seek_common 634 " 635 " **********OPERATOR(41)********** 636 " 637 " 000472 638 seek_key: 000472 639 inhibit on 000472 aa 6 00101 7403 00 640 stx0 pr6|return_to_main_off 000473 641 inhibit off 000473 aa 6 00066 4501 00 642 stz pr6|54 for write 000474 643 seek_common: 000474 aa 6 00126 2515 00 644 spri1 pr6|86 set iocb_ptr 000475 aa 1 00007 3521 00 645 epp2 pr1|7 000476 aa 6 00130 2521 00 646 spri2 pr6|88 store pointer to key area 000477 aa 6 00076 3521 00 647 epp2 pr6|62 work area not used as seek key returns length 000500 aa 6 00132 2521 00 648 spri2 pr6|90 store pointer to key len 000501 aa 000020 2350 07 649 lda 16,dl 000502 aa 6 00110 7551 00 650 sta pr6|rts_code store rts code 000503 aa 0 00515 7061 00 651 tsx6 pr0|subr_seek_op 000504 aa 6 00050 2341 00 652 szn pr6|mcode 000505 0a 000330 6000 00 653 tze return_to_reset 654 " set status 000506 aa 000032 2210 03 655 ldx1 26,du 000507 aa 6 00066 2341 00 656 szn pr6|54 read or write? 000510 0a 000326 6010 00 657 tnz io_return_to_reset read. 000511 0a 012003 2350 00 658 lda io30_con 000512 0a 012030 2360 00 659 ldq s4632con 000513 aa 6 00052 7571 00 660 staq pr6|status12 000514 0a 000326 7100 00 661 tra io_return_to_reset 662 " 663 " 664 " SUBROUTINE to iox_$seek_key 665 " 666 " 000515 667 subr_seek_op: 000515 aa 6 00153 7461 00 668 stx6 pr6|subr_return_save_off 000516 aa 6 00050 3521 00 669 epp2 pr6|mcode 000517 aa 6 00134 2521 00 670 spri2 pr6|92 store pointer to mcode 000520 aa 6 00114 2521 00 671 spri2 pr6|76 mcode_ptr 000521 aa 6 00124 6211 00 672 eax1 pr6|84 000522 aa 020000 4310 07 673 fld 8192,dl 4 args 000523 aa 1 00000 3521 20 674 epp2 pr1|0,* 000524 aa 2 00112 3521 00 675 epp2 pr2|74 offset for iox_$seek_key 000525 0a 000530 3500 00 676 epp0 return_seek_key 000526 aa 6 00024 2501 00 677 spri0 pr6|stack_frame.return_ptr 000527 0a 000143 7100 00 678 tra call_ent_var_from_op 000530 679 return_seek_key: 000530 aa 6 00044 3701 20 680 epp4 pr6|linkage_ptr,* reset linkage pointer 681 " rts code must be set by caller to this SUBROUTINE 000531 aa 6 00152 3501 20 682 epp0 pr6|subr_return_save,* EXIT FROM SUBROUTINE 000532 aa 6 00024 2501 00 683 spri0 pr6|stack_frame.return_ptr 000533 0a 000336 7100 00 684 tra call_rts_from_op handle seek errors 685 " 686 " 687 " SUBROUTINE to set up for iox_$write_record and iox_$rewrite_record 688 " 689 " 000534 690 subr_write_record: 000534 aa 6 00153 7461 00 691 stx6 pr6|subr_return_save_off 000535 aa 6 00126 3515 20 692 epp1 pr6|86,* reset pr 1 000536 aa 6 00116 6515 00 693 spri5 pr6|78 store_buff_ptr 000537 aa 6 00116 3521 00 694 epp2 pr6|78 000540 aa 6 00130 2521 00 695 spri2 pr6|88 store pointer to buffptr 000541 aa 6 00120 3521 00 696 epp2 pr6|80 000542 aa 6 00132 2521 00 697 spri2 pr6|90 store pointer to buff_len 000543 aa 6 00050 3521 00 698 epp2 pr6|mcode 000544 aa 6 00134 2521 00 699 spri2 pr6|92 000545 aa 6 00124 6211 00 700 eax1 pr6|84 000546 aa 020000 4310 07 701 fld 8192,dl 4 args 000547 aa 1 00000 3521 20 702 epp2 pr1|0,* 000550 aa 6 00152 7101 20 703 tra pr6|subr_return_save,* EXIT FROM SUBROUTINE 704 " 705 " **********OPERATOR(42)********** 706 " write record op call iox_$write_record 707 " 708 " 000551 709 write_record: 000551 710 inhibit on 000551 aa 6 00101 7403 00 711 stx0 pr6|return_to_main_off 000552 712 inhibit off 000552 aa 0 00534 7061 00 713 tsx6 pr0|subr_write_record 000553 aa 2 00076 3521 00 714 epp2 pr2|62 offset for iox_$write_record 000554 0a 000557 3500 00 715 epp0 return_write_record 000555 aa 6 00024 2501 00 716 spri0 pr6|stack_frame.return_ptr 000556 0a 000143 7100 00 717 tra call_ent_var_from_op 000557 718 return_write_record: 000557 aa 6 00050 2341 00 719 szn pr6|mcode 000560 0a 000330 6000 00 720 tze return_to_reset 721 " set status 000561 0a 012003 2350 00 722 lda io30_con 000562 0a 012022 2360 00 723 ldq s4432con 000563 aa 6 00052 7571 00 724 staq pr6|status12 000564 aa 000051 2210 03 725 ldx1 41,du Write is an invalid operatoin for current open mode 000565 0a 000326 7100 00 726 tra io_return_to_reset 727 " 728 " 729 " SUBROUTINE to put_chars 730 " 731 " 000566 732 subr_put_chars: 000566 aa 6 00153 7461 00 733 stx6 pr6|subr_return_save_off 000567 aa 6 00054 7551 00 734 sta pr6|retrycode 000570 aa 6 00126 2515 00 735 spri1 pr6|86 set iocb_ptr 000571 aa 6 00116 6515 00 736 spri5 pr6|78 store buff_ptr 000572 aa 6 00116 3521 00 737 epp2 pr6|78 000573 aa 6 00130 2521 00 738 spri2 pr6|88 store pointer to buff_ptr 000574 aa 6 00120 3521 00 739 epp2 pr6|80 000575 aa 6 00132 2521 00 740 spri2 pr6|90 store pointer to buff_len 000576 aa 6 00050 3521 00 741 epp2 pr6|mcode 000577 aa 6 00134 2521 00 742 spri2 pr6|92 store pointer to mcode 000600 aa 6 00124 6211 00 743 eax1 pr6|84 000601 aa 020000 4310 07 744 fld 8192,dl 4 args 000602 aa 1 00000 3521 20 745 epp2 pr1|0,* indirect thru fsb to iocb 000603 aa 2 00052 3521 00 746 epp2 pr2|42 offset for iox_$put_chars 000604 aa 6 00152 3501 20 747 epp0 pr6|subr_return_save,* EXIT FROM SUBROUTINE 000605 aa 6 00024 2501 00 748 spri0 pr6|stack_frame.return_ptr 000606 0a 000143 7100 00 749 tra call_ent_var_from_op call iox_$put_chars 750 " 751 " 752 " linage 753 " A reg set with advancing value 754 " 755 " 000607 756 linage: 000607 757 inhibit on 000607 aa 6 00101 7403 00 758 stx0 pr6|return_to_main_off 000610 759 inhibit off 000610 aa 000000 7230 07 760 lxl3 0,dl [4.0-2], by MHD 000611 aa 6 00126 3515 20 761 epp1 pr6|86,* reset pr 1 000612 aa 001750 1150 07 762 cmpa 1000,dl Is the PAGE force value 000613 0a 000635 6000 00 763 tze force_page YES, 000614 aa 6 00057 2351 00 764 lda pr6|47 000615 aa 6 00057 2361 00 765 ldq pr6|47 000616 aa 6 00121 7551 00 766 sta pr6|81 set advancing value 000617 aa 6 00120 0761 00 767 adq pr6|80 increment Q with buff length 000620 aa 6 00121 7561 00 768 stq pr6|81 = buff length +advancing value 000621 aa 0 00100 3055 00 769 dtb (pr),(pr) store the linage_counter into a stack word 000622 aa 100130 030006 770 desc9ns pr1|88,6,0 000623 aa 600056 000004 771 desc9a pr6|46,4 000624 aa 6 00056 0751 00 772 ada pr6|46 increment A with current linage_counter 000625 aa 1 00134 1151 00 773 cmpa pr1|92 is linage_counter + advancing value > page_size 000626 0a 000635 6054 00 774 tpnz finish_curr_page YES, do finish current page,include TOP, LC = 1 000627 aa 6 00120 2351 00 775 lda pr6|80 reset A to buff length 000630 aa 6 00057 2361 00 776 ldq pr6|47 reset q to adv value 000631 aa 0 00100 3015 00 777 btd (pr),(pr) 000632 aa 600056 000004 778 desc9a pr6|46,4 000633 aa 100130 030006 779 desc9ns pr1|88,6,0 000634 0a 000330 7100 00 780 tra return_to_reset 000635 781 force_page: 000635 782 finish_curr_page: 000635 aa 1 00134 2361 00 783 ldq pr1|92 load Q with page_size 000636 aa 6 00056 1761 00 784 sbq pr6|46 subtract linage_counter from Q 000637 aa 000001 0760 07 785 adq 1,dl 000640 aa 6 00120 0761 00 786 adq pr6|80 add advancing + buff length 000641 aa 1 00136 0761 00 787 adq pr1|94 add top_size to Q 000642 aa 1 00137 0761 00 788 adq pr1|95 add bottom_size to Q 000643 aa 6 00121 7561 00 789 stq pr6|81 = total amount from last write to new write on next page 000644 aa 6 00056 4501 00 790 stz pr6|46 initialize linage_counter to 0 000645 aa 0 00100 3015 00 791 btd (pr),(pr) store the stack word back to the linage counter 000646 aa 600056 000004 792 desc9a pr6|46,4 000647 aa 100130 030006 793 desc9ns pr1|88,6,0 000650 aa 000001 7230 07 794 lxl3 1,dl [4.0-2],by MHD. shows page overflow occured 000651 aa 6 00120 2351 00 795 lda pr6|80 reset A to length of buffer 000652 aa 6 00057 2361 00 796 ldq pr6|47 reset q to adv value 000653 0a 000330 7100 00 797 tra return_to_reset 798 " 799 " 800 " Please insert the new highly used cobol operator before this line. 801 " 802 " 803 804 " **************************************** 805 " 806 " 807 " 808 " This is the overpunch operator. 809 " 810 " **************************************** 811 " 812 " 813 814 815 " 816 " 000654 817 cobol_opch_operator_: 000654 818 opch: 819 " Modified on 3/12/76 by Bob Chang for cobol operator. 820 " 821 " This ALM procedure is the cobol_operator_ that does conversion 822 " to and from overpunch sign decimal data. 823 " For this first implementation some simplifying assumptions are made: 824 " 1. Only three formats of data can be converted. 825 " a. unpacked decimal, trailing sign. 826 " b. overpunch decimal, leading sign. 827 " c. overpunch decimal, trailing sign. 828 " 829 " 2. Before this operator is called, any data, other than overpunch 830 " or unpacked decimal trailing sign, is converted to unpacked 831 " decimal trailing sign data in a temporary. 832 " 833 " Subsequent implementations may provide for direct conversion by this 834 " operator of the following data formats: 835 " 1. long fixed binary 836 " 2. short fixed binary 837 " 3. packed decimal, leading or trailing sign 838 " 839 " ENTRY CONDITIONS 840 " 841 " Data is passed to this operator in the following registers: 842 " 843 " 844 " 1. pr1 points to the target of the conversion. 845 " 846 " 2. pr2 points to the source of the conversion. 847 " 848 " 3. pr5 points to a block of work space, at the top of the 849 " stack. This work space must be aligned on a double word 850 " boundary. 851 " 852 " 4. Q register contains the scale and precision of the source of 853 " conversion. 854 " 855 " a. bits 0-17 of the Q register contains the scale. 856 " Scale is obtained from data_name.places_right of a 857 " data name token. 858 " 859 " b. Bits 18-36 of the Q contain precision. 860 " Precision is obtained from data_name.item_length of a 861 " data name token. 862 " 863 " 5. A register contains the scale and precision of the target 864 " of conversion. Bits 0-17 contain the scale, 865 " bits 18-36 contain the precision. Scale and precision are obtained 866 " as for the source of conversion. 867 " 868 " 6. X7 contains a code that identifies the data type of the 869 " source of conversion. This code is defined in the following 870 " table: 871 " 872 " x7 contents | type of source 873 " __________________________________________ 874 " 1 | overpunch,leading sign 875 " 2 | overpunch, trailing sign 876 " 3 | unpacked decimal, trailing sign 877 " 878 " 7. X6 contains a code that identifies the data type of the 879 " target of conversion. This code is the same as that described 880 " above for X7. 881 " 882 " 8. pr3 is used to store the location to which the cobol 883 " overpunch conversion operator is to return. 884 " 000654 885 segdef cobol_opch_operator_ 886 887 888 " definition of offsets within the work space 889 000000 890 equ scales,0 000001 891 equ s_scale,1 000000 892 equ t_scale,0 000002 893 equ temp1,2 000003 894 equ temp2,3 000004 895 equ temp3,4 000005 896 equ source_desc,5 000006 897 equ target_desc,6 000010 898 equ pr_store,8 000012 899 equ x_store,10 000013 900 equ save_t_scale,11 000014 901 equ temp_source,12 000040 902 equ udts_source_ret,32 000041 903 equ opch_udts_ret,33 000042 904 equ opch_opch_ret,34 905 906 " definition of the names of pointer registers 907 000005 908 equ work_pr,5 000002 909 equ source_pr,2 000001 910 equ target_pr,1 000003 911 equ return_pr,3 912 913 914 " *************************************** 915 " * 916 " * ENTRY POINT * 917 " * * 918 " *************************************** 919 920 000654 921 cobol_opch_operator_: 000654 aa 6 00100 2535 00 922 spri3 pr6|return_to_main_ptr 000655 aa 5 00000 7571 00 923 staq work_pr|scales 924 925 926 927 000656 aa 000003 1070 03 928 cmpx7 3,du is source unpacked decimal? 000657 0a 000662 6010 00 929 tnz opch_source no, must be overpunch 000660 0a 000674 7050 00 930 tsx5 udts_source yes 000661 0a 000667 7100 00 931 tra operator_exit 932 000662 933 opch_source: 934 000662 aa 000003 1060 03 935 cmpx6 3,du Is destination unpacked decimal? 000663 0a 000666 6010 00 936 tnz opch_dest no, must be overpunch 937 000664 938 udts_dest: 000664 0a 000740 7050 00 939 tsx5 opch_udts 000665 0a 000667 7100 00 940 tra operator_exit 941 000666 942 opch_dest: 000666 0a 000757 7050 00 943 tsx5 opch_opch 944 000667 945 operator_exit: 000667 aa 3 00000 3735 00 946 epp7 pr3|0 000670 aa 6 00044 3701 20 947 epp4 pr6|linkage_ptr,* 000671 aa 6 00156 3535 20 948 epp3 pr6|pr3_save,* 000672 aa 6 00160 3715 20 949 epp5 pr6|pr5_save,* 000673 aa 7 00000 7101 00 950 tra pr7|0 951 952 " ************************************** 953 " * udts_source * 954 " *************************************** 955 000674 956 udts_source: 957 000674 aa 5 00040 7451 00 958 stx5 work_pr|udts_source_ret store return point 959 960 " calculate the number of characters to move from the source, and the character 961 " position in the source at which to start the move 962 000675 0a 001037 7050 00 963 tsx5 calc_length 964 965 " Set up to insert scale factors into the indirect descriptors 966 000676 0a 001107 2350 00 967 lda dec_ns_source_desc 000677 0a 001110 2360 00 968 ldq opch_target_desc 000700 0a 001066 7050 00 969 tsx5 insert_scale_factor 970 971 " Move the source to the target with scaling, but without moving the sign 972 000701 aa 0 00160 3005 72 973 mvn (pr,rl,id,x2),(pr,rl,id) 000702 aa 5 00005 0001 00 974 arg work_pr|source_desc 000703 aa 5 00006 0001 00 975 arg work_pr|target_desc 976 977 " Get the character offset of the sign byte of the source 978 000704 aa 5 00001 7211 00 979 lxl1 work_pr|s_scale 000705 aa 777777 0610 03 980 adx1 -1,du 981 982 " Test to see if the sign is plus or minus 983 000706 aa 0 00000 1065 11 984 cmpc (pr,x1),(0,0),fill(000) 000707 aa 200000 000001 985 desc9a source_pr|0,1 000710 0a 001113 000001 986 desc9a plus_sign,1 987 000711 0a 000714 6000 00 988 tze trailing_dec_plus 989 990 " Must be trailing minus sign 991 000712 aa 000001 2220 03 992 ldx2 1,du set to indicate trailing sign was negative 993 000713 0a 000715 7100 00 994 tra check_target_sign 995 000714 996 trailing_dec_plus: 997 000714 aa 000000 2220 03 998 ldx2 0,du offset of plus overpunch characters in the dec_to_op_sign table 999 000715 1000 check_target_sign: 1001 1002 " Determine whether target is leading or trailing sign overpunch. 1003 000715 aa 000002 1060 03 1004 cmpx6 2,du Is target trailing sign overpunch? 000716 0a 000721 6000 00 1005 tze op_ts yes 1006 1007 " Must be leading sign overpunch 1008 000717 aa 000000 2230 03 1009 ldx3 0,du 000720 0a 000723 7100 00 1010 tra insert_op_sign 1011 000721 1012 op_ts: 1013 1014 " Calculate the offset of the last byte in the target 1015 000721 aa 5 00000 7231 00 1016 lxl3 work_pr|t_scale 000722 aa 777777 0630 03 1017 adx3 -1,du 1018 000723 1019 insert_op_sign: 1020 1021 " Insert the overpunch character into the leading or trailing byte of the target. 000723 aa 000000 1020 03 1022 cmpx2 0,du 000724 0a 000732 6010 00 1023 tnz insert_neg_op trailing sign was negative 1024 000725 aa 0 00113 1605 13 1025 mvt (pr,x3),(pr,x3),(0,0),fill(000) 000726 aa 100000 000001 1026 desc9a target_pr|0,1 000727 aa 100000 000001 1027 desc9a target_pr|0,1 000730 0a 001114 0000 00 1028 arg plus_dec_op_sign_table 000731 0a 000736 7100 00 1029 tra udts_source_exit 000732 1030 insert_neg_op: 1031 000732 aa 0 00113 1605 13 1032 mvt (pr,x3),(pr,x3),(0,0),fill(000) 000733 aa 100000 000001 1033 desc9a target_pr|0,1 000734 aa 100000 000001 1034 desc9a target_pr|0,1 000735 0a 001117 0000 00 1035 arg minus_dec_op_sign_table 1036 1037 000736 1038 udts_source_exit: 1039 1040 1041 1042 " Return to the entry sequence of this program 1043 000736 aa 5 00040 2251 00 1044 ldx5 work_pr|udts_source_ret restore return point 000737 aa 000000 7100 15 1045 tra 0,x5 return 1046 1047 " ************************************** 1048 " * opch_udts * 1049 " *************************************** 1050 000740 1051 opch_udts: 1052 000740 aa 5 00041 7451 00 1053 stx5 work_pr|opch_udts_ret store return point 1054 " Move the overpunch sign source into an unpacked decimal unsigned temporary. 1055 000741 0a 001005 7050 00 1056 tsx5 unpack_opch 1057 1058 " Move the sign from the sign table into the trailing sign byte of the temporary 1059 " Note that x1 contains the length of the source, which is the character position of 1060 " the trailing sign byte. 1061 000742 aa 000111 1004 13 1062 mlr (x3),(pr,x1) 000743 0a 001116 000001 1063 desc9a sign_table,1 000744 aa 500014 000001 1064 desc9a work_pr|temp_source,1 1065 1066 " Calculate the length of the temporary to move, and the character position at which 1067 " to start the move. 1068 000745 0a 001037 7050 00 1069 tsx5 calc_length 1070 1071 " Increment length of source, because length was derived for overpunch source, and we 1072 " are moving an unpacked decimal, trailing sign temporary. 1073 000746 aa 000001 0610 03 1074 adx1 1,du 1075 1076 " Set up to insert the scale factor into the indirect descriptors. 1077 000747 0a 001105 2350 00 1078 lda dec_ts_temp_source_desc 000750 0a 001106 2360 00 1079 ldq dec_ts_target_desc 000751 0a 001066 7050 00 1080 tsx5 insert_scale_factor 1081 1082 " Move the unpacked dec, trailing sign temporary to the unpacked dec, target 1083 000752 aa 0 00160 3005 72 1084 mvn (pr,id,rl,x2),(pr,id,rl) 000753 aa 5 00005 0111 00 1085 nop work_pr|source_desc 000754 aa 5 00006 0111 00 1086 nop work_pr|target_desc 1087 1088 " Return to the calling sequence 1089 000755 aa 5 00041 2251 00 1090 ldx5 work_pr|opch_udts_ret 000756 aa 000000 7100 15 1091 tra 0,x5 1092 1093 " ************************************** 1094 " * opch_opch * 1095 " *************************************** 1096 000757 1097 opch_opch: 1098 000757 aa 5 00042 7451 00 1099 stx5 work_pr|opch_opch_ret store return point 1100 1101 " Store the pointer to the target field and the type code of the target 1102 000760 aa 5 00010 2515 00 1103 spri1 work_pr|pr_store 000761 aa 5 00012 7461 00 1104 stx6 work_pr|x_store 1105 1106 " Set pointer to target to a temporary. Set the target type code to unpacked decimal 1107 000762 aa 5 00014 3515 00 1108 epp target_pr,work_pr|temp_source 000763 aa 000003 2260 03 1109 ldx6 3,du 1110 1111 " Save the scale and precision of the original target 000764 aa 5 00000 2351 00 1112 lda work_pr|t_scale 000765 aa 5 00013 7551 00 1113 sta work_pr|save_t_scale 1114 " Increment the precision of the target, since we are 1115 " adding a trailing sign byte when converting to unpacked decimal. 000766 aa 5 00000 7211 00 1116 lxl1 work_pr|t_scale 000767 aa 000001 0610 03 1117 adx1 1,du 000770 aa 5 00000 4411 00 1118 sxl1 work_pr|t_scale 1119 " Convert the overpunch source to an unpacked decimal into the temporary 1120 000771 0a 000740 7050 00 1121 tsx5 opch_udts 1122 1123 " Set the source pointer to the imal temporary, and the source type code to 1124 " unpacked decimal. 1125 000772 aa 1 00000 3521 00 1126 epp source_pr,target_pr|0 000773 aa 000003 2270 03 1127 ldx7 3,du 1128 1129 " unpacked decimal target now becomes the source 1130 " Set source scale and precision to the scale and precision of the 1131 " unpacked decimal temporary. 000774 aa 5 00000 2351 00 1132 lda work_pr|t_scale 000775 aa 5 00001 7551 00 1133 sta work_pr|s_scale 1134 1135 " restore the target scale and precision 000776 aa 5 00013 2351 00 1136 lda work_pr|save_t_scale 000777 aa 5 00000 7551 00 1137 sta work_pr|t_scale 1138 1139 1140 " Restore the target pointer and type code to the overpunch target 1141 001000 aa 5 00010 3515 20 1142 epp target_pr,work_pr|pr_store,* 001001 aa 5 00012 2261 00 1143 ldx6 work_pr|x_store 1144 1145 " Convert the unpacked dec temporary to the overpunch sign target 1146 001002 0a 000674 7050 00 1147 tsx5 udts_source 1148 1149 " Return to the calling sequence 1150 001003 aa 5 00042 2251 00 1151 ldx5 work_pr|opch_opch_ret restore return point 001004 aa 000000 7100 15 1152 tra 0,x5 return 1153 1154 1155 1156 " *************************************** 1157 " * unpack_opch* 1158 " *************************************** 1159 001005 1160 unpack_opch: 1161 1162 " Move the overpunch sign source into a temporary 1163 001005 aa 5 00001 7211 00 1164 lxl1 work_pr|s_scale get length of source 1165 001006 aa 0 00140 1005 40 1166 mlr (pr,rl),(pr,rl) 001007 aa 200000 000011 1167 desc9a source_pr|0,x1 001010 aa 500014 000011 1168 desc9a work_pr|temp_source,x1 1169 1170 " Get the character position of the overpunch sign character into x2 1171 001011 aa 000001 1070 03 1172 cmpx7 1,du Is source leading overpunch sign? 001012 0a 001015 6010 00 1173 tnz t_opch no 001013 aa 000000 2220 03 1174 ldx2 0,du Yes, overpunch character is in zeroth byte position 001014 0a 001017 7100 00 1175 tra common1 1176 001015 1177 t_opch: 1178 001015 aa 5 00001 7221 00 1179 lxl2 work_pr|s_scale get length of source 001016 aa 777777 0620 03 1180 adx2 -1,du Decrement by one to get char position of last byte 1181 001017 1182 common1: 1183 1184 " Translate the overpunch sign character into a subscript into the digit_table and sign_table 1185 001017 aa 5 00002 4501 00 1186 stz work_pr|temp1 001020 aa 0 00100 1605 12 1187 mvt (pr,x2),(pr) 001021 aa 200000 000001 1188 desc9a source_pr|0,1 001022 aa 500002 200001 1189 desc9a work_pr|temp1(1),1 001023 0a 001144 0000 00 1190 arg mvt_table 1191 1192 " Load the subscript into x3 1193 001024 aa 5 00002 2231 00 1194 ldx3 work_pr|temp1 1195 1196 " Test to see if overpunch char is legal. 001025 aa 777777 0630 03 1197 adx3 -1,du 001026 0a 001033 6040 00 1198 tmi bad_oph 1199 " Char OK keep going 1200 1201 " Move the digit from the digit table into the leading or trailing byte of the temporary. 1202 001027 aa 000112 1004 13 1203 mlr (x3),(pr,x2) 001030 0a 001123 000001 1204 desc9a digit_table,1 001031 aa 500014 000001 1205 desc9a work_pr|temp_source,1 1206 1207 " Return to the calling sequence 1208 001032 aa 000000 7100 15 1209 tra 0,x5 1210 1211 " Cause ipr for bad overpunch char. 001033 1212 bad_oph: 001033 aa 5 00002 7431 00 1213 stx3 work_pr|temp1 001034 aa 0 00100 3035 00 1214 cmpn (pr),(pr) 001035 aa 500002 200001 1215 desc9a work_pr|temp1(1),1 001036 aa 500002 200001 1216 desc9a work_pr|temp1(1),1 1217 " *************************************** 1218 " * calc_length * 1219 " *************************************** 1220 001037 1221 calc_length: 1222 1223 " This sequence of code calculates: 1224 " 1. The length of the source field to be moved. (Returned in x1) 1225 " 2. The character offset of the leftmost character of the source field 1226 " to be moved. (Returned in x2) 1227 " The length of the target field. (Returned ix x3) 1228 1229 " The calling sequence return point is contained in x5, so x5 must not be modified by 1230 " this code. Also x4 is used as a work register. 1231 1232 " Calculate source places left 1233 001037 aa 5 00001 7221 00 1234 lxl2 work_pr|s_scale precision (length) of source 001040 aa 000003 1070 03 1235 cmpx7 3,du is source unpacked decimal? 001041 0a 001043 6010 00 1236 tnz s_non_dec no 001042 aa 777777 0620 03 1237 adx2 -1,du decrement length to exclude the sign byte 1238 001043 1239 s_non_dec: 1240 001043 aa 5 00002 7421 00 1241 stx2 work_pr|temp1 001044 aa 5 00002 2211 00 1242 ldx1 work_pr|temp1 load length into x1 001045 aa 5 00001 1621 00 1243 sbx2 work_pr|s_scale subtract scale to get source places left in x2. 1244 1245 " Calculate destination places left 1246 001046 aa 5 00000 7241 00 1247 lxl4 work_pr|t_scale precision (length) of the target 001047 aa 5 00000 7231 00 1248 lxl3 work_pr|t_scale 001050 aa 000003 1060 03 1249 cmpx6 3,du Is target unpacked decimal? 001051 0a 001053 6010 00 1250 tnz t_non_dec no 001052 aa 777777 0640 03 1251 adx4 -1,du decrement by 1 to exclude the sign byte 1252 001053 1253 t_non_dec: 001053 aa 5 00002 4501 00 1254 stz work_pr|temp1 001054 aa 5 00002 7441 00 1255 stx4 work_pr|temp1 1256 1257 " Subtract scale to get target places left 1258 001055 aa 5 00000 1641 00 1259 sbx4 work_pr|t_scale 001056 aa 5 00002 7441 00 1260 stx4 work_pr|temp1 save places left 1261 1262 " Subtrace target places left from source places left. 1263 001057 aa 5 00002 1421 00 1264 ssx2 work_pr|temp1 1265 001060 0a 001064 6044 00 1266 tmoz target_big_enough 1267 1268 " Target places left less than source places left, must adjust source legnth. 1269 1270 " Note that if the difference is positive, it contains the character position at which to start moving characters 1271 001061 aa 5 00002 2221 00 1272 ldx2 work_pr|temp1 001062 aa 5 00002 1611 00 1273 sbx1 work_pr|temp1 adjust length 001063 0a 001065 7100 00 1274 tra calc_length_return 1275 001064 1276 target_big_enough: 1277 1278 " It is not necessary to start the move at a characterhother than the first. Set x2 to zero, so 1279 " that the first character in the source will be moved. 1280 001064 aa 000000 2220 03 1281 ldx2 0,du 1282 001065 1283 calc_length_return: 1284 001065 aa 000000 7100 15 1285 tra 0,x5 1286 1287 " *************************************** 1288 " * insert_scale_factor * 1289 " *************************************** 1290 001066 1291 insert_scale_factor: 1292 1293 " This sequence of code inserts the scale factor of the source and target fields into indirect 1294 " descriptors. 1295 1296 " ENTRY CONDITIONS 1297 " 1. A register contains the source field indirect descriptor 1298 " 2. Q register contains the target field indirect descriptor 1299 " 3. x5 conatins the return address. 1300 1301 " Insert scale factor into the source indirect descriptor 1302 001066 aa 5 00005 7551 00 1303 sta work_pr|source_desc 001067 aa 5 00001 2351 00 1304 lda work_pr|s_scale scale factor in upper 001070 aa 000022 7310 00 1305 ars 18 extend sign 001071 aa 000000 5310 00 1306 neg 001072 aa 000006 7350 00 1307 als 6 shift to SF position 001073 0a 001112 3750 00 1308 ana scale_factor_mask and out junk 001074 aa 5 00005 2551 00 1309 orsa work_pr|source_desc insert SF inot indirect descriptor 1310 1311 " Insert scale factor into the target indirect descriptor 1312 001075 aa 5 00006 7561 00 1313 stq work_pr|target_desc 001076 aa 5 00000 2351 00 1314 lda work_pr|t_scale scale factor in upper of a now 001077 aa 000022 7310 00 1315 ars 18 extend sign 001100 aa 000000 5310 00 1316 neg 001101 aa 000006 7350 00 1317 als 6 shift to SF position 001102 0a 001112 3750 00 1318 ana scale_factor_mask mask out junk 001103 aa 5 00006 2551 00 1319 orsa work_pr|target_desc insert SF into indirect descriptor 1320 1321 " Return to caller 1322 001104 aa 000000 7100 15 1323 tra 0,x5 1324 1325 " *************************************** 1326 " * CONSTANTS AND TABLES * 1327 " *************************************** 1328 001105 1329 dec_ts_temp_source_desc: 001105 aa 500014 020011 1330 desc9ts work_pr|temp_source,x1,0 1331 001106 1332 dec_ts_target_desc: 001106 aa 100000 020013 1333 desc9ts target_pr|0,x3,0 1334 001107 1335 dec_ns_source_desc: 001107 aa 200000 030011 1336 desc9ns source_pr|0,x1,0 1337 001110 1338 opch_target_desc: 001110 aa 100000 030013 1339 desc9ns target_pr|0,x3,0 1340 001111 1341 dec_ns_temp_source_desc: 001111 aa 500014 030011 1342 desc9ns work_pr|temp_source,x1,0 1343 001112 1344 scale_factor_mask: 001112 aa 000000 007700 1345 oct 000000007700 1346 001113 1347 plus_sign: 001113 aa 053 000 000 000 1348 aci /+/ 1349 1350 001114 1351 plus_dec_op_sign_table: 001114 1352 empty1: 001114 aa 000000 000000 1353 oct 0 001115 aa 000000 000000 1354 oct 0 001116 1355 sign_table: 001116 aa 053 053 053 053 1356 aci /++++/ 001117 1357 minus_dec_op_sign_table: 001117 aa 053 053 053 053 1358 aci /++++/ 001120 aa 053 053 055 055 1359 aci /++--/ 001121 aa 055 055 055 055 1360 aci /----/ 001122 aa 055 055 055 055 1361 aci /----/ 001123 1362 digit_table: 001123 aa 060 061 062 063 1363 aci /0123/ 001124 aa 064 065 066 067 1364 aci /4567/ 001125 aa 070 071 060 061 1365 aci /8901/ 001126 aa 062 063 064 065 1366 aci /2345/ 001127 aa 066 067 070 071 1367 aci /6789/ 001130 aa 173 101 102 103 1368 aci /{ABC/ PLUS OVERPUNCH DIGITS 001131 aa 104 105 106 107 1369 aci /DEFG/ PLUS OVERPUNCH DIGITS 001132 aa 110 111 040 040 1370 aci /HI / PLUS OVERPUNCH DIGITS 001133 aa 175 112 113 114 1371 aci /}JKL/ MINUS OVERPUNCH DIGITS 001134 aa 115 116 117 120 1372 aci /MNOP/ MINUS OVERPUNCH DIGITS 001135 aa 121 122 040 040 1373 aci /QR / MINUS OVERPUNCH DIGITS 001136 aa 000000 000000 1374 oct 0 001137 aa 000000 000000 1375 oct 0 001140 aa 000000 000000 1376 oct 0 001141 aa 000000 000000 1377 oct 0 001142 aa 000000 000000 1378 oct 0 001143 aa 000000 000000 1379 oct 0 001144 1380 mvt_table: 001144 aa 000000 000000 1381 oct 0 001145 aa 000000 000000 1382 oct 0 001146 aa 000000 000000 1383 oct 0 001147 aa 000000 000000 1384 oct 0 001150 aa 000000 000000 1385 oct 0 001151 aa 000000 000000 1386 oct 0 001152 aa 000000 000000 1387 oct 0 001153 aa 000000 000000 1388 oct 0 001154 aa 000000 000000 1389 oct 0 001155 aa 000000 000000 1390 oct 0 001156 aa 000000 000000 1391 oct 0 001157 aa 000000 000000 1392 oct 0 001160 aa 001002 003004 1393 oct 001002003004 001161 aa 005006 007010 1394 oct 005006007010 001162 aa 011012 000000 1395 oct 011012000000 001163 aa 000000 000000 1396 oct 0 001164 1397 mvt_data1: 001164 aa 000002 003004 1398 oct 000002003004 maps overpunch digits into subscript into sign_table 001165 aa 005006 007010 1399 oct 005006007010 and digit_table. 001166 aa 011012 014015 1400 oct 011012014015 ditto 001167 aa 016017 020021 1401 oct 016017020021 ditto 001170 aa 022023 024000 1402 oct 022023024000 ditto 001171 1403 empty2: 001171 aa 000000 000000 1404 oct 0 001172 aa 000000 000000 1405 oct 0 001173 aa 000000 000000 1406 oct 0 001174 aa 000000 000000 1407 oct 0 001175 aa 000000 000000 1408 oct 0 001176 aa 000000 000000 1409 oct 0 001177 aa 000000 000000 1410 oct 0 001200 aa 000000 000000 1411 oct 0 001201 aa 000000 000000 1412 oct 0 001202 1413 mvt_data2: 001202 aa 000000 000001 1414 oct 000000000001 maps "{" into digit_table and sign_table 001203 1415 mvt_data3: 001203 aa 000013 000000 1416 oct 000013000000 maps "}" into digit_table and sign_table 001204 aa 000000 000000 1417 oct 0 001205 aa 000000 000000 1418 oct 0 001206 aa 000000 000000 1419 oct 0 001207 aa 000000 000000 1420 oct 0 001210 aa 000000 000000 1421 oct 0 001211 aa 000000 000000 1422 oct 0 001212 aa 000000 000000 1423 oct 0 001213 aa 000000 000000 1424 oct 0 001214 aa 000000 000000 1425 oct 0 001215 aa 000000 000000 1426 oct 0 001216 aa 000000 000000 1427 oct 0 001217 aa 000000 000000 1428 oct 0 001220 aa 000000 000000 1429 oct 0 001221 aa 000000 000000 1430 oct 0 001222 aa 000000 000000 1431 oct 0 001223 aa 000000 000000 1432 oct 0 001224 aa 000000 000000 1433 oct 0 001225 aa 000000 000000 1434 oct 0 001226 aa 000000 000000 1435 oct 0 001227 aa 000000 000000 1436 oct 0 001230 aa 000000 000000 1437 oct 0 001231 aa 000000 000000 1438 oct 0 001232 aa 000000 000000 1439 oct 0 001233 aa 000000 000000 1440 oct 0 001234 aa 000000 000000 1441 oct 0 001235 aa 000000 000000 1442 oct 0 001236 aa 000000 000000 1443 oct 0 001237 aa 000000 000000 1444 oct 0 001240 aa 000000 000000 1445 oct 0 001241 aa 000000 000000 1446 oct 0 001242 aa 000000 000000 1447 oct 0 001243 aa 000000 000000 1448 oct 0 001244 aa 000000 000000 1449 oct 0 001245 aa 000000 000000 1450 oct 0 001246 aa 000000 000000 1451 oct 0 001247 aa 000000 000000 1452 oct 0 001250 aa 000000 000000 1453 oct 0 001251 aa 000000 000000 1454 oct 0 001252 aa 000000 000000 1455 oct 0 001253 aa 000000 000000 1456 oct 0 001254 aa 000000 000000 1457 oct 0 001255 aa 000000 000000 1458 oct 0 001256 aa 000000 000000 1459 oct 0 001257 aa 000000 000000 1460 oct 0 001260 aa 000000 000000 1461 oct 0 001261 aa 000000 000000 1462 oct 0 001262 aa 000000 000000 1463 oct 0 001263 aa 000000 000000 1464 oct 0 001264 aa 000000 000000 1465 oct 0 001265 aa 000000 000000 1466 oct 0 001266 aa 000000 000000 1467 oct 0 001267 aa 000000 000000 1468 oct 0 001270 aa 000000 000000 1469 oct 0 001271 aa 000000 000000 1470 oct 0 001272 aa 000000 000000 1471 oct 0 001273 aa 000000 000000 1472 oct 0 001274 aa 000000 000000 1473 oct 0 001275 aa 000000 000000 1474 oct 0 001276 aa 000000 000000 1475 oct 0 001277 aa 000000 000000 1476 oct 0 001300 aa 000000 000000 1477 oct 0 001301 aa 000000 000000 1478 oct 0 001302 aa 000000 000000 1479 oct 0 001303 aa 000000 000000 1480 oct 0 001304 aa 000000 000000 1481 oct 0 001305 aa 000000 000000 1482 oct 0 001306 aa 000000 000000 1483 oct 0 001307 aa 000000 000000 1484 oct 0 001310 aa 000000 000000 1485 oct 0 001311 aa 000000 000000 1486 oct 0 001312 aa 000000 000000 1487 oct 0 001313 aa 000000 000000 1488 oct 0 001314 aa 000000 000000 1489 oct 0 001315 aa 000000 000000 1490 oct 0 001316 aa 000000 000000 1491 oct 0 001317 aa 000000 000000 1492 oct 0 001320 aa 000000 000000 1493 oct 0 001321 aa 000000 000000 1494 oct 0 001322 aa 000000 000000 1495 oct 0 001323 aa 000000 000000 1496 oct 0 001324 aa 000000 000000 1497 oct 0 001325 aa 000000 000000 1498 oct 0 001326 aa 000000 000000 1499 oct 0 001327 aa 000000 000000 1500 oct 0 001330 aa 000000 000000 1501 oct 0 001331 aa 000000 000000 1502 oct 0 001332 aa 000000 000000 1503 oct 0 001333 aa 000000 000000 1504 oct 0 001334 aa 000000 000000 1505 oct 0 001335 aa 000000 000000 1506 oct 0 001336 aa 000000 000000 1507 oct 0 001337 aa 000000 000000 1508 oct 0 001340 aa 000000 000000 1509 oct 0 001341 aa 000000 000000 1510 oct 0 001342 aa 000000 000000 1511 oct 0 001343 aa 000000 000000 1512 oct 0 1513 1514 " 1515 " 1516 " 1517 " This was added to get rid of a page of zeroes in the object segment 1518 " When the previos table reaches 2000 octal remove the following two statements 002000 1519 org 1024 002000 aa 000001 0110 00 1520 nop 1 004000 1521 org 2048 1522 use text2 1523 1524 include cobol_op_fix_con 4-1 " **************************************** 4-2 " 4-3 " BEGIN cobol_op_fix_con.incl.alm 4-4 " Modified on 1/17/77 by Bob Chang to add short binary constants. 4-5 " Modified since Version 2.0. 4-6 " 4-7 " 4-8 " CONSTANT SECTION 4-9 " All locations are relative to the starting location con_sec. 4-10 " This part of the constant section includes only those 4-11 " constants which are never changed, because the cobol 4-12 " object codes are depending on the offset of teach constant. 4-13 " or those constants which may be changed, use cobol_op_var_con.incl.alm. 4-14 " The first number is the total number of characters. It should 4-15 " be updated whenever a new constant is added at the end. 4-16 " No constant is allowed to be inserted into the middle of this section. 4-17 " Update cobol_op_con.incl.pl1 and cobol_alphabet_offset.incl.pl1 when this 4-18 " include file is updated. 4-19 " **************************************** 4-20 " 4-21 " 4-22 " 004000 4-23 con_sec: 4-24 " start from pr0|4000(oct) 4-25 " The following number is the total number of characters of this section. 4-26 " ******* Update the follwing number whenever new constants are appended at the end ******* 004000 aa 000000 001030 4-27 oct 000000001030 004001 aa 000000 000000 4-28 oct 000000000000 004002 aa 077777 000043 4-29 null_con: its -1,1 null pointer 004003 aa 000001 000000 004004 aa 077777 000077 4-30 mask_con: oct 077777000077 004005 aa 777777 077077 4-31 oct 777777077077 4-32 " start from pr0|4006(oct) 004006 4-33 space_con: 004006 aa 040 040 040 040 4-34 aci / / 004007 aa 040 040 040 040 4-35 aci / / 4-36 " 4-37 " The constant for operpunch begin pr0|4010(oct) 004010 aa 173 101 102 103 4-38 aci /{ABC/ 004011 aa 104 105 106 107 4-39 aci /DEFG/ 004012 aa 110 111 040 040 4-40 aci /HI / 004013 aa 175 112 113 114 4-41 aci /}JKL/ 004014 aa 115 116 117 120 4-42 aci /MNOP/ 004015 aa 121 122 040 040 4-43 aci /QR / 4-44 " decimal numbers start from pr0|4016(oct) 004016 4-45 dce_con: 004016 aa 060060 060060 4-46 oct 060060060060 0 004017 aa 060060 060060 4-47 oct 060060060060 0 004020 aa 061060 060060 4-48 oct 061060060060 1000 004021 aa 062060 060060 4-49 oct 062060060060 2000 004022 aa 063060 060060 4-50 oct 063060060060 3000 004023 aa 064060 060060 4-51 oct 064060060060 4000 004024 aa 065060 060060 4-52 oct 065060060060 5000 004025 aa 066060 060060 4-53 oct 066060060060 6000 004026 aa 067060 060060 4-54 oct 067060060060 7000 004027 aa 070060 060060 4-55 oct 070060060060 8000 004030 aa 071060 060060 4-56 oct 071060060060 9000 004031 aa 060061 060060 4-57 oct 060061060060 100 004032 aa 060062 060060 4-58 oct 060062060060 200 004033 aa 060063 060060 4-59 oct 060063060060 300 004034 aa 060064 060060 4-60 oct 060064060060 400 004035 aa 060065 060060 4-61 oct 060065060060 500 004036 aa 060066 060060 4-62 oct 060066060060 600 004037 aa 060067 060060 4-63 oct 060067060060 700 004040 aa 060070 060060 4-64 oct 060070060060 800 004041 aa 060071 060060 4-65 oct 060071060060 900 004042 aa 060060 061060 4-66 oct 060060061060 10 004043 aa 060060 061061 4-67 oct 060060061061 11 004044 aa 060060 061062 4-68 oct 060060061062 12 004045 aa 060060 061063 4-69 oct 060060061063 13 004046 aa 060060 061064 4-70 oct 060060061064 14 004047 aa 060060 061065 4-71 oct 060060061065 15 004050 aa 060060 061066 4-72 oct 060060061066 16 004051 aa 060060 061067 4-73 oct 060060061067 17 004052 aa 060060 061070 4-74 oct 060060061070 18 004053 aa 060060 061071 4-75 oct 060060061071 19 004054 aa 060060 062060 4-76 oct 060060062060 20 004055 aa 060060 063060 4-77 oct 060060063060 30 004056 aa 060060 064060 4-78 oct 060060064060 40 004057 aa 060060 065060 4-79 oct 060060065060 50 004060 aa 060060 066060 4-80 oct 060060066060 60 004061 aa 060060 067060 4-81 oct 060060067060 70 004062 aa 060060 070060 4-82 oct 060060070060 80 004063 aa 060060 071060 4-83 oct 060060071060 90 004064 aa 060060 060061 4-84 oct 060060060061 1 004065 aa 060060 060062 4-85 oct 060060060062 2 004066 aa 060060 060063 4-86 oct 060060060063 3 004067 aa 060060 060064 4-87 oct 060060060064 4 004070 aa 060060 060065 4-88 oct 060060060065 5 004071 aa 060060 060066 4-89 oct 060060060066 6 004072 aa 060060 060067 4-90 oct 060060060067 7 004073 aa 060060 060070 4-91 oct 060060060070 8 004074 aa 060060 060071 4-92 oct 060060060071 9 4-93 " start from pr0|4074(oct) 004075 aa 777777 777754 4-94 neg_con: oct 777777777754 -20 004076 aa 777777 777755 4-95 oct 777777777755 -19 004077 aa 777777 777756 4-96 oct 777777777756 -18 004100 aa 777777 777757 4-97 oct 777777777757 -17 004101 aa 777777 777760 4-98 oct 777777777760 -16 004102 aa 777777 777761 4-99 oct 777777777761 -15 004103 aa 777777 777762 4-100 oct 777777777762 -14 004104 aa 777777 777763 4-101 oct 777777777763 -13 004105 aa 777777 777764 4-102 oct 777777777764 -12 004106 aa 777777 777765 4-103 oct 777777777765 -11 004107 aa 777777 777766 4-104 oct 777777777766 -10 004110 aa 777777 777767 4-105 oct 777777777767 -9 004111 aa 777777 777770 4-106 oct 777777777770 -8 004112 aa 777777 777771 4-107 oct 777777777771 -7 004113 aa 777777 777772 4-108 oct 777777777772 -6 004114 aa 777777 777773 4-109 oct 777777777773 -5 004115 aa 777777 777774 4-110 oct 777777777774 -4 004116 aa 777777 777775 4-111 oct 777777777775 -3 004117 aa 777777 777776 4-112 oct 777777777776 -2 004120 aa 777777 777777 4-113 oct 777777777777 -1 004121 aa 000000 000000 4-114 zero_con: oct 000000000000 0 004122 aa 000000 000001 4-115 one_con: oct 000000000001 1 004123 aa 000000 000002 4-116 oct 000000000002 2 004124 aa 000000 000003 4-117 oct 000000000003 3 004125 aa 000000 000004 4-118 oct 000000000004 4 004126 aa 000000 000005 4-119 oct 000000000005 5 004127 aa 000000 000006 4-120 oct 000000000006 6 004130 aa 000000 000007 4-121 oct 000000000007 7 004131 aa 000000 000010 4-122 oct 000000000010 8 004132 aa 000000 000011 4-123 oct 000000000011 9 004133 aa 000000 000012 4-124 oct 000000000012 10 004134 aa 000000 000013 4-125 oct 000000000013 11 004135 aa 000000 000014 4-126 oct 000000000014 12 004136 aa 000000 000015 4-127 oct 000000000015 13 004137 aa 000000 000016 4-128 oct 000000000016 14 004140 aa 000000 000017 4-129 oct 000000000017 15 004141 aa 000000 000020 4-130 oct 000000000020 16 004142 aa 000000 000021 4-131 oct 000000000021 17 004143 aa 000000 000022 4-132 oct 000000000022 18 004144 aa 000000 000023 4-133 oct 000000000023 19 004145 aa 000000 000024 4-134 oct 000000000024 20 004146 aa 055 142 146 000 4-135 sort_con: aci /-bf/ 004147 aa 143 154 145 141 4-136 aci /clea/ 004150 aa 156 165 160 000 4-137 aci /nup/ 004151 aa 044 044 044 044 4-138 aci /$$$$/ 004152 aa 052 052 052 052 4-139 aci /****/ 004153 aa 042 042 042 042 4-140 aci /""""/ 004154 aa 053 053 053 053 4-141 aci /++++/ 004155 aa 055 055 055 055 4-142 aci /----/ 004156 aa 057057 057057 4-143 oct 057057057057 004157 aa 056 056 056 056 4-144 aci /..../ 004160 aa 054 054 054 054 4-145 aci /,,,,/ 004161 aa 177177 177177 4-146 oct 177177177177 004162 aa 103 122 103 122 4-147 aci /CRCR/ 004163 aa 104 102 104 102 4-148 aci /DBDB/ 004164 aa 000001 000000 4-149 bin_18: oct 000001000000 1 004165 aa 000002 000000 4-150 oct 000002000000 2 004166 aa 000003 000000 4-151 oct 000003000000 3 004167 aa 000004 000000 4-152 oct 000004000000 4 004170 aa 000005 000000 4-153 oct 000005000000 5 004171 aa 000006 000000 4-154 oct 000006000000 6 004172 aa 000007 000000 4-155 oct 000007000000 7 004173 aa 000010 000000 4-156 oct 000010000000 8 004174 aa 000011 000000 4-157 oct 000011000000 9 004175 aa 000012 000000 4-158 oct 000012000000 10 004176 aa 000013 000000 4-159 oct 000013000000 11 004177 aa 000014 000000 4-160 oct 000014000000 12 004200 aa 000015 000000 4-161 oct 000015000000 13 004201 aa 000016 000000 4-162 oct 000016000000 14 004202 aa 000017 000000 4-163 oct 000017000000 15 004203 aa 000020 000000 4-164 oct 000020000000 16 004204 aa 000021 000000 4-165 oct 000021000000 17 004205 aa 000022 000000 4-166 oct 000022000000 18 004206 aa 000023 000000 4-167 oct 000023000000 19 004207 aa 000024 000000 4-168 oct 000024000000 20 4-169 " 4-170 " 000400 4-171 org 256 4-172 use text3 4-173 4-174 " 4-175 " 4-176 " Starts from pr0|4400(oct) 4-177 " The following table are the translation table from ascii to ebcdic 4-178 " 004400 4-179 ascii_ebcdic: 004400 aa 000001 002003 4-180 oct 000001002003 004401 aa 067055 056057 4-181 oct 067055056057 004402 aa 026005 045013 4-182 oct 026005045013 004403 aa 014015 016017 4-183 oct 014015016017 004404 aa 020021 022023 4-184 oct 020021022023 004405 aa 074075 062046 4-185 oct 074075062046 004406 aa 030031 077047 4-186 oct 030031077047 004407 aa 034035 036037 4-187 oct 034035036037 004410 aa 100117 177173 4-188 oct 100117177173 004411 aa 133154 120175 4-189 oct 133154120175 004412 aa 115135 134116 4-190 oct 115135134116 004413 aa 153140 113141 4-191 oct 153140113141 004414 aa 360361 362363 4-192 oct 360361362363 004415 aa 364365 366367 4-193 oct 364365366367 004416 aa 370371 172136 4-194 oct 370371172136 004417 aa 114176 156157 4-195 oct 114176156157 004420 aa 174301 302303 4-196 oct 174301302303 004421 aa 304305 306307 4-197 oct 304305306307 004422 aa 310311 321322 4-198 oct 310311321322 004423 aa 323324 325326 4-199 oct 323324325326 004424 aa 327330 331342 4-200 oct 327330331342 004425 aa 343344 345346 4-201 oct 343344345346 004426 aa 347350 351112 4-202 oct 347350351112 004427 aa 340132 137155 4-203 oct 340132137155 004430 aa 171201 202203 4-204 oct 171201202203 004431 aa 204205 206207 4-205 oct 204205206207 004432 aa 210211 221222 4-206 oct 210211221222 004433 aa 223224 225226 4-207 oct 223224225226 004434 aa 227230 231242 4-208 oct 227230231242 004435 aa 243244 245246 4-209 oct 243244245246 004436 aa 247250 251300 4-210 oct 247250251300 004437 aa 152320 241007 4-211 oct 152320241007 004440 aa 040041 042043 4-212 oct 040041042043 004441 aa 044025 006027 4-213 oct 044025006027 004442 aa 050051 052053 4-214 oct 050051052053 004443 aa 054011 012033 4-215 oct 054011012033 004444 aa 060061 032063 4-216 oct 060061032063 004445 aa 064065 066010 4-217 oct 064065066010 004446 aa 070071 072073 4-218 oct 070071072073 004447 aa 004024 076341 4-219 oct 004024076341 004450 aa 101102 103104 4-220 oct 101102103104 004451 aa 105106 107110 4-221 oct 105106107110 004452 aa 111121 122123 4-222 oct 111121122123 004453 aa 124125 126127 4-223 oct 124125126127 004454 aa 130131 142143 4-224 oct 130131142143 004455 aa 144145 146147 4-225 oct 144145146147 004456 aa 150151 160161 4-226 oct 150151160161 004457 aa 162163 164165 4-227 oct 162163164165 004460 aa 166167 170200 4-228 oct 166167170200 004461 aa 212213 214215 4-229 oct 212213214215 004462 aa 216217 220232 4-230 oct 216217220232 004463 aa 233234 235236 4-231 oct 233234235236 004464 aa 237240 252253 4-232 oct 237240252253 004465 aa 254255 256257 4-233 oct 254255256257 004466 aa 260261 262263 4-234 oct 260261262263 004467 aa 264265 266267 4-235 oct 264265266267 004470 aa 270271 272273 4-236 oct 270271272273 004471 aa 274275 276277 4-237 oct 274275276277 004472 aa 312313 314315 4-238 oct 312313314315 004473 aa 316317 332333 4-239 oct 316317332333 004474 aa 334335 336337 4-240 oct 334335336337 004475 aa 352353 354355 4-241 oct 352353354355 004476 aa 356357 372373 4-242 oct 356357372373 004477 aa 374375 376377 4-243 oct 374375376377 004500 aa 400401 402403 4-244 oct 400401402403 004501 aa 404405 406407 4-245 oct 404405406407 004502 aa 410411 412413 4-246 oct 410411412413 004503 aa 414415 416417 4-247 oct 414415416417 004504 aa 420421 422423 4-248 oct 420421422423 004505 aa 424425 426427 4-249 oct 424425426427 004506 aa 430431 432433 4-250 oct 430431432433 004507 aa 434435 436437 4-251 oct 434435436437 004510 aa 440441 442443 4-252 oct 440441442443 004511 aa 444445 446447 4-253 oct 444445446447 004512 aa 450451 452453 4-254 oct 450451452453 004513 aa 454455 456457 4-255 oct 454455456457 004514 aa 460461 462463 4-256 oct 460461462463 004515 aa 464465 466467 4-257 oct 464465466467 004516 aa 470471 472473 4-258 oct 470471472473 004517 aa 474475 476477 4-259 oct 474475476477 004520 aa 500501 502503 4-260 oct 500501502503 004521 aa 504505 506507 4-261 oct 504505506507 004522 aa 510511 512513 4-262 oct 510511512513 004523 aa 514515 516517 4-263 oct 514515516517 004524 aa 520521 522523 4-264 oct 520521522523 004525 aa 524525 526527 4-265 oct 524525526527 004526 aa 530531 532533 4-266 oct 530531532533 004527 aa 534535 536537 4-267 oct 534535536537 004530 aa 540541 542543 4-268 oct 540541542543 004531 aa 544545 546547 4-269 oct 544545546547 004532 aa 550551 552553 4-270 oct 550551552553 004533 aa 554555 556557 4-271 oct 554555556557 004534 aa 560561 562563 4-272 oct 560561562563 004535 aa 564565 566567 4-273 oct 564565566567 004536 aa 570571 572573 4-274 oct 570571572573 004537 aa 574575 576577 4-275 oct 574575576577 004540 aa 600601 602603 4-276 oct 600601602603 004541 aa 604605 606607 4-277 oct 604605606607 004542 aa 610611 612613 4-278 oct 610611612613 004543 aa 614615 616617 4-279 oct 614615616617 004544 aa 620621 622623 4-280 oct 620621622623 004545 aa 624625 626627 4-281 oct 624625626627 004546 aa 630631 632633 4-282 oct 630631632633 004547 aa 634635 636637 4-283 oct 634635636637 004550 aa 640641 642643 4-284 oct 640641642643 004551 aa 644645 646647 4-285 oct 644645646647 004552 aa 650651 652653 4-286 oct 650651652653 004553 aa 654655 656657 4-287 oct 654655656657 004554 aa 660661 662663 4-288 oct 660661662663 004555 aa 664665 666667 4-289 oct 664665666667 004556 aa 670671 672673 4-290 oct 670671672673 004557 aa 674675 676677 4-291 oct 674675676677 004560 aa 700701 702703 4-292 oct 700701702703 004561 aa 704705 706707 4-293 oct 704705706707 004562 aa 710711 712713 4-294 oct 710711712713 004563 aa 714715 716717 4-295 oct 714715716717 004564 aa 720721 722723 4-296 oct 720721722723 004565 aa 724725 726727 4-297 oct 724725726727 004566 aa 730731 732733 4-298 oct 730731732733 004567 aa 734735 736737 4-299 oct 734735736737 004570 aa 740741 742743 4-300 oct 740741742743 004571 aa 744745 746747 4-301 oct 744745746747 004572 aa 750751 752753 4-302 oct 750751752753 004573 aa 754755 756757 4-303 oct 754755756757 004574 aa 760761 762763 4-304 oct 760761762763 004575 aa 764765 766767 4-305 oct 764765766767 004576 aa 770771 772773 4-306 oct 770771772773 004577 aa 774775 776777 4-307 oct 774775776777 4-308 " 4-309 " 4-310 " The ebcdic to ascii translation table 4-311 " 004600 4-312 ebcdic_ascii: 004600 aa 000001 002003 4-313 oct 000001002003 004601 aa 234011 206177 4-314 oct 234011206177 004602 aa 227215 216013 4-315 oct 227215216013 004603 aa 014015 016017 4-316 oct 014015016017 004604 aa 020021 022023 4-317 oct 020021022023 004605 aa 235205 010207 4-318 oct 235205010207 004606 aa 030031 222217 4-319 oct 030031222217 004607 aa 034035 036037 4-320 oct 034035036037 004610 aa 200201 202203 4-321 oct 200201202203 004611 aa 204012 027033 4-322 oct 204012027033 004612 aa 210211 212213 4-323 oct 210211212213 004613 aa 214005 006007 4-324 oct 214005006007 004614 aa 220221 026223 4-325 oct 220221026223 004615 aa 224225 226004 4-326 oct 224225226004 004616 aa 230231 232233 4-327 oct 230231232233 004617 aa 024025 236032 4-328 oct 024025236032 004620 aa 040240 241242 4-329 oct 040240241242 004621 aa 243244 245246 4-330 oct 243244245246 004622 aa 247250 133056 4-331 oct 247250133056 004623 aa 074050 053041 4-332 oct 074050053041 004624 aa 046251 252253 4-333 oct 046251252253 004625 aa 254255 256257 4-334 oct 254255256257 004626 aa 260261 135044 4-335 oct 260261135044 004627 aa 052051 073136 4-336 oct 052051073136 004630 aa 055057 262263 4-337 oct 055057262263 004631 aa 264265 266267 4-338 oct 264265266267 004632 aa 270271 174054 4-339 oct 270271174054 004633 aa 045137 076077 4-340 oct 045137076077 004634 aa 272273 274275 4-341 oct 272273274275 004635 aa 276277 300301 4-342 oct 276277300301 004636 aa 302140 072043 4-343 oct 302140072043 004637 aa 100047 075042 4-344 oct 100047075042 004640 aa 303141 142143 4-345 oct 303141142143 004641 aa 144145 146147 4-346 oct 144145146147 004642 aa 150151 304305 4-347 oct 150151304305 004643 aa 306307 310311 4-348 oct 306307310311 004644 aa 312152 153154 4-349 oct 312152153154 004645 aa 155156 157160 4-350 oct 155156157160 004646 aa 161162 313314 4-351 oct 161162313314 004647 aa 315316 317320 4-352 oct 315316317320 004650 aa 321176 163164 4-353 oct 321176163164 004651 aa 165166 167170 4-354 oct 165166167170 004652 aa 171172 322323 4-355 oct 171172322323 004653 aa 324325 326327 4-356 oct 324325326327 004654 aa 330331 332333 4-357 oct 330331332333 004655 aa 334335 336337 4-358 oct 334335336337 004656 aa 340341 342343 4-359 oct 340341342343 004657 aa 344345 346347 4-360 oct 344345346347 004660 aa 173101 102103 4-361 oct 173101102103 004661 aa 104105 106107 4-362 oct 104105106107 004662 aa 110111 350351 4-363 oct 110111350351 004663 aa 352353 354355 4-364 oct 352353354355 004664 aa 175112 113114 4-365 oct 175112113114 004665 aa 115116 117120 4-366 oct 115116117120 004666 aa 121122 356357 4-367 oct 121122356357 004667 aa 360361 362363 4-368 oct 360361362363 004670 aa 134237 123124 4-369 oct 134237123124 004671 aa 125126 127130 4-370 oct 125126127130 004672 aa 131132 364365 4-371 oct 131132364365 004673 aa 366367 370371 4-372 oct 366367370371 004674 aa 060061 062063 4-373 oct 060061062063 004675 aa 064065 066067 4-374 oct 064065066067 004676 aa 070071 372373 4-375 oct 070071372373 004677 aa 374375 376377 4-376 oct 374375376377 004700 aa 400401 402403 4-377 oct 400401402403 004701 aa 404405 406407 4-378 oct 404405406407 004702 aa 410411 412413 4-379 oct 410411412413 004703 aa 414415 416417 4-380 oct 414415416417 004704 aa 420421 422423 4-381 oct 420421422423 004705 aa 424425 426427 4-382 oct 424425426427 004706 aa 430431 432433 4-383 oct 430431432433 004707 aa 434435 436437 4-384 oct 434435436437 004710 aa 440441 442443 4-385 oct 440441442443 004711 aa 444445 446447 4-386 oct 444445446447 004712 aa 450451 452453 4-387 oct 450451452453 004713 aa 454455 456457 4-388 oct 454455456457 004714 aa 460461 462463 4-389 oct 460461462463 004715 aa 464465 466467 4-390 oct 464465466467 004716 aa 470471 472473 4-391 oct 470471472473 004717 aa 474475 476477 4-392 oct 474475476477 004720 aa 500501 502503 4-393 oct 500501502503 004721 aa 504505 506507 4-394 oct 504505506507 004722 aa 510511 512513 4-395 oct 510511512513 004723 aa 514515 516517 4-396 oct 514515516517 004724 aa 520521 522523 4-397 oct 520521522523 004725 aa 524525 526527 4-398 oct 524525526527 004726 aa 530531 532533 4-399 oct 530531532533 004727 aa 534535 536537 4-400 oct 534535536537 004730 aa 540541 542543 4-401 oct 540541542543 004731 aa 544545 546547 4-402 oct 544545546547 004732 aa 550551 552553 4-403 oct 550551552553 004733 aa 554555 556557 4-404 oct 554555556557 004734 aa 560561 562563 4-405 oct 560561562563 004735 aa 564565 566567 4-406 oct 564565566567 004736 aa 570571 572573 4-407 oct 570571572573 004737 aa 574575 576577 4-408 oct 574575576577 004740 aa 600601 602603 4-409 oct 600601602603 004741 aa 604605 606607 4-410 oct 604605606607 004742 aa 610611 612613 4-411 oct 610611612613 004743 aa 614615 616617 4-412 oct 614615616617 004744 aa 620621 622623 4-413 oct 620621622623 004745 aa 624625 626627 4-414 oct 624625626627 004746 aa 630631 632633 4-415 oct 630631632633 004747 aa 634635 636637 4-416 oct 634635636637 004750 aa 640641 642643 4-417 oct 640641642643 004751 aa 644645 646647 4-418 oct 644645646647 004752 aa 650651 652653 4-419 oct 650651652653 004753 aa 654655 656657 4-420 oct 654655656657 004754 aa 660661 662663 4-421 oct 660661662663 004755 aa 664665 666667 4-422 oct 664665666667 004756 aa 670671 672673 4-423 oct 670671672673 004757 aa 674675 676677 4-424 oct 674675676677 004760 aa 700701 702703 4-425 oct 700701702703 004761 aa 704705 706707 4-426 oct 704705706707 004762 aa 710711 712713 4-427 oct 710711712713 004763 aa 714715 716717 4-428 oct 714715716717 004764 aa 720721 722723 4-429 oct 720721722723 004765 aa 724725 726727 4-430 oct 724725726727 004766 aa 730731 732733 4-431 oct 730731732733 004767 aa 734735 736737 4-432 oct 734735736737 004770 aa 740741 742743 4-433 oct 740741742743 004771 aa 744745 746747 4-434 oct 744745746747 004772 aa 750751 752753 4-435 oct 750751752753 004773 aa 754755 756757 4-436 oct 754755756757 004774 aa 760761 762763 4-437 oct 760761762763 004775 aa 764765 766767 4-438 oct 764765766767 004776 aa 770771 772773 4-439 oct 770771772773 004777 aa 774775 776777 4-440 oct 774775776777 4-441 " Please insert the new frequently used constant before this line. 4-442 " 4-443 " 4-444 " END cobol_op_fix_con.incl.alm 4-445 " 1525 " 1526 " 1527 " This was added to get rid of a page of zeroes in the object segment 1528 " When the previous table reaches 6030 octal remove the following two statements 001430 1529 org 792 006030 aa 000001 0110 00 1530 nop 1 003400 1531 org 1792 1532 use text4 1533 1534 " **************************************** 1535 " 1536 " This page is for the cobol_error. tra instruction. 1537 " 1538 " **************************************** 1539 " 1540 " 1541 " 010000 0a 012053 7070 00 1542 tsx7 cobol_error_no_mcode 1 010001 0a 012053 7070 00 1543 tsx7 cobol_error_no_mcode 2 010002 0a 012054 7070 00 1544 tsx7 cobol_error 3 010003 0a 012054 7070 00 1545 tsx7 cobol_error 4 010004 0a 012053 7070 00 1546 tsx7 cobol_error_no_mcode 5 010005 0a 012054 7070 00 1547 tsx7 cobol_error 6 010006 0a 012054 7070 00 1548 tsx7 cobol_error 7 010007 0a 012053 7070 00 1549 tsx7 cobol_error_no_mcode 8 010010 0a 012053 7070 00 1550 tsx7 cobol_error_no_mcode 9 010011 0a 012053 7070 00 1551 tsx7 cobol_error_no_mcode 10 010012 0a 012054 7070 00 1552 tsx7 cobol_error 11 010013 0a 012054 7070 00 1553 tsx7 cobol_error 12 010014 0a 012054 7070 00 1554 tsx7 cobol_error 13 010015 0a 012054 7070 00 1555 tsx7 cobol_error 14 010016 0a 012054 7070 00 1556 tsx7 cobol_error 15 010017 0a 012054 7070 00 1557 tsx7 cobol_error 16 010020 0a 012053 7070 00 1558 tsx7 cobol_error_no_mcode 17 010021 0a 012054 7070 00 1559 tsx7 cobol_error 18 010022 0a 012054 7070 00 1560 tsx7 cobol_error 19 010023 0a 012053 7070 00 1561 tsx7 cobol_error_no_mcode 20 010024 0a 012054 7070 00 1562 tsx7 cobol_error 21 010025 0a 012054 7070 00 1563 tsx7 cobol_error 22 010026 0a 012053 7070 00 1564 tsx7 cobol_error_no_mcode 23 010027 0a 012053 7070 00 1565 tsx7 cobol_error_no_mcode 24 010030 0a 012054 7070 00 1566 tsx7 cobol_error 25 010031 0a 012054 7070 00 1567 tsx7 cobol_error 26 010032 0a 012054 7070 00 1568 tsx7 cobol_error 27 010033 0a 012053 7070 00 1569 tsx7 cobol_error_no_mcode 28 010034 0a 012054 7070 00 1570 tsx7 cobol_error 29 010035 0a 012054 7070 00 1571 tsx7 cobol_error 30 010036 0a 012054 7070 00 1572 tsx7 cobol_error 31 010037 0a 012054 7070 00 1573 tsx7 cobol_error 32 010040 0a 012053 7070 00 1574 tsx7 cobol_error_no_mcode 33 010041 0a 012053 7070 00 1575 tsx7 cobol_error_no_mcode 34 010042 0a 012053 7070 00 1576 tsx7 cobol_error_no_mcode 35 010043 0a 012053 7070 00 1577 tsx7 cobol_error_no_mcode 36 010044 0a 012054 7070 00 1578 tsx7 cobol_error 37 010045 0a 012054 7070 00 1579 tsx7 cobol_error 38 010046 0a 012053 7070 00 1580 tsx7 cobol_error_no_mcode 39 010047 0a 012053 7070 00 1581 tsx7 cobol_error_no_mcode 40 010050 0a 012054 7070 00 1582 tsx7 cobol_error 41 [4.1-1] 010051 0a 012053 7070 00 1583 tsx7 cobol_error_no_mcode 42 010052 0a 012054 7070 00 1584 tsx7 cobol_error 43 [4.1-1] 010053 0a 012053 7070 00 1585 tsx7 cobol_error_no_mcode 44 010054 0a 012053 7070 00 1586 tsx7 cobol_error_no_mcode 45 010055 0a 012053 7070 00 1587 tsx7 cobol_error_no_mcode 46 010056 0a 012053 7070 00 1588 tsx7 cobol_error_no_mcode 47 010057 0a 012053 7070 00 1589 tsx7 cobol_error_no_mcode 48 010060 0a 012053 7070 00 1590 tsx7 cobol_error_no_mcode 49 010061 0a 012054 7070 00 1591 tsx7 cobol_error 50 010062 0a 012054 7070 00 1592 tsx7 cobol_error 51 010063 0a 012054 7070 00 1593 tsx7 cobol_error 52 010064 0a 012132 7070 00 1594 tsx7 cobol_error_53 53 010065 0a 012054 7070 00 1595 tsx7 cobol_error 54 010066 0a 012054 7070 00 1596 tsx7 cobol_error 55 010067 0a 012054 7070 00 1597 tsx7 cobol_error 56 010070 0a 012054 7070 00 1598 tsx7 cobol_error 57 010071 0a 012054 7070 00 1599 tsx7 cobol_error 58 010072 0a 012053 7070 00 1600 tsx7 cobol_error_no_mcode 59 010073 0a 012053 7070 00 1601 tsx7 cobol_error_no_mcode 60 010074 0a 012053 7070 00 1602 tsx7 cobol_error_no_mcode 61 010075 0a 012053 7070 00 1603 tsx7 cobol_error_no_mcode 62 010076 0a 012053 7070 00 1604 tsx7 cobol_error_no_mcode 63 010077 0a 012053 7070 00 1605 tsx7 cobol_error_no_mcode 64 010100 0a 012053 7070 00 1606 tsx7 cobol_error_no_mcode 65 010101 0a 012053 7070 00 1607 tsx7 cobol_error_no_mcode 66 010102 0a 012053 7070 00 1608 tsx7 cobol_error_no_mcode 67 010103 0a 012053 7070 00 1609 tsx7 cobol_error_no_mcode 68 010104 0a 012053 7070 00 1610 tsx7 cobol_error_no_mcode 69 010105 0a 012053 7070 00 1611 tsx7 cobol_error_no_mcode 70 010106 0a 012053 7070 00 1612 tsx7 cobol_error_no_mcode 71 010107 0a 012053 7070 00 1613 tsx7 cobol_error_no_mcode 72 010110 0a 012053 7070 00 1614 tsx7 cobol_error_no_mcode 73 010111 0a 012053 7070 00 1615 tsx7 cobol_error_no_mcode 74 010112 0a 012053 7070 00 1616 tsx7 cobol_error_no_mcode 75 010113 0a 012053 7070 00 1617 tsx7 cobol_error_no_mcode 76 010114 0a 012053 7070 00 1618 tsx7 cobol_error_no_mcode 77 010115 0a 012053 7070 00 1619 tsx7 cobol_error_no_mcode 78 010116 0a 012053 7070 00 1620 tsx7 cobol_error_no_mcode 79 010117 0a 012053 7070 00 1621 tsx7 cobol_error_no_mcode 80 010120 0a 012053 7070 00 1622 tsx7 cobol_error_no_mcode 81 010121 0a 012053 7070 00 1623 tsx7 cobol_error_no_mcode 82 1624 " 1625 " 002000 1626 org 1024 1627 use text5 1628 1629 " 1630 include cobol_op_var_con 5-1 " ************************************* 5-2 " 5-3 " BEGIN cobol_op_var_con.incl.alm 5-4 " Modified on 11/30/78 by FCH 5-5 " Created 7/9/76 by Bob Chang 5-6 " 5-7 " 5-8 " CONSTANT SECTION ---flexiable part. 5-9 5-10 " ************************************* 5-11 " 5-12 " 5-13 " the following constants are cobol status codes used through the io operators. 012000 aa 071 040 040 040 5-14 io9_con: aci /9 / 012001 aa 061 060 040 040 5-15 io10_con: aci /10 / 012002 aa 062 062 040 040 5-16 io22_con: aci /22 / 012003 aa 063 060 040 040 5-17 io30_con: aci /30 / 012004 aa 061 060 063 062 5-18 s1032con: aci /1032/ 012005 aa 061 060 063 066 5-19 s1036con: aci /1036/ 012006 aa 061 060 071 060 5-20 s1090con: aci /1090/ 012007 aa 061 061 071 063 5-21 s1193con: aci /1193/ 012010 aa 061 062 071 063 5-22 s1293con: aci /1293/ 012011 aa 061 062 071 065 5-23 s1295con: aci /1295/ 012012 aa 062 060 063 066 5-24 s2036con: aci /2036/ 012013 aa 062 063 071 063 5-25 s2393con: aci /2393/ 012014 aa 063 060 063 061 5-26 s3031con: aci /3031/ 012015 aa 063 060 063 062 5-27 s3032con: aci /3032/ 012016 aa 063 064 061 060 5-28 s3410con: aci /3410/ 012017 aa 064 060 062 062 5-29 s4022con: aci /4022/ 012020 aa 064 060 063 061 5-30 s4031con: aci /4031/ 012021 aa 064 064 063 060 5-31 s4430con: aci /4430/ 012022 aa 064 064 063 062 5-32 s4432con: aci /4432/ 012023 aa 064 065 063 062 5-33 s4532con: aci /4532/ 012024 aa 064 066 063 060 5-34 s4630con: aci /4630/ 012025 aa 064 067 063 060 5-35 s4730con: aci /4730/ 012026 aa 065 064 063 062 5-36 s5432con: aci /5432/ 012027 aa 065 067 063 060 5-37 s5730con: aci /5730/ 012030 aa 064 066 063 062 5-38 s4632con: aci /4632/ 012031 aa 066 060 063 061 5-39 s6031con: aci /6031/ 012032 aa 066 067 063 062 5-40 s6732con: aci /6732/ 012033 aa 067 060 063 061 5-41 s7031con: aci /7031/ 012034 aa 067 064 063 060 5-42 s7430con: aci /7430/ 012035 aa 067 066 063 062 5-43 s7632con: aci /7632/ 012036 aa 000000 000000 5-44 atd_con: oct 000000000000 012037 aa 377777 000000 5-45 high_con: oct 377777000000 012040 aa 300000 000000 5-46 optional_int: oct 300000000000 012041 aa 240000 000000 5-47 optional_ext: oct 240000000000 012042 aa 524000 000015 5-48 volume_desc: oct 524000000015 012043 aa 166 157 154 165 5-49 volume_con: aci /volu/ 012044 aa 155 145 137 163 5-50 aci /me_s/ 012045 aa 164 141 164 165 5-51 aci /tatu/ 012046 aa 163 040 040 040 5-52 aci /s / 012047 aa 524000 000004 5-53 feov_desc: oct 524000000004 012050 aa 146 145 157 166 5-54 feov_con: aci /feov/ 012051 aa 464000 000000 5-55 ptr_desc: oct 464000000000 012052 aa 404000 000043 5-56 fb35_desc: oct 404000000043 5-57 " 5-58 " 5-59 " Please insert the next new constant before this line. 5-60 " 5-61 " END cobol_op_var_con.incl.alm 5-62 " 5-63 " 5-64 " 1631 1632 " **************************************** 1633 " 1634 " This page is for the cobol_error operator. 1635 " 1636 " **************************************** 1637 " 1638 " 012053 1639 cobol_error_no_mcode: 012053 aa 6 00050 4501 00 1640 stz pr6|mcode 012054 1641 cobol_error: 012054 1642 inhibit on 012054 aa 6 00101 7403 00 1643 stx0 pr6|return_to_main_off 012055 1644 inhibit off 012055 aa 000001 2350 07 1645 lda 1,dl Set the rts_code for cobol_error_ 012056 aa 6 00110 7551 00 1646 sta pr6|rts_code 012057 aa 010000 1670 03 1647 sbx7 4096,du Get the cobol_error_code 012060 aa 6 00131 4501 00 1648 stz pr6|89 012061 aa 6 00131 4471 00 1649 sxl7 pr6|89 012062 aa 6 00026 3501 20 1650 epp0 pr6|stack_frame.entry_ptr,* Get the entry pointer 012063 aa 6 00134 4501 00 1651 stz pr6|92 Zero out the line number 012064 aa 6 00135 4501 00 1652 stz pr6|93 012065 aa 0 00004 2201 00 1653 ldx0 pr0|4 entry_seq for the symbol section 012066 0a 012115 6000 00 1654 tze line_no_done 012067 aa 6 00154 3701 20 1655 epp4 pr6|pr4_save,* load pr4 012070 aa 4 00000 3501 30 1656 epp0 pr4|0,0* get the symbol section 012071 aa 0 00016 7201 00 1657 lxl0 pr0|14 get the area offset 012072 aa 0 00006 7211 10 1658 lxl1 pr0|6,0 get the upper bound offset 012073 aa 6 00114 7411 00 1659 stx1 pr6|76 store into temporary location 012074 aa 0 00006 2201 10 1660 ldx0 pr0|6,0 get the lower bound offset 012075 aa 0 00000 2211 10 1661 ldx1 pr0|0,0 start the loop 012076 aa 6 00101 1011 00 1662 cmpx1 pr6|return_to_main_off 012077 aa 000007 6000 04 1663 tze 7,ic the current line number 012100 aa 000005 6050 04 1664 tpl 5,ic the next line number 012101 aa 6 00114 1001 00 1665 cmpx0 pr6|76 check with the upper bound 012102 0a 012115 6050 00 1666 tpl line_no_done no line number obtainable 012103 aa 000002 0600 03 1667 adx0 2,du 012104 aa 777771 7100 04 1668 tra -7,ic back to loop 012105 aa 000002 1600 03 1669 sbx0 2,du 012106 aa 0 00000 2351 10 1670 lda pr0|0,0 get_statement_map 012107 aa 0 00001 2361 10 1671 ldq pr0|1,0 load seperately in case of odd loc. 012110 0a 012130 3770 00 1672 anaq line_mask mask the line number part. 012111 aa 000012 7730 00 1673 lrl 10 get the file number in a reg 012112 aa 6 00135 7551 00 1674 sta pr6|93 012113 aa 000026 7720 00 1675 qrl 22 get the line number in q 012114 aa 6 00134 7561 00 1676 stq pr6|92 012115 1677 line_no_done: 012115 aa 6 00100 3501 20 1678 epp0 pr6|return_to_main_ptr,* get the error pointer 012116 aa 6 00136 2501 00 1679 spri0 pr6|94 012117 aa 000001 2350 07 1680 lda 1,dl get the rts code 1 012120 aa 6 00110 7551 00 1681 sta pr6|rts_code 012121 aa 4 00023 3501 00 1682 epp0 pr4|19 load the location of program name 012122 aa 6 00140 2501 00 1683 spri0 pr6|96 012123 aa 4 00022 2351 00 1684 lda pr4|18 get program name length 012124 aa 6 00142 7551 00 1685 sta pr6|98 012125 aa 6 00050 2351 00 1686 lda pr6|mcode get status code of multics 012126 aa 6 00132 7551 00 1687 sta pr6|90 012127 0a 000336 7100 00 1688 tra call_rts_from_op 1689 " constant for cobol_error 1690 even 012130 1691 line_mask: 012130 aa 000000 777777 1692 oct 000000777777 012131 aa 740000 000000 1693 oct 740000000000 1694 " 1695 " 1696 " 1697 " ****************************** 1698 " 1699 " cobol_error_53 1700 " 012132 1701 cobol_error_53: 1702 " epp4 pr6|linkage_ptr,* reload pr4 after call out 1703 " lda 6,dl load rts code for sort_terminate 1704 " sta pr6|rts_code 1705 " epp0 return_from_term overset the return pointer 1706 " spri0 pr6|stack_frame.return_ptr 1707 " tra call_rts_from_op 1708 even 012132 1709 return_from_term: 012132 aa 6 00120 2351 00 1710 lda pr6|80 get the multics status code 012133 aa 6 00050 7551 00 1711 sta pr6|mcode 012134 1712 cobol_error_from_op: 012134 aa 6 00101 2201 00 1713 ldx0 pr6|return_to_main_off load x0 before transfer to cobol_error 012135 aa 6 00044 3701 20 1714 epp4 pr6|linkage_ptr,* reload pr4 after call out 012136 0a 000320 3500 00 1715 epp0 return_from_call reset the return pointer back to noraml 012137 aa 6 00024 2501 00 1716 spri0 pr6|stack_frame.return_ptr 012140 aa 6 00131 7271 00 1717 lxl7 pr6|89 get the cobol error code 012141 aa 010000 0670 03 1718 adx7 4096,du put the adjust error code into x7 012142 0a 012054 7100 00 1719 tra cobol_error 1720 " 1721 " 1722 " 1723 " 1724 " Please insert the next cobol error operator before this line 1725 " 1726 1727 " **************************************** 1728 " 1729 " The following operators are low used operators. 1730 " 1731 " **************************************** 1732 1733 1734 " 1735 " operator to do a procedure return 1736 " 012143 1737 return_mac: 012143 aa 6 00000 3731 00 1738 epbpsb sp|0 get ptr to base of stack 012144 1739 inhibit on 012144 aa 7 00024 6523 00 1740 sprisp sb|stack_header.stack_end_ptr reset stack end pointer 012145 aa 6 00020 3723 20 1741 eppsp sp|stack_frame.prev_sp,* pop stack 012146 1742 inhibit off 012146 aa 6 00000 3731 00 1743 epbpsb sp|0 set sb up in case we just switched stacks 012147 aa 6 00030 3501 20 1744 eppap sp|stack_frame.operator_ptr,* set up operator pointer 012150 aa 6 00025 6341 00 1745 ldi sp|stack_frame.return_ptr+1 012151 aa 6 00024 6101 00 1746 rtcd sp|stack_frame.return_ptr continue execution after call 1747 " 1748 " 1749 " 1750 " 1751 " operator to enable a condition. calling sequence is: 1752 " eppbp name 1753 " lxl6 name_size 1754 " tsx0 ap|enable 1755 " tra on_unit_body 1756 " arg on_unit (snap & system flags in RHS if used) 1757 " tra skip_around_body 1758 " body of on unit starts here 1759 " 1760 include on_unit 6-1 " 6-2 " BEGIN INCLUDE FILE --- on_unit.incl.alm 5/75 RAB 6-3 " 000000 6-4 equ on_unit.name,0 000002 6-5 equ on_unit.body,2 000004 6-6 equ on_unit.size,4 000005 6-7 equ on_unit.next,5 upper offset relative to stack FRAME 000005 6-8 equ on_unit.flags,5 lower 000006 6-9 equ on_unit.file,6 000010 6-10 equ on_unit.file_copy,8 6-11 " 6-12 " END INCLUDE FILE --- on_unit.incl.alm 6-13 " 012152 1761 enable_1: 1762 1763 " 1764 " 012152 1765 enable: 012152 1766 inhibit on 012152 aa 6 00101 7403 00 1767 stx0 pr6|return_to_main_off 012153 1768 inhibit off 012153 aa 6 00037 4401 00 1769 sxl0 sp|stack_frame.operator_ret_ptr 012154 aa 6 00046 3515 70 1770 epp1 sp|text_base_ptr,*0 012155 aa 000100 2350 07 1771 lda =o100,dl is there a valid on_unit_list 012156 aa 6 00020 3151 00 1772 cana sp|stack_frame.prev_sp check bit 29 of sp|stack_frame.prev_sp 012157 aa 000003 6010 04 1773 tnz 3,ic non-zero means ok 012160 aa 6 00036 4501 00 1774 stz sp|stack_frame.on_unit_rel_ptrs init ptr 012161 aa 6 00020 2551 00 1775 orsa sp|stack_frame.prev_sp and set bit 1776 " 012162 aa 6 00036 2211 00 1777 ldx1 sp|stack_frame.on_unit_rel_ptrs get rel ptr to first enabled unit 012163 0a 012170 6000 00 1778 tze add_on zero means chain empty 012164 aa 1 00000 1011 00 1779 on_1: cmpx1 pr1|0 is this the unit we want 012165 0a 012174 6000 00 1780 tze have_on yes, go process 012166 aa 6 00005 2211 11 1781 ldx1 sp|on_unit.next,1 no, get ptr to next on chain 012167 0a 012164 6010 00 1782 tnz on_1 and repeat if end not reached 012170 aa 1 00000 2211 00 1783 add_on: ldx1 pr1|0 get rel ptr to new unit 012171 aa 6 00036 2201 00 1784 ldx0 sp|stack_frame.on_unit_rel_ptrs get rel ptr to first unit 012172 aa 6 00005 7401 11 1785 stx0 sp|on_unit.next,1 set next ptr of new unit 012173 aa 6 00036 7411 00 1786 stx1 sp|stack_frame.on_unit_rel_ptrs make new unit first on chain 012174 aa 6 00000 2521 11 1787 have_on: spribp sp|on_unit.name,1 set name of new unit 012175 aa 6 00002 2535 11 1788 spri3 sp|on_unit.body,1 set ptr to body 012176 aa 6 00004 4501 11 1789 stz sp|on_unit.size,1 clear size field 012177 aa 6 00004 4461 11 1790 sxl6 sp|on_unit.size,1 set size of unit name 012200 aa 1 00000 7201 00 1791 lxl0 pr1|0 get snap & system flags 012201 aa 6 00005 4401 11 1792 sxl0 sp|on_unit.flags,1 and save in on unit 012202 aa 6 00037 4501 00 1793 stz sp|stack_frame.operator_ret_ptr 012203 aa 6 00156 3535 20 1794 epp3 pr6|pr3_save,* 012204 aa 6 00160 3715 20 1795 epp5 pr6|pr5_save,* 012205 aa 1 00001 7101 00 1796 tra pr1|1 return to cobol program 1797 " 1798 " 1799 " 1800 " 1801 1802 " **************************************** 1803 " 1804 " The following operators are used for sort interface. 1805 " 1806 " **************************************** 1807 " 1808 1809 1810 " 1811 " The operator for sort_commence 1812 " **********OPERATOR(22)********** 1813 " 1814 " 012206 1815 sort_commence: 012206 1816 inhibit on 012206 aa 6 00101 7403 00 1817 stx0 pr6|return_to_main_off 012207 1818 inhibit off 1819 " RTS(7) 012207 aa 000007 2350 07 1820 lda 7,dl load rts_code 012210 aa 6 00110 7551 00 1821 sta pr6|rts_code 012211 0a 012214 3500 00 1822 epp0 return_from_sort_commence set the return_ptr to special location 012212 aa 6 00024 2501 00 1823 spri0 pr6|stack_frame.return_ptr 012213 0a 000336 7100 00 1824 tra call_rts_from_op 1825 even 012214 1826 return_from_sort_commence: 012214 aa 6 00120 2341 00 1827 szn pr6|80 check the status code 012215 0a 012307 6000 00 1828 tze sort_good return to good sort label 012216 aa 000070 2350 07 1829 lda 56,dl lda the error code and store 012217 aa 6 00131 7551 00 1830 sta pr6|89 012220 0a 012132 7100 00 1831 tra cobol_error_53 1832 " 1833 " The operator for sort release 1834 " pr3 for the address od the data to be released 1835 " Q for the length of the data in bytes. 1836 " **********OPERATOR(11)********** 012221 1837 sort_release: 012221 1838 inhibit on 012221 aa 6 00101 7403 00 1839 stx0 pr6|return_to_main_off 012222 1840 inhibit off 012222 aa 6 00112 2535 00 1841 spri3 pr6|74 store the data pointer 012223 aa 6 00114 7561 00 1842 stq pr6|76 store the length of the data 1843 " RTS(4) 012224 aa 000004 2350 07 1844 lda 4,dl store the rts_code 012225 aa 6 00110 7551 00 1845 sta pr6|rts_code 012226 0a 012232 3500 00 1846 epp0 return_from_sort_release set the return_ptr to special location 012227 aa 6 00024 2501 00 1847 spri0 pr6|stack_frame.return_ptr 012230 0a 000336 7100 00 1848 tra call_rts_from_op 012231 aa 000000 0110 03 1849 even 012232 1850 return_from_sort_release: 012232 aa 6 00120 2341 00 1851 szn pr6|80 check the status code 012233 0a 012307 6000 00 1852 tze sort_good return to good sort label 012234 aa 000064 2350 07 1853 lda 52,dl lda the error code and store 012235 aa 6 00131 7551 00 1854 sta pr6|89 012236 0a 012132 7100 00 1855 tra cobol_error_53 1856 " 1857 " 1858 " **********OPERATOR(13)********** 1859 " 1860 " 14 words in stack are needed 1861 " 012237 1862 sort_return: 012237 1863 inhibit on 012237 aa 6 00101 7403 00 1864 stx0 pr6|return_to_main_off 012240 1865 inhibit off 1866 " RTS(5) 012240 aa 000005 2350 07 1867 lda 5,dl load the rts_code 012241 aa 6 00110 7551 00 1868 sta pr6|rts_code 012242 0a 012246 3500 00 1869 epp0 return_from_sort_return lda the error code and store 012243 aa 6 00024 2501 00 1870 spri0 pr6|stack_frame.return_ptr 012244 0a 000336 7100 00 1871 tra call_rts_from_op 1872 " 1873 " 012245 aa 000000 0110 03 1874 even 012246 1875 return_from_sort_return: 012246 aa 6 00120 2351 00 1876 lda pr6|80 check the status code 012247 0a 012307 6000 00 1877 tze sort_good return to good sort label 012250 aa 000065 2350 07 1878 lda 53,dl load the error code 012251 aa 6 00131 7551 00 1879 sta pr6|89 012252 0a 012132 7100 00 1880 tra cobol_error_53 1881 " 1882 " 1883 " 1884 " 1885 " The operator for the sort initiate. 1886 " It needs the following parameters: 1887 " pr3 for compare entry ptr 1888 " pr7 for sort_$noexit 1889 " x2 for the stack offset 1890 " 14 word are used to set up parameter list for soit exit. 1891 " 1892 " **********OPERATOR(14)********** 012253 1893 sort_initiate: 012253 1894 sort_exit: 012253 1895 inhibit on 012253 aa 6 00101 7403 00 1896 stx0 pr6|return_to_main_off 012254 1897 inhibit off 012254 aa 000000 1020 03 1898 cmpx2 0,du check same sort merge possibility 012255 aa 000005 6050 04 1899 tpl 5,ic 012256 aa 6 00154 3501 20 1900 epp0 pr6|pr4_save,* 012257 aa 0 00051 7421 00 1901 stx2 pr0|41 complement x2 012260 aa 0 00051 3221 00 1902 lcx2 pr0|41 012261 aa 0 00051 4501 00 1903 stz pr0|41 for sort 012262 aa 6 00002 2535 12 1904 spri3 pr6|2,2 store the compare entry 012263 0a 004002 2370 00 1905 ldaq null_con 012264 aa 6 00004 7571 12 1906 staq pr6|4,2 012265 aa 6 00000 4501 12 1907 stz pr6|0,2 store 1 in the version number 012266 aa 6 00000 0541 12 1908 aos pr6|0,2 012267 aa 6 00000 3535 12 1909 epp3 pr6|0,2 get pointer for the exit ptr 1910 " 012270 1911 sort_initiate_call: 012270 aa 6 00112 2535 00 1912 spri3 pr6|74 store the exit_ptr into the argument 012271 0a 012302 3500 00 1913 epp0 return_from_sort_init set the return_ptr to special location 012272 aa 6 00024 2501 00 1914 spri0 pr6|stack_frame.return_ptr 1915 " RTS(3) 012273 aa 000003 2350 07 1916 lda 3,dl load the rts_code 012274 aa 6 00110 7551 00 1917 sta pr6|rts_code 012275 aa 6 00154 3501 20 1918 epp0 pr6|pr4_save,* 012276 aa 0 00012 3501 20 1919 epp0 pr0|control_ptr,* 012277 aa 6 00114 2501 00 1920 spri0 pr6|76 012300 0a 000336 7100 00 1921 tra call_rts_from_op 012301 aa 000000 0110 03 1922 even 012302 1923 return_from_sort_init: 012302 aa 6 00120 2341 00 1924 szn pr6|80 check the status code 012303 0a 012307 6000 00 1925 tze sort_good return to good sort label 012304 aa 000067 2350 07 1926 lda 55,dl lda the error code and store 012305 aa 6 00131 7551 00 1927 sta pr6|89 012306 0a 012132 7100 00 1928 tra cobol_error_53 1929 1930 " 1931 " 1932 " For good sort result, skip the retry instruction. 1933 " 012307 1934 sort_good: 012307 aa 000001 2350 03 1935 lda 1,du 012310 aa 6 00101 0551 00 1936 asa pr6|return_to_main_off 012311 0a 000330 7100 00 1937 tra return_to_reset 1938 " 1939 " 1940 " Establish the cleanup handler for sort. 1941 " The cobol_rts_handler_ is called to call sort_$terminate. 1942 " 1943 " **********OPERATOR(16)********** 012312 1944 establish_cleanup: 012312 1945 inhibit on 012312 aa 6 00101 7403 00 1946 stx0 pr6|return_to_main_off 012313 1947 inhibit off 012313 aa 6 00046 3515 70 1948 epp1 pr6|text_base_ptr,*0 get the return location 012314 aa 000100 2350 07 1949 lda =o100,dl check the condition bit 012315 aa 6 00020 3151 00 1950 cana pr6|stack_frame.condition_word 012316 aa 000003 6010 04 1951 tnz 3,ic some conditions are on 012317 aa 6 00036 4501 00 1952 stz pr6|stack_frame.on_unit_rel_ptrs zero out the condition offset 012320 aa 6 00020 2551 00 1953 orsa pr6|stack_frame.condition_word set the condition bit 012321 aa 6 00036 2201 00 1954 ldx0 pr6|stack_frame.on_unit_rel_ptrs get the last condition 012322 aa 000004 6000 04 1955 tze 4,ic no condition 012323 aa 6 00036 2211 00 1956 ldx1 pr6|stack_frame.on_unit_rel_ptrs get the last condition 012324 aa 000012 0610 04 1957 adx1 10,ic 10 words for the last condition 012325 aa 000002 7100 04 1958 tra 2,ic 012326 aa 000166 2210 03 1959 ldx1 118,du it is the 1st cond. Put it in pr6|118 012327 aa 6 00005 7401 11 1960 stx0 pr6|on_unit.next,1 reset this as the last cond 012330 aa 6 00036 7411 00 1961 stx1 pr6|stack_frame.on_unit_rel_ptrs 012331 0a 004147 3520 00 1962 epp2 sort_con+1 store the name cleanup 012332 aa 6 00000 2521 11 1963 spri2 pr6|on_unit.name,1 012333 aa 6 00154 3701 20 1964 epp4 pr6|pr4_save,* load pr4 012334 aa 4 00012 3535 20 1965 epp3 pr4|control_ptr,* get control_seg 012335 aa 3 00056 3535 20 1966 epp3 pr3|46,* get cobol_rts_handler_ 012336 aa 6 00002 2535 11 1967 spri3 pr6|on_unit.body,1 store into the condition body 012337 aa 000007 2350 07 1968 lda 7,dl store the length 012340 aa 6 00004 7551 11 1969 sta pr6|on_unit.size,1 012341 aa 000000 7200 07 1970 lxl0 0,dl no flag 012342 aa 6 00005 4401 11 1971 sxl0 pr6|on_unit.flags,1 012343 0a 012402 7100 00 1972 tra return_cond 1973 " 1974 " The operator for calling the sort_$terminate 1975 " 1976 " **********OPERATOR(17)********** 012344 1977 sort_terminate: 012344 1978 inhibit on 012344 aa 6 00101 7403 00 1979 stx0 pr6|return_to_main_off 012345 1980 inhibit off 012345 aa 6 00112 4501 00 1981 stz pr6|74 zero out the status code. It is needed, unfortunately 1982 " RTS(6) 012346 aa 000006 2350 07 1983 lda 6,dl load the rts_code 012347 aa 6 00110 7551 00 1984 sta pr6|rts_code 012350 0a 012354 3500 00 1985 epp0 return_from_sort_term set the return_ptr to special location 012351 aa 6 00024 2501 00 1986 spri0 pr6|stack_frame.return_ptr 012352 0a 000336 7100 00 1987 tra call_rts_from_op 012353 aa 000000 0110 03 1988 even 012354 1989 return_from_sort_term: 012354 aa 6 00112 2351 00 1990 lda pr6|74 check the status code 012355 0a 000330 6000 00 1991 tze return_to_reset 012356 aa 6 00120 7551 00 1992 sta pr6|80 012357 aa 000066 2350 07 1993 lda 54,dl lda the error code and store 012360 aa 6 00131 7551 00 1994 sta pr6|89 012361 0a 012132 7100 00 1995 tra return_from_term 1996 " 1997 " 1998 " The operator for reverting the cleanup condition. 1999 " 2000 " **********OPERATOR(18)********** 012362 2001 revert_cleanup: 012362 2002 inhibit on 012362 aa 6 00101 7403 00 2003 stx0 pr6|return_to_main_off 012363 2004 inhibit off 012363 aa 6 00046 3515 70 2005 epp1 pr6|text_base_ptr,*0 store the return_ptr in pr1 012364 aa 6 00000 3731 00 2006 epbp7 pr6|0 pr7 for stack header 012365 aa 6 00166 3501 00 2007 epp0 pr6|118 first condition start from pr6|118 012366 0a 004147 3520 00 2008 epp2 sort_con+1 get the cleanup character string 012367 aa 000007 6260 00 2009 eax6 7 7 characters 012370 0a 012406 7070 00 2010 tsx7 find_unit 2011 " unit found null out the current condition 012371 aa 6 00004 4501 11 2012 stz pr6|on_unit.size,1 start searching 012372 0a 004002 2370 00 2013 ldaq null_con 012373 aa 6 00000 7571 11 2014 staq pr6|on_unit.name,1 012374 aa 6 00002 7571 11 2015 staq pr6|on_unit.body,1 2016 " If this is the first unit then reset pr6|stack_frame.on_unit_rel_ptrs 012375 aa 000000 6350 11 2017 eaa 0,1 012376 aa 6 00036 1151 00 2018 cmpa pr6|stack_frame.on_unit_rel_ptrs 012377 0a 012402 6010 00 2019 tnz return_cond 012400 aa 6 00005 2211 11 2020 ldx1 pr6|on_unit.next,1 012401 aa 6 00036 7411 00 2021 stx1 pr6|stack_frame.on_unit_rel_ptrs 2022 " restore pr0, pr3 and pr4 012402 2023 return_cond: 012402 aa 6 00030 3501 20 2024 epp0 pr6|stack_frame.operator_ptr,* 012403 aa 6 00044 3701 20 2025 epp4 pr6|linkage_ptr,* 012404 aa 6 00156 3535 20 2026 epp3 pr6|pr3_save,* 012405 aa 1 00000 7101 00 2027 tra pr1|0 2028 " This subroutine tries to find the unit for the given condition. 2029 012406 2030 find_unit: 012406 aa 000100 2350 07 2031 lda stack_frame.condition_bit,dl make sure this is a condition stack 012407 aa 6 00020 3151 00 2032 cana sp|stack_frame.condition_word .. 012410 0a 012413 6010 00 2033 tnz get_length .. 012411 aa 6 00036 4501 00 2034 stz sp|stack_frame.on_unit_rel_ptrs .. 012412 aa 6 00020 2551 00 2035 orsa sp|stack_frame.condition_word .. 012413 2036 get_length: 012413 aa 000000 6350 16 2037 eaa 0,6 get length of name in chars 012414 0a 012402 6000 00 2038 tze return_cond if zero then done 012415 aa 000024 7330 00 2039 lrs 20 convert to words 012416 aa 000000 6260 05 2040 eax6 0,al place number of words in x6 012417 aa 000020 7720 00 2041 qrl 16 get extra chars 012420 aa 000001 6250 02 2042 eax5 1,qu place extra chars in x5 012421 2043 previous_char: 012421 aa 777777 6250 15 2044 eax5 -1,5 reduce chars by 1 012422 0a 012426 6010 00 2045 tnz next_word have we gone over word boundary 012423 aa 777777 6260 16 2046 eax6 -1,6 if so reduce number of words 012424 0a 012402 6040 00 2047 tmi return_cond name of all blanks 012425 aa 000004 6250 00 2048 eax5 4 have four chars in new word 012426 2049 next_word: 012426 aa 2 00000 2351 16 2050 lda bp|0,6 get word and check for blanks 012427 0a 012457 2360 15 2051 ldq masks1-1,5 .. 012430 0a 012457 2110 00 2052 cmk blanks .. 012431 0a 012421 6000 00 2053 tze previous_char if blank reduce length by 1 012432 aa 6 00036 2211 00 2054 ldx1 sp|stack_frame.on_unit_rel_ptrs get offset of first on unit 012433 0a 012435 7100 00 2055 tra next_length .. 012434 2056 next_on_unit: 012434 aa 6 00005 2211 11 2057 ldx1 sp|on_unit.next,1 get offset of next on unit 012435 2058 next_length: 012435 0a 012402 6000 00 2059 tze return_cond cannot find unit 012436 aa 000000 6350 16 2060 eaa 0,6 compute length of name 012437 aa 000020 7310 00 2061 ars 16 .. 012440 0a 012467 0750 15 2062 ada char_count-1,5 .. 012441 aa 6 00004 1151 11 2063 cmpa sp|on_unit.size,1 are names the same length 012442 0a 012434 6010 00 2064 tnz next_on_unit if not go to next on unit 012443 aa 6 00000 3701 31 2065 epplp sp|on_unit.name,1* get pointer to name for this unit 012444 aa 2 00000 2351 16 2066 lda bp|0,6 compare extra chars 012445 0a 012463 2360 15 2067 ldq masks2-1,5 .. 012446 aa 4 00000 2111 16 2068 cmk lp|0,6 .. 012447 0a 012434 6010 00 2069 tnz next_on_unit no match, try next 012450 aa 000000 6240 16 2070 eax4 0,6 compare rest of name 012451 2071 compare_next_word: 012451 aa 777777 6240 14 2072 eax4 -1,4 .. 012452 aa 000000 6040 17 2073 tmi 0,7 match, we are done 012453 aa 2 00000 2351 14 2074 lda bp|0,4 .. 012454 aa 4 00000 1151 14 2075 cmpa lp|0,4 .. 012455 0a 012451 6000 00 2076 tze compare_next_word .. 012456 0a 012434 7100 00 2077 tra next_on_unit no match, try next 2078 012457 aa 040 040 040 040 2079 blanks: aci " " word of blanks 012460 aa 000777 777777 2080 masks1: oct 000777777777 masks for lookin at individual chars 012461 aa 777000 777777 2081 oct 777000777777 012462 aa 777777 000777 2082 oct 777777000777 012463 aa 777777 777000 2083 oct 777777777000 012464 aa 000777 777777 2084 masks2: oct 000777777777 masks for comparing strings 012465 aa 000000 777777 2085 oct 000000777777 012466 aa 000000 000777 2086 oct 000000000777 012467 aa 000000 000000 2087 oct 000000000000 012470 2088 char_count: 012470 aa 000000 000001 2089 oct 1 number of chars in last word 012471 aa 000000 000002 2090 oct 2 012472 aa 000000 000003 2091 oct 3 012473 aa 000000 000004 2092 oct 4 2093 2094 " 2095 " 2096 " This operator is called from sort_gen to set up parameter for compare 2097 " procedure. 2098 " 2099 " **********OPERATOR(19)********** 012474 2100 sort_comp: 012474 2101 inhibit on 012474 aa 6 00101 7403 00 2102 stx0 pr6|return_to_main_off 012475 2103 inhibit off 012475 aa 6 00032 3735 20 2104 epp7 pr6|stack_frame.arg_ptr,* get the argument pointer 012476 aa 7 00004 3521 20 2105 epp2 pr7|4,* pr2 for second operand 012477 aa 7 00002 3515 20 2106 epp1 pr7|2,* pr1 for first operand 012500 aa 2 00000 3521 20 2107 epp2 pr2|0,* 012501 aa 1 00000 3515 20 2108 epp1 pr1|0,* 012502 aa 7 00006 4501 20 2109 stz pr7|6,* prestore 0 for equal compare 012503 aa 6 00046 7101 70 2110 tra pr6|text_base_ptr,*0 2111 " 2112 " 2113 " The operator for calling the pl1 operator real_to_real. 2114 " This operator is used for exponential computation. 2115 " 2116 " 2117 " **********OPERATOR(15)********** 012504 2118 real_to_real: 012504 2119 inhibit on 012504 aa 6 00101 7403 00 2120 stx0 pr6|return_to_main_off 012505 2121 inhibit off 012505 0a 000000 3500 00 2122 epp0 cobol_operators_ reset text_base_ptr to cobol_operators_ 012506 aa 6 00046 2501 00 2123 spri0 pr6|text_base_ptr 012507 aa 6 00000 3505 00 2124 epbp0 pr6|0 012510 aa 0 00034 3501 20 2125 epp0 pr0|28,* 012511 0a 000316 6200 00 2126 eax0 return_from_pl1_op rest x0 befor transfer to pl1_operators_ 012512 aa 0 01254 7101 00 2127 tra pr0|684 2128 " 2129 " 2130 2131 " **************************************** 2132 " 2133 " This page is for merge statement interface 2134 " 2135 " **************************************** 2136 " 2137 " merge_init **********OPERATOR(60)********** 2138 " 2139 " Input: x2 for merge stack offset 2140 " x3 for no of using files 2141 " pr3 for compare entry 012513 2142 merge_init: 012513 2143 inhibit on 012513 aa 6 00101 7403 00 2144 stx0 pr6|return_to_main_off 012514 2145 inhibit off 012514 aa 000000 1020 03 2146 cmpx2 0,du check same sort merge possibility 012515 aa 000004 6050 04 2147 tpl 4,ic 012516 aa 6 00154 3501 20 2148 epp0 pr6|pr4_save,* 012517 aa 0 00051 7421 00 2149 stx2 pr0|41 complement x2 012520 aa 0 00051 3221 00 2150 lcx2 pr0|41 012521 aa 6 00120 4501 00 2151 stz pr6|80 012522 aa 6 00120 4421 00 2152 sxl2 pr6|80 merge stack offset 012523 aa 6 00121 4501 00 2153 stz pr6|81 012524 aa 6 00121 4431 00 2154 sxl3 pr6|81 no of using files 012525 aa 6 00000 3521 12 2155 epp2 pr6|0,2 stack_off loaction 012526 aa 6 00122 2521 00 2156 spri2 pr6|82 012527 aa 000000 6360 13 2157 eaq 0,3 012530 aa 000001 7360 00 2158 qls 1 multiply by 2 and put into Q upper 012531 aa 2 00000 3521 02 2159 epp2 pr2|0,qu tree loaction 012532 aa 6 00124 2521 00 2160 spri2 pr6|84 012533 aa 2 00000 3521 02 2161 epp2 pr2|0,qu compare entry loaction 012534 aa 6 00126 2521 00 2162 spri2 pr6|86 012535 aa 6 00154 3501 20 2163 epp0 pr6|pr4_save,* 012536 aa 0 00012 3501 20 2164 epp0 pr0|control_ptr,* get controlp for temp dir 012537 aa 6 00130 2501 00 2165 spri0 pr6|88 012540 aa 2 00000 2535 00 2166 spri3 pr2|0 strore the compare entry 012541 0a 004002 2370 00 2167 ldaq null_con 012542 aa 2 00002 7571 00 2168 staq pr2|2 012543 aa 000036 2350 07 2169 lda 30,dl 012544 0a 000335 7100 00 2170 tra call_rts_load_code 2171 " 2172 " merge_comp **********OPERATOR(61)********** 2173 " 2174 " Input: none 2175 " 012545 2176 merge_comp: 012545 2177 inhibit on 012545 aa 6 00101 7403 00 2178 stx0 pr6|return_to_main_off 012546 2179 inhibit off 012546 aa 000037 2350 07 2180 lda 31,dl 012547 0a 000335 7100 00 2181 tra call_rts_load_code 2182 " 2183 " 2184 " merge_return **********OPERATOR(62)********** 2185 " 2186 "Input: none 2187 " 012550 2188 merge_return: 012550 2189 inhibit on 012550 aa 6 00101 7403 00 2190 stx0 pr6|return_to_main_off 012551 2191 inhibit off 012551 aa 000040 2350 07 2192 lda 32,dl 012552 0a 000335 7100 00 2193 tra call_rts_load_code 2194 " 2195 2196 " **********OPERATOR(24)********** 2197 " This page is for communication interface. 2198 " 2199 " **************************************** 2200 " 2201 " **********OPERATOR(70)********** 012553 2202 receive_comm: 012553 2203 inhibit on 012553 aa 6 00101 7403 00 2204 stx0 pr6|return_to_main_off 012554 2205 inhibit off 012554 aa 000050 2350 07 2206 lda 40,dl 012555 0a 000335 7100 00 2207 tra call_rts_load_code 2208 " 2209 " **********OPERATOR(71)********** 012556 2210 accept_comm: 012556 2211 inhibit on 012556 aa 6 00101 7403 00 2212 stx0 pr6|return_to_main_off 012557 2213 inhibit off 012557 aa 000051 2350 07 2214 lda 41,dl 012560 0a 000335 7100 00 2215 tra call_rts_load_code 2216 " 2217 " **********OPERATOR(72)********** 012561 2218 purge_comm: 012561 2219 inhibit on 012561 aa 6 00101 7403 00 2220 stx0 pr6|return_to_main_off 012562 2221 inhibit off 012562 aa 000052 2350 07 2222 lda 42,dl 012563 0a 000335 7100 00 2223 tra call_rts_load_code 2224 " 2225 " **********OPERATOR(73)********** 012564 2226 send_comm: 012564 2227 inhibit on 012564 aa 6 00101 7403 00 2228 stx0 pr6|return_to_main_off 012565 2229 inhibit off 012565 aa 000053 2350 07 2230 lda 43,dl 012566 0a 000335 7100 00 2231 tra call_rts_load_code 2232 " 2233 " **********OPERATOR(74)********** 012567 2234 enable_comm: 012567 2235 inhibit on 012567 aa 6 00101 7403 00 2236 stx0 pr6|return_to_main_off 012570 2237 inhibit off 012570 aa 000054 2350 07 2238 lda 44,dl 012571 0a 000335 7100 00 2239 tra call_rts_load_code 2240 " 2241 " **********OPERATOR(75)********** 012572 2242 disable_comm: 012572 2243 inhibit on 012572 aa 6 00101 7403 00 2244 stx0 pr6|return_to_main_off 012573 2245 inhibit off 012573 aa 000055 2350 07 2246 lda 45,dl 012574 0a 000335 7100 00 2247 tra call_rts_load_code 2248 " 2249 2250 " **************************************** 2251 2252 " 2253 " This page is for low used general operators. 2254 " 2255 " **************************************** 2256 2257 " 2258 " 2259 " 2260 " 2261 " 2262 " The operator for managing the files within OPEN and CLOSE. 2263 " X5 set to 2*no_of_files 2264 " X6 set to 2*file_no 2265 " 2266 " 2267 " **********OPERATOR(24)********** 012575 2268 set_lin_file_status: 012575 2269 inhibit on 012575 aa 6 00101 7403 00 2270 stx0 pr6|return_to_main_off 012576 2271 inhibit off 012576 aa 6 00056 4501 00 2272 stz pr6|46 zero work area 012577 aa 6 00056 0541 00 2273 aos pr6|46 set init linage counter to 1. 012600 aa 0 00100 3015 00 2274 btd (pr),(pr) 012601 aa 600056 000004 2275 desc9a pr6|46,4 012602 aa 100130 030006 2276 desc9ns pr1|88,6,0 012603 aa 1 00136 2351 00 2277 lda pr1|94 get TOP value 012604 aa 012140 1004 04 2278 mlr (ic),(pr,rl),fill(012) 012605 aa 777777 000000 2279 desc9a -1,0 012606 aa 500000 000005 2280 desc9a pr5|0,al 012607 aa 6 00120 7551 00 2281 sta pr6|80 set length value 012610 aa 6 00144 7461 00 2282 stx6 pr6|x6_save [3.0-1] 012611 aa 0 00566 7061 00 2283 tsx6 pr0|subr_put_chars [3.0-1] 012612 aa 6 00144 2261 00 2284 ldx6 pr6|x6_save [3.0-1] 012613 aa 6 00126 3515 20 2285 epp1 pr6|86,* 012614 aa 6 00156 3535 20 2286 epp3 pr6|pr3_save,* 2287 " 2288 " **********OPERATOR(25)********** 2289 " 2290 " 012615 2291 set_file_status: 012615 2292 inhibit on 012615 aa 6 00101 7403 00 2293 stx0 pr6|return_to_main_off 012616 2294 inhibit off 012616 aa 6 00154 3701 20 2295 epp4 pr6|pr4_save,* load static data pointer 012617 aa 4 00014 2371 00 2296 ldaq pr4|file_info_ptr 012620 0a 004002 6770 00 2297 eraq null_con 012621 0a 004004 3770 00 2298 anaq mask_con 012622 aa 000023 6010 04 2299 tnz 19,ic 012623 aa 4 00012 3521 20 2300 epp2 pr4|control_ptr,* 012624 aa 303240 0520 03 2301 adwp2 100000,du 012625 aa 2 00000 2341 00 2302 szn pr2|0 012626 aa 000004 6010 04 2303 tnz 4,ic 012627 aa 2 00000 2521 00 2304 spri2 pr2|0 012630 aa 000002 2350 03 2305 lda 2,du 012631 aa 2 00001 0551 00 2306 asa pr2|1 012632 aa 2 00000 2371 00 2307 ldaq pr2|0 012633 aa 4 00014 7571 00 2308 staq pr4|file_info_ptr 012634 aa 000002 2240 03 2309 ldx4 2,du 012635 aa 2 00001 0441 00 2310 asx4 pr2|1 012636 aa 2 00001 0451 00 2311 asx5 pr2|1 012637 aa 4 00014 3521 20 2312 epp2 pr4|file_info_ptr,* 012640 aa 2 00000 4451 00 2313 sxl5 pr2|0 012641 0a 004002 2370 00 2314 ldaq null_con 012642 aa 2 00000 7571 15 2315 staq pr2|0,5 012643 aa 000002 1650 03 2316 sbx5 2,du 012644 aa 777776 6010 04 2317 tnz -2,ic 012645 aa 4 00014 3521 20 2318 epp2 pr4|file_info_ptr,* 012646 aa 2 00000 2515 16 2319 spri1 pr2|0,6 012647 aa 6 00044 3701 20 2320 epp4 pr6|linkage_ptr,* 012650 aa 6 00046 7101 70 2321 tra pr6|text_base_ptr,*0 2322 2323 " 2324 " 2325 " 2326 " **********OPERATOR(27)********** 2327 " This operator handles the FILE CLOSE and DETACH. 2328 " 2329 " 012651 2330 close_file: 012651 2331 inhibit on 012651 aa 6 00101 7403 00 2332 stx0 pr6|return_to_main_off 012652 2333 inhibit off 012652 aa 6 00126 2515 00 2334 spri1 pr6|86 store iocb ptr 012653 aa 0 13364 7061 00 2335 tsx6 pr0|subr_close_file 012654 0a 000330 7100 00 2336 tra return_to_reset 2337 "[3.0-1] 2338 "[3.0-1] alt_close_file **********OPERATOR(89)********** 2339 "[3.0-1] 2340 "[3.0-1] 012655 2341 alt_close_file: 012655 2342 inhibit on 012655 aa 6 00101 7403 00 2343 stx0 pr6|return_to_main_off 012656 2344 inhibit off 2345 " 012656 aa 6 00120 6535 00 2346 spri7 pr6|80 set file desc ptr 2347 " 012657 aa 000057 2350 07 2348 lda 47,dl RTS(47) 012660 aa 6 00110 7551 00 2349 sta pr6|rts_code set fields in FSB 012661 0a 012664 3500 00 2350 epp0 return_from_alt_close 012662 aa 6 00024 2501 00 2351 spri0 pr6|stack_frame.return_ptr 012663 0a 000336 7100 00 2352 tra call_rts_from_op 2353 " 012664 2354 return_from_alt_close: 012664 0a 000330 7100 00 2355 tra return_to_reset 2356 " 2357 " 2358 " **********OPERATOR(38)********** 2359 " This operator handles the FILE CLOSE only NO detach 2360 " 2361 " 012665 2362 close_file_only: 012665 2363 inhibit on 012665 aa 6 00101 7403 00 2364 stx0 pr6|return_to_main_off 012666 2365 inhibit off 012666 aa 6 00126 2515 00 2366 spri1 pr6|86 012667 aa 0 13473 7061 00 2367 tsx6 pr0|subr_close_file_only 012670 aa 6 00126 3515 20 2368 epp1 pr6|86,* reset pr 1 to fsb 012671 aa 1 00002 4501 00 2369 stz pr1|2 reset open mode 012672 0a 000330 7100 00 2370 tra return_to_reset 2371 " 2372 " 2373 " 2374 " **********OPERATOR(43)********** 2375 " This operator is for stop literal code to call cu_$cl 2376 " 012673 2377 stop_literal: 012673 2378 inhibit on 012673 aa 6 00101 7403 00 2379 stx0 pr6|return_to_main_off 012674 2380 inhibit off 2381 " RTS(8) 012674 aa 000010 2350 07 2382 lda 8,dl 012675 aa 6 00110 7551 00 2383 sta pr6|rts_code 012676 0a 000336 7100 00 2384 tra call_rts_from_op 2385 " 2386 " **********OPERATOR(48)********** 2387 " This operator is for "stop run" code to call cobol_stoprun_ 2388 " 012677 2389 stop_run: 012677 2390 inhibit on 012677 aa 6 00101 7403 00 2391 stx0 pr6|return_to_main_off 012700 2392 inhibit off 012700 aa 6 00154 3701 20 2393 epp4 pr6|pr4_save,* load pr4 012701 aa 4 00044 7571 00 2394 staq pr4|36 store the line number 2395 " RTS(9) 012702 aa 000011 2350 07 2396 lda 9,dl load the rts_code 012703 aa 6 00110 7551 00 2397 sta pr6|rts_code 012704 0a 000336 7100 00 2398 tra call_rts_from_op 2399 " 2400 " **********OPERATOR(94)********** [4.4-3] 2401 " This operator is for "stop run" code to call cobol_stoprun_ if CD INITIAL used 2402 " 012705 2403 stop_cd_run: 012705 2404 inhibit on 012705 aa 6 00101 7403 00 2405 stx0 pr6|return_to_main_off 012706 2406 inhibit off 012706 aa 6 00154 3701 20 2407 epp4 pr6|pr4_save,* load pr4 012707 aa 4 00044 7571 00 2408 staq pr4|36 save the line number 2409 " RTS(62) 012710 aa 000076 2350 07 2410 lda 62,dl load the rts code 012711 aa 6 00110 7551 00 2411 sta pr6|rts_code 012712 0a 000336 7100 00 2412 tra call_rts_from_op 2413 " 2414 " 2415 " the cancel operator used to call cobol_cantrol_$cancel. 2416 " 2417 " **********OPERATOR(49)********** 012713 2418 cancel: 012713 2419 inhibit on 012713 aa 6 00101 7403 00 2420 stx0 pr6|return_to_main_off 012714 2421 inhibit off 012714 aa 6 00112 2535 00 2422 spri3 pr6|74 store the name 012715 aa 6 00114 7551 00 2423 sta pr6|76 store the name length 2424 " RTS(10) 012716 aa 000012 2350 07 2425 lda 10,dl load the rts_code 012717 aa 6 00110 7551 00 2426 sta pr6|rts_code 012720 0a 000336 7100 00 2427 tra call_rts_from_op 2428 " 2429 " The operator for calling cobol_su_$tally and cobol_su_$replace. 2430 " 2431 " **********OPERATOR(51)********** 012721 2432 inspect_replace: 012721 2433 inhibit on 012721 aa 6 00101 7403 00 2434 stx0 pr6|return_to_main_off 012722 2435 inhibit off 012722 aa 000030 2350 07 2436 lda 24,dl 012723 aa 000003 7100 04 2437 tra 3,ic 2438 " 2439 " **********OPERATOR(50)********** 2440 " 012724 2441 inspect_tally: 012724 2442 inhibit on 012724 aa 6 00101 7403 00 2443 stx0 pr6|return_to_main_off 012725 2444 inhibit off 2445 " RTS(23) 012725 aa 000027 2350 07 2446 lda 23,dl 012726 aa 6 00112 2521 00 2447 spri2 pr6|74 load tally pointer 012727 aa 6 00110 7551 00 2448 sta pr6|rts_code load the rts_code 012730 0a 000336 7100 00 2449 tra call_rts_from_op 2450 " 2451 " **********OPERATOR(12)********** 2452 " 2453 " 2454 " **********OPERATOR(77)********** 2455 " The operator for initialize cd token (77) 2456 " 012731 2457 init_cd: 012731 2458 inhibit on 012731 aa 6 00101 7403 00 2459 stx0 pr6|return_to_main_off 012732 2460 inhibit off 012732 aa 6 00032 3521 20 2461 epp2 pr6|26,* 012733 aa 2 00000 2211 00 2462 ldx1 pr2|0 012734 0a 012742 6000 00 2463 tze init_cd_space 012735 aa 2 00000 3521 31 2464 epp2 pr2|0,1* 012736 aa 0 00100 1005 00 2465 mlr (pr),(pr) 012737 aa 200000 000060 2466 desc9a pr2|0,48 012740 aa 100000 000060 2467 desc9a pr1|0,48 012741 aa 6 00046 7101 70 2468 tra pr6|text_base_ptr,*0 012742 2469 init_cd_space: 012742 aa 040100 1004 00 2470 mlr (0),(pr),fill(040) 012743 aa 000000 000000 2471 desc9a 0,0 012744 aa 100000 000060 2472 desc9a pr1|0,48 012745 aa 6 00046 7101 70 2473 tra pr6|text_base_ptr,*0 2474 " 2475 " 2476 " 2477 " The operator for the runtime_check option. 2478 " 012746 2479 pack_mask: 012746 aa 775777 777777 2480 oct 775777777777 012747 2481 desc_mask: 012747 aa 000000 100000 2482 oct 000000100000 012750 2483 runtime_check: 012750 2484 inhibit on 012750 aa 6 00101 7403 00 2485 stx0 pr6|return_to_main_off 012751 2486 inhibit off 012751 aa 6 00032 3715 20 2487 epp5 pr6|stack_frame.arg_ptr,* get arg_ptr from the caller 012752 aa 6 00026 3535 20 2488 epp3 pr6|stack_frame.entry_ptr,* get the stack_frame.entry for the callee 012753 aa 6 00050 4501 00 2489 stz pr6|mcode set the status code to 0. 012754 aa 6 00046 3501 20 2490 epp0 pr6|text_base_ptr,* load the text_base into pr0 012755 aa 3 77777 2351 00 2491 lda pr3|-1 012756 0a 012747 3750 00 2492 ana desc_mask check the descriptor bit 012757 aa 000003 6010 04 2493 tnz 3,ic 012760 aa 000000 2230 03 2494 ldx3 0,du 012761 aa 000004 7100 04 2495 tra 4,ic 012762 aa 3 77776 2211 00 2496 ldx1 pr3|-2 get the descr_relp_offset 012763 aa 0 00000 2231 11 2497 ldx3 pr0|0,1 obtain the number of arguments 012764 aa 000004 6010 04 2498 tnz 4,ic there are arguments 012765 aa 5 00000 1031 00 2499 cmpx3 pr5|0 check caller 012766 0a 000320 6000 00 2500 tze return_from_call both have no argument 012767 0a 012773 7100 00 2501 tra n_args_error caller has some arguments, call error routine 012770 aa 0 00000 0631 11 2502 adx3 pr0|0,1 double x3 to get 2*n_args 012771 aa 5 00000 1031 00 2503 cmpx3 pr5|0 compare n_args with the caller's 012772 aa 000003 6000 04 2504 tze 3,ic n_args equal, passed the first check 012773 2505 n_args_error: 012773 aa 010073 7270 07 2506 lxl7 4155,dl load the error_code 012774 0a 012054 7100 00 2507 tra cobol_error 012775 aa 5 00001 2221 00 2508 ldx2 pr5|1 load the desc_count 012776 aa 000000 1020 03 2509 cmpx2 0,du Is there descriptor? 012777 aa 000002 6010 04 2510 tnz 2,ic yes. check descriptors. 013000 0a 000320 7100 00 2511 tra return_from_call no. restore registers and back 013001 aa 6 00042 3521 20 2512 epp2 pr6|descriptor_ptr,* load descriptor_ptr for the caller 013002 aa 0 00000 3535 11 2513 epp3 pr0|0,1 find parm_desc_ptr for the caller 013003 aa 6 00112 7421 00 2514 stx2 pr6|74 013004 aa 000000 2250 03 2515 ldx5 0,du initialization for the loop 013005 aa 000000 2220 03 2516 ldx2 0,du 013006 aa 000000 2270 03 2517 ldx7 0,du 013007 2518 loop_compare: 013007 aa 000000 1070 03 2519 cmpx7 0,du 013010 0a 013013 6010 00 2520 tnz upper_half 013011 aa 3 00000 7211 15 2521 lxl1 pr3|0,5 013012 0a 013015 7100 00 2522 tra desc_join 013013 2523 upper_half: 013013 aa 000001 0650 03 2524 adx5 1,du next desc_relp in next word 013014 aa 3 00000 2211 15 2525 ldx1 pr3|0,5 obtain the next desc_relp for the caller 013015 2526 desc_join: 013015 aa 0 00000 3515 11 2527 epp1 pr0|0,1 013016 aa 2 00000 3715 32 2528 epp5 pr2|0,2* 013017 aa 1 77777 7231 00 2529 lxl3 pr1|-1 013020 2530 desc_loop: 013020 aa 000001 1630 03 2531 sbx3 1,du 013021 0a 013032 6040 00 2532 tmi desc_exit 013022 aa 1 00000 2351 13 2533 lda pr1|0,3 013023 0a 012746 3750 00 2534 ana pack_mask 013024 aa 6 00113 7551 00 2535 sta pr6|75 013025 aa 5 00000 2351 13 2536 lda pr5|0,3 013026 0a 012746 3750 00 2537 ana pack_mask 013027 aa 6 00113 1151 00 2538 cmpa pr6|75 013030 0a 013040 6010 00 2539 tnz desc_error not equal, call cobol_error_ 013031 0a 013020 7100 00 2540 tra desc_loop 013032 2541 desc_exit: 013032 aa 000002 0620 03 2542 adx2 2,du yes. get the next one 013033 aa 6 00112 1021 00 2543 cmpx2 pr6|74 more descriptor? 013034 0a 000320 6050 00 2544 tpl return_from_call no. back to main procedure 013035 aa 000001 0670 03 2545 adx7 1,du 013036 aa 000001 3670 03 2546 anx7 1,du 013037 0a 013007 7100 00 2547 tra loop_compare back to loop 013040 2548 desc_error: 013040 aa 010074 2270 03 2549 ldx7 4156,du load the error_code 013041 0a 012054 7100 00 2550 tra cobol_error call cobol_error_ 2551 " 2552 " 2553 2554 " 2555 " 2556 " open_ext_file **********OPERATOR(30)********** 2557 " 2558 " 013042 2559 open_ext_file: 013042 2560 inhibit on 013042 aa 6 00101 7403 00 2561 stx0 pr6|return_to_main_off 013043 2562 inhibit off 013043 aa 1 00132 2351 00 2563 lda pr1|90 if file LOCKed then don't OPEN. 013044 aa 020000 3750 03 2564 ana 8192,du 013045 0a 013054 6000 00 2565 tze cont_open_ext 2566 " set status 013046 0a 012003 2350 00 2567 lda io30_con 013047 0a 012006 2360 00 2568 ldq s1090con 013050 aa 6 00052 7571 00 2569 staq pr6|status12 013051 aa 000076 2210 03 2570 ldx1 62,du Attempt to OPEN a file closed with the LOCK option. 013052 aa 000001 0600 03 2571 adx0 1,du force skip over tra instr 013053 0a 013066 7100 00 2572 tra return_thru_text_base_pone 013054 2573 cont_open_ext: 013054 aa 6 00067 7551 00 2574 sta pr6|55 temp save A reg value 013055 aa 1 00002 2351 00 2575 lda pr1|2 013056 aa 6 00046 6045 70 2576 tmoz pr6|text_base_ptr,*0 minus or zero cont processing 013057 aa 6 00067 1151 00 2577 cmpa pr6|55 do the cobol modes match 013060 0a 013066 6000 00 2578 tze return_thru_text_base_pone YES 2579 " set status 013061 0a 012003 2350 00 2580 lda io30_con 013062 0a 012004 2360 00 2581 ldq s1032con 013063 aa 6 00052 7571 00 2582 staq pr6|status12 013064 aa 000010 2210 03 2583 ldx1 8,du attempt to open ext file already opened in inconsistent mode. 013065 aa 000001 0600 03 2584 adx0 1,du force skip over tra instruction 013066 2585 return_thru_text_base_pone: 013066 aa 000001 0600 03 2586 adx0 1,du skip one instruction 013067 aa 6 00046 7101 70 2587 tra pr6|text_base_ptr,*0 2588 " 2589 " 2590 " open_int_file cobol **********OPERATOR(31)********** 2591 " 2592 " 013070 2593 open_int_file: 013070 2594 inhibit on 013070 aa 6 00101 7403 00 2595 stx0 pr6|return_to_main_off 013071 2596 inhibit off 013071 aa 1 00132 2351 00 2597 lda pr1|90 if file LOCKed then don't OPEN. 013072 aa 020000 3750 03 2598 ana 8192,du 013073 0a 013101 6000 00 2599 tze cont_open_int 2600 " set status 013074 0a 012003 2350 00 2601 lda io30_con 013075 0a 012006 2360 00 2602 ldq s1090con 013076 aa 6 00052 7571 00 2603 staq pr6|status12 013077 aa 000076 2210 03 2604 ldx1 62,du Attempt to OPEN a file closed with the LOCK option. 013100 0a 013066 7100 00 2605 tra return_thru_text_base_pone 013101 2606 cont_open_int: 013101 aa 1 00002 2341 00 2607 szn pr1|2 013102 aa 6 00046 6001 70 2608 tze pr6|text_base_ptr,*0 2609 " set status 013103 0a 012003 2350 00 2610 lda io30_con 013104 0a 012005 2360 00 2611 ldq s1036con 013105 aa 6 00052 7571 00 2612 staq pr6|status12 013106 aa 000011 2210 03 2613 ldx1 9,du attempt to open int file already opened. 013107 0a 013066 7100 00 2614 tra return_thru_text_base_pone 2615 " 2616 " 2617 " find_iocb cobol **********OPERATOR(32)********** 2618 " A reg = length of switch name 2619 " X5 = stack offset value for ioname 2620 " 2621 " 013110 2622 find_iocb: 013110 2623 inhibit on 013110 aa 6 00101 7403 00 2624 stx0 pr6|return_to_main_off 013111 2625 inhibit off 013111 aa 6 00060 6521 00 2626 spri6 pr6|48 store stack_offset ptr for ioname 013112 aa 6 00062 6521 00 2627 spri6 pr6|50 013113 aa 6 00061 0651 00 2628 adx5 pr6|49 add base offset to x5 013114 aa 6 00061 7451 00 2629 stx5 pr6|49 set correct offset 013115 aa 000002 0650 03 2630 adx5 2,du 013116 aa 6 00063 7451 00 2631 stx5 pr6|51 013117 aa 6 00126 2515 00 2632 spri1 pr6|86 store pr1 013120 aa 6 00060 2515 20 2633 spri1 pr6|48,* store fsb pointer 013121 aa 6 00062 7551 20 2634 sta pr6|50,* store switch length 013122 aa 6 00050 3521 00 2635 epp2 pr6|40 013123 aa 6 00114 2521 00 2636 spri2 pr6|76 store mcode_ptr 2637 " 013124 aa 000016 2350 07 2638 lda 14,dl RTS(14) 013125 aa 6 00110 7551 00 2639 sta pr6|rts_code store rts_code 013126 0a 013131 3500 00 2640 epp0 return_find_iocb 013127 aa 6 00024 2501 00 2641 spri0 pr6|stack_frame.return_ptr 013130 0a 000336 7100 00 2642 tra call_rts_from_op iox_find_iocb 013131 2643 return_find_iocb: 013131 aa 6 00050 2341 00 2644 szn pr6|40 013132 0a 000330 6000 00 2645 tze return_to_reset 2646 " set status 013133 0a 012003 2350 00 2647 lda io30_con 013134 0a 012007 2360 00 2648 ldq s1193con 013135 aa 6 00052 7571 00 2649 staq pr6|status12 013136 aa 000007 2210 03 2650 ldx1 7,du unable to establish iocb 013137 0a 000326 7100 00 2651 tra io_return_to_reset 2652 " 2653 " check_attach cobol **********OPERATOR(33)********** 2654 " 013140 2655 check_attach: 013140 2656 inhibit on 013140 aa 6 00101 7403 00 2657 stx0 pr6|return_to_main_off 013141 2658 inhibit off 013141 aa 6 00126 3515 20 2659 epp1 pr6|86,* reset pr1 013142 aa 1 00000 3521 20 2660 epp2 pr1|0,* 013143 aa 2 00014 2371 00 2661 ldaq pr2|12 013144 0a 004002 6770 00 2662 eraq null_con 013145 0a 004004 3770 00 2663 anaq mask_con 2664 " [4.0-1] The following 7 lines are used to set a bit in the fsb if the 2665 " file is already attched otherwise the bit is zero 013146 aa 000004 6010 04 2666 tnz 4,ic transfer if already attached 013147 0a 012036 2350 00 2667 lda atd_con load zeroes 013150 aa 1 00127 5511 20 2668 stba pr1|87,20 store a byte of a into fsb 013151 0a 013066 7100 00 2669 tra return_thru_text_base_pone 013152 0a 014750 2350 00 2670 lda =o000400000000 load bit to be set 013153 aa 1 00127 5511 20 2671 stba pr1|87,20 store the set byte of a ino fsb 013154 aa 6 00046 6011 70 2672 tnz pr6|text_base_ptr,*0 2673 2674 " 2675 " 2676 " close_op_file cobol **********OPERATOR(29)********** 2677 " 2678 " 013155 2679 close_op_file: 013155 2680 inhibit on 013155 aa 6 00101 7403 00 2681 stx0 pr6|return_to_main_off 013156 2682 inhibit off 013156 aa 6 00054 7571 00 2683 staq pr6|44 save open mode & optional/opened bit 013157 aa 6 00056 4501 00 2684 stz pr6|46 013160 aa 6 00056 4451 00 2685 sxl5 pr6|46 store open mode(multics_mode) 013161 aa 6 00126 3515 20 2686 epp1 pr6|86,* 013162 aa 0 13473 7061 00 2687 tsx6 pr0|subr_close_file_only 013163 aa 6 00126 3515 20 2688 epp1 pr6|86,* 013164 aa 0 13266 7061 00 2689 tsx6 pr0|subr_open_file 013165 0a 013334 7100 00 2690 tra open_ok 2691 " 2692 " 2693 " attach_iocb cobol_ **********OPERATOR(34)********** 2694 " A reg = length of attach description 2695 " X5 = stack offset value for atd 2696 " 2697 " 013166 2698 attach_iocb: 013166 2699 inhibit on 013166 aa 6 00101 7403 00 2700 stx0 pr6|return_to_main_off 013167 2701 inhibit off 013167 aa 6 00126 3515 20 2702 epp1 pr6|86,* 013170 aa 6 00060 6521 00 2703 spri6 pr6|48 store stack offset for atd 013171 aa 6 00061 0651 00 2704 adx5 pr6|49 013172 aa 6 00061 7451 00 2705 stx5 pr6|49 013173 aa 000002 0650 03 2706 adx5 2,du 013174 aa 6 00063 7451 00 2707 stx5 pr6|51 013175 aa 6 00062 7551 20 2708 sta pr6|50,* store atd length 013176 aa 6 00050 3521 00 2709 epp2 pr6|40 013177 aa 6 00114 2521 00 2710 spri2 pr6|76 store mcode_ptr 2711 " RTS(15) 013200 aa 000017 2350 07 2712 lda 15,dl 013201 aa 6 00110 7551 00 2713 sta pr6|rts_code store rts_code 013202 0a 013206 3500 00 2714 epp0 return_attach_iocb 013203 aa 6 00024 2501 00 2715 spri0 pr6|stack_frame.return_ptr 013204 0a 000336 7100 00 2716 tra call_rts_from_op iox_$attach_iocb 013205 aa 000000 0110 03 2717 even 013206 2718 return_attach_iocb: 013206 aa 6 00050 2341 00 2719 szn pr6|40 013207 0a 000330 6000 00 2720 tze return_to_reset 2721 " set status 013210 0a 012003 2350 00 2722 lda io30_con 013211 0a 012010 2360 00 2723 ldq s1293con 013212 aa 6 00052 7571 00 2724 staq pr6|status12 013213 aa 000015 2210 03 2725 ldx1 13,du unable to attach IO switch. 013214 0a 000326 7100 00 2726 tra io_return_to_reset 2727 " 2728 " open_file cobol **********OPERATOR(35)********** 2729 " A reg = open mode 2730 " 013215 2731 open_file: 013215 2732 inhibit on 013215 aa 6 00101 7403 00 2733 stx0 pr6|return_to_main_off 013216 2734 inhibit off 013216 aa 6 00126 2515 00 2735 spri1 pr6|86 013217 aa 6 00054 7571 00 2736 staq pr6|44 save open mode & optional/opened bit 013220 aa 6 00056 4501 00 2737 stz pr6|46 013221 aa 6 00056 4451 00 2738 sxl5 pr6|46 store open mode(multics_mode) 013222 aa 1 00132 2351 00 2739 lda pr1|90 if file LOCKed then don't open , return 013223 aa 0 13266 7061 00 2740 tsx6 pr0|subr_open_file 013224 0a 013334 7100 00 2741 tra open_ok 2742 "[3.0-1] 2743 "[3.0-1] alt_open_file **********OPERATOR 78********** 2744 "[3.0-1] 2745 "[3.0-1] 013225 2746 alt_open_file: 013225 2747 inhibit on 013225 aa 6 00101 7403 00 2748 stx0 pr6|return_to_main_off 013226 2749 inhibit off 2750 " 013226 aa 6 00120 6535 00 2751 spri7 pr6|80 set file desc ptr 013227 aa 6 00050 3735 00 2752 epp7 pr6|mcode mcode_ptr 013230 aa 6 00114 6535 00 2753 spri7 pr6|76 013231 aa 6 00054 2351 00 2754 lda pr6|44 move cobol_open_mode to rts_ stack frame 013232 aa 6 00122 7551 00 2755 sta pr6|82 013233 aa 6 00056 2351 00 2756 lda pr6|46 move vfile_open_mode to rts_ stack frame 013234 aa 6 00124 7551 00 2757 sta pr6|84 2758 " 013235 aa 000056 2350 07 2759 lda 46,dl RTS(46) 013236 aa 6 00110 7551 00 2760 sta pr6|rts_code set fields in FSB 013237 0a 013242 3500 00 2761 epp0 return_from_alt_open 013240 aa 6 00024 2501 00 2762 spri0 pr6|stack_frame.return_ptr 013241 0a 000336 7100 00 2763 tra call_rts_from_op 2764 " 013242 2765 return_from_alt_open: 013242 0a 000330 7100 00 2766 tra return_to_reset 2767 " 2768 " 2769 " **********OPERATOR(36)********** 2770 " open close op no. 36 2771 " A reg = open mode 2772 " 2773 " 013243 2774 open_close_file: 013243 2775 inhibit on 013243 aa 6 00101 7403 00 2776 stx0 pr6|return_to_main_off 013244 2777 inhibit off 013244 aa 000011 2350 07 2778 lda 9,dl [3.0-1] 013245 aa 6 00056 7551 00 2779 sta pr6|46 [3.0-1] 013246 aa 6 00112 2515 00 2780 spri1 pr6|74 iocb_ptr 013247 aa 6 00126 2515 00 2781 spri1 pr6|86 fsb_ptr 013250 aa 0 13266 7061 00 2782 tsx6 pr0|subr_open_file 013251 aa 6 00126 3515 20 2783 epp1 pr6|86,* 013252 aa 0 13473 7061 00 2784 tsx6 pr0|subr_close_file_only 013253 0a 000330 7100 00 2785 tra return_to_reset 2786 " 2787 " **********OPERATOR(37)********** 2788 " check non cobol no. 37 2789 " 2790 " 013254 2791 check_file: 013254 2792 inhibit on 013254 aa 6 00101 7403 00 2793 stx0 pr6|return_to_main_off 013255 2794 inhibit off 013255 aa 6 00126 3515 20 2795 epp1 pr6|86,* reset pr1 013256 aa 1 00000 3521 20 2796 epp2 pr1|0,* 013257 aa 2 00020 2371 00 2797 ldaq pr2|16 iocb, open_descrip_ptr 013260 0a 004002 6770 00 2798 eraq null_con 013261 0a 004004 3770 00 2799 anaq mask_con 013262 0a 013066 6000 00 2800 tze return_thru_text_base_pone fall though to OPEN 013263 aa 777777 2350 03 2801 lda -1,du noncobol open status 013264 aa 1 00002 7551 00 2802 sta pr1|2 set fsb open mode 013265 aa 6 00046 7101 70 2803 tra pr6|text_base_ptr,*0 2804 " 2805 " 2806 " SUBROUTINE to open files 2807 " 2808 " 013266 2809 subr_open_file: 013266 aa 6 00153 7461 00 2810 stx6 pr6|subr_return_save_off save return offset within operators 013267 aa 6 00056 3521 00 2811 epp2 pr6|46 013270 aa 6 00130 2521 00 2812 spri2 pr6|88 store pointer to open mode 013271 aa 6 00057 4501 00 2813 stz pr6|47 013272 aa 6 00057 3521 00 2814 epp2 pr6|47 013273 aa 6 00132 2521 00 2815 spri2 pr6|90 unused 013274 aa 6 00050 3521 00 2816 epp2 pr6|40 013275 aa 6 00114 2521 00 2817 spri2 pr6|76 mcode_ptr 013276 aa 6 00134 2521 00 2818 spri2 pr6|92 store pointer to mcode 013277 aa 6 00124 6211 00 2819 eax1 pr6|84 013300 aa 020000 4310 07 2820 fld 8192,dl 4 args 013301 aa 1 00000 3521 20 2821 epp2 pr1|0,* indirect thru fsb to iocb 013302 aa 2 00032 3521 00 2822 epp2 pr2|26 offset for iox_$open 013303 0a 013306 3500 00 2823 epp0 return_from_open 013304 aa 6 00024 2501 00 2824 spri0 pr6|stack_frame.return_ptr 013305 0a 000143 7100 00 2825 tra call_ent_var_from_op 013306 2826 return_from_open: 013306 aa 6 00044 3701 20 2827 epp4 pr6|linkage_ptr,* 013307 aa 6 00050 2341 00 2828 szn pr6|40 013310 aa 6 00152 6001 20 2829 tze pr6|subr_return_save,* EXIT FROM SUBROUTINE 013311 aa 6 00126 3515 20 2830 epp1 pr6|86,* 013312 aa 1 00002 4501 00 2831 stz pr1|2 2832 " check if optional bit is on 013313 aa 6 00055 2351 00 2833 lda pr6|45 013314 0a 012040 1150 00 2834 cmpa optional_int 013315 aa 6 00152 6001 20 2835 tze pr6|subr_return_save,* EXIT FROM SUBR 013316 0a 012041 1150 00 2836 cmpa optional_ext 013317 aa 6 00152 6001 20 2837 tze pr6|subr_return_save,* EXIT FROM SUBR 2838 " set status RTS(13) 013320 aa 000015 2350 07 2839 lda 13,dl 013321 aa 6 00110 7551 00 2840 sta pr6|rts_code store rts(13) call 013322 aa 000017 2210 03 2841 ldx1 15,du set open error code 013323 0a 013326 3500 00 2842 epp0 return_from_open_rts 013324 aa 6 00024 2501 00 2843 spri0 pr6|stack_frame.return_ptr exit to main line +1 013325 0a 000336 7100 00 2844 tra call_rts_from_op 013326 2845 return_from_open_rts: 013326 aa 6 00044 3701 20 2846 epp4 pr6|linkage_ptr,* reset_linkage pointer 013327 aa 000017 2210 03 2847 ldx1 15,du 013330 0a 012011 2360 00 2848 ldq s1295con 013331 aa 6 00052 1161 00 2849 cmpq pr6|status12 013332 0a 000326 6010 00 2850 tnz io_return_to_reset 013333 aa 6 00152 7101 20 2851 tra pr6|subr_return_save,* EXIT FROM SUBROUTINE 013334 2852 open_ok: 013334 aa 6 00126 3515 20 2853 epp1 pr6|86,* reset pr 1 013335 aa 6 00050 2341 00 2854 szn pr6|40 013336 0a 013344 6000 00 2855 tze set_open_mode 013337 aa 6 00055 2351 00 2856 lda pr6|45 013340 0a 012040 1150 00 2857 cmpa optional_int 013341 0a 013346 6000 00 2858 tze skip_open_mode 013342 0a 012041 1150 00 2859 cmpa optional_ext 013343 0a 013346 6000 00 2860 tze skip_open_mode 013344 2861 set_open_mode: 013344 aa 6 00054 2351 00 2862 lda pr6|44 013345 aa 1 00002 7551 00 2863 sta pr1|2 cobol open mode 013346 2864 skip_open_mode: 013346 aa 6 00154 3701 20 2865 epp4 pr6|pr4_save,* load pr4 013347 aa 4 00022 7251 00 2866 lxl5 pr4|18 length of program name 013350 aa 0 40100 1005 40 2867 mlr (pr,rl),(pr),fill(040) 013351 aa 400023 000015 2868 desc9a pr4|19,x5 set name 013352 aa 100107 000101 2869 desc9a pr1|71,65 013353 aa 1 00006 4501 00 2870 stz pr1|6 set fsb.relkeylen to zero 013354 aa 0 60100 1005 00 2871 mlr (pr),(pr),fill(060) reset key on each open 013355 aa 000000 000000 2872 desc9a 0,0 013356 aa 100007 000020 2873 desc9a pr1|7,16 013357 0a 012037 2250 03 2874 ldx5 high_con,du set optional bit 013360 aa 1 00132 3451 00 2875 ansx5 pr1|90 013361 aa 6 00055 2251 00 2876 ldx5 pr6|45 set how opened bit 100000=ext 140000=int 013362 aa 1 00132 2451 00 2877 orsx5 pr1|90 opened bit 013363 0a 000330 7100 00 2878 tra return_to_reset 2879 " 2880 " 2881 " SUBROUTINE to close files 2882 " 2883 " 013364 2884 subr_close_file: 013364 aa 6 00153 7461 00 2885 stx6 pr6|subr_return_save_off 013365 aa 6 00050 3521 00 2886 epp2 pr6|mcode [5.1-1] 013366 aa 6 00130 2521 00 2887 spri2 pr6|88 store ptr to mcode_ptr [5.1-1] 013367 aa 6 00114 2521 00 2888 spri2 pr6|76 mcode_ptr [5.1-1] 2889 " check if optional bit is on 013370 aa 1 00132 2351 00 2890 lda pr1|90 013371 0a 012040 1150 00 2891 cmpa optional_int 013372 0a 013375 6000 00 2892 tze check_if_open 013373 0a 012041 1150 00 2893 cmpa optional_ext 013374 aa 000003 6010 04 2894 tnz 3,ic 013375 2895 check_if_open: 013375 aa 1 00002 2341 00 2896 szn pr1|2 013376 0a 013431 6000 00 2897 tze close_ok 013377 aa 6 00054 2341 00 2898 szn pr6|retrycode op retry code 013400 0a 013433 6010 00 2899 tnz detach_op 013401 aa 1 00002 2341 00 2900 szn pr1|2 013402 0a 013433 6040 00 2901 tmi detach_op syn attachment don't close 013403 0a 013411 6010 00 2902 tnz close_file_begin 2903 " set status 1,2,3 handle unopen error 013404 0a 012003 2350 00 2904 lda io30_con 013405 0a 012012 2360 00 2905 ldq s2036con 013406 aa 6 00052 7571 00 2906 staq pr6|status12 013407 aa 000021 2210 03 2907 ldx1 17,du set unopened error code to X1 013410 0a 000326 7100 00 2908 tra io_return_to_reset 2909 " This section handles the close. 013411 2910 close_file_begin: 013411 aa 6 00124 6211 00 2911 eax1 pr6|84 argument list offset 013412 aa 010000 4310 07 2912 fld 4096,dl 2 args 013413 aa 1 00000 3521 20 2913 epp2 pr1|0,* indirect thru fsb to iocb 013414 aa 2 00036 3521 00 2914 epp2 pr2|30 offset for close 013415 0a 013420 3500 00 2915 epp0 return_from_io_close 013416 aa 6 00024 2501 00 2916 spri0 pr6|stack_frame.return_ptr adjust return from call_rts 013417 0a 000143 7100 00 2917 tra call_ent_var_from_op iox_$close 2918 even 013420 2919 return_from_io_close: 013420 aa 6 00044 3701 20 2920 epp4 pr6|linkage_ptr,* reset linkage pointer 013421 aa 6 00050 2341 00 2921 szn pr6|mcode 013422 0a 013431 6000 00 2922 tze close_ok 013423 aa 000014 2350 07 2923 lda 12,dl 013424 aa 6 00110 7551 00 2924 sta pr6|rts_code store rts_code 2925 " RTS(18) 013425 aa 000022 2210 03 2926 ldx1 18,du set close error code to X1 013426 0a 000326 3500 00 2927 epp0 io_return_to_reset exit to main line +1 013427 aa 6 00024 2501 00 2928 spri0 pr6|stack_frame.return_ptr 013430 0a 000336 7100 00 2929 tra call_rts_from_op handle close error 2930 " This section handles the detach after a close. 013431 2931 close_ok: 013431 aa 6 00126 3515 20 2932 epp1 pr6|86,* reset pr1 with fsb_ptr 013432 aa 1 00002 4501 00 2933 stz pr1|2 013433 2934 detach_op: 013433 aa 1 00127 2351 00 2935 lda pr1|87 load bit to see if file was previously attached 013434 0a 014750 3750 00 2936 ana =o000400000000 isolate bit 013435 aa 6 00152 6011 20 2937 tnz pr6|subr_return_save,* do not detach if file was previously attached 013436 0a 004006 2350 00 2938 lda space_con 013437 aa 1 00107 1151 00 2939 cmpa pr1|71 is attach name spaces 013440 aa 6 00152 6001 20 2940 tze pr6|subr_return_save,* yes, then NO DETACH SUBR EXIT 013441 aa 6 00154 3701 20 2941 epp4 pr6|pr4_save,* load pr4 013442 aa 0 00100 1065 00 2942 cmpc (pr),(pr),fill(000) attach name to program name 013443 aa 100107 000101 2943 desc9a pr1|71,65 013444 aa 400023 000101 2944 desc9a pr4|19,65 013445 aa 6 00152 6011 20 2945 tnz pr6|subr_return_save,* don't detach names differ SUBR EXIT 013446 aa 6 00124 6211 00 2946 eax1 pr6|84 013447 aa 010000 4310 07 2947 fld 4096,dl 2 args 013450 aa 1 00000 3521 20 2948 epp2 pr1|0,* 013451 aa 2 00026 3521 00 2949 epp2 pr2|22 offset for detach_iocb 013452 0a 013456 3500 00 2950 epp0 return_from_io_detach 013453 aa 6 00024 2501 00 2951 spri0 pr6|stack_frame.return_ptr 013454 0a 000143 7100 00 2952 tra call_ent_var_from_op iox_$detach 013455 aa 000000 0110 03 2953 even 013456 2954 return_from_io_detach: 013456 aa 6 00050 2341 00 2955 szn pr6|mcode 013457 0a 013466 6000 00 2956 tze detach_ok 2957 " set status 1,2,3 handle detach error 013460 aa 6 00054 0541 00 2958 aos pr6|retrycode set retry code to close complete 013461 0a 012003 2350 00 2959 lda io30_con 013462 0a 012013 2360 00 2960 ldq s2393con 013463 aa 6 00052 7571 00 2961 staq pr6|status12 013464 aa 000023 2210 03 2962 ldx1 19,du set detach error code to X1 013465 0a 000326 7100 00 2963 tra io_return_to_reset 013466 2964 detach_ok: 013466 aa 6 00126 3515 20 2965 epp1 pr6|86,* reset pr1 with fsb_ptr 013467 aa 0 40100 1005 00 2966 mlr (pr),(pr),fill(040) space fill attach name 013470 aa 000000 000000 2967 desc9a 0,0 013471 aa 100107 000101 2968 desc9a pr1|71,65 013472 aa 6 00152 7101 20 2969 tra pr6|subr_return_save,* EXIT FROM SUBROUTINE 2970 " 2971 " 2972 " SUBROUTINE to close files only, NO detach 2973 " 2974 " 013473 2975 subr_close_file_only: 013473 aa 6 00153 7461 00 2976 stx6 pr6|subr_return_save_off 013474 aa 6 00050 3521 00 2977 epp2 pr6|mcode 013475 aa 6 00130 2521 00 2978 spri2 pr6|88 013476 aa 1 00002 2341 00 2979 szn pr1|2 [4.1-2] 013477 aa 6 00152 6041 20 2980 tmi pr6|subr_return_save,* 013500 aa 6 00124 6211 00 2981 eax1 pr6|84 argument list offset 013501 aa 010000 4310 07 2982 fld 4096,dl 2 args 013502 aa 1 00000 3521 20 2983 epp2 pr1|0,* indirect thru fsb to iocb 013503 aa 2 00036 3521 00 2984 epp2 pr2|30 offset for close 013504 0a 013510 3500 00 2985 epp0 return_from_io_close_only 013505 aa 6 00024 2501 00 2986 spri0 pr6|stack_frame.return_ptr adjust return from call_rts 013506 0a 000143 7100 00 2987 tra call_ent_var_from_op iox_$close 013507 aa 000000 0110 03 2988 even 013510 2989 return_from_io_close_only: 013510 aa 6 00044 3701 20 2990 epp4 pr6|linkage_ptr,* reset linkage pointer 013511 aa 6 00050 2341 00 2991 szn pr6|mcode 013512 aa 6 00152 6001 20 2992 tze pr6|subr_return_save,* 013513 aa 000014 2350 07 2993 lda 12,dl 013514 aa 6 00110 7551 00 2994 sta pr6|rts_code store rts_code 2995 " RTS(18) 013515 aa 000022 2210 03 2996 ldx1 18,du set close error code to X1 013516 0a 000326 3500 00 2997 epp0 io_return_to_reset exit to main line +1 013517 aa 6 00024 2501 00 2998 spri0 pr6|stack_frame.return_ptr 013520 0a 000336 7100 00 2999 tra call_rts_from_op handle close error 3000 " 3001 " 3002 " 3003 " This operator is for accept the user's word.**********OPERATOR(20)********** 3004 " 013521 3005 accept_line: 013521 3006 inhibit on 013521 aa 6 00101 7403 00 3007 stx0 pr6|return_to_main_off 013522 3008 inhibit off 013522 aa 6 00120 7551 00 3009 sta pr6|80 length of the buff 013523 aa 6 00116 2521 00 3010 spri2 pr6|78 buff_ptr 013524 aa 6 00000 3521 15 3011 epp2 pr6|0,5 013525 aa 6 00122 2521 00 3012 spri2 pr6|82 address of the buffer on the stack 013526 aa 6 00050 3521 00 3013 epp2 pr6|40 013527 aa 6 00114 2521 00 3014 spri2 pr6|76 store the mcode_ptr 3015 " RTS(18) 013530 aa 000022 2350 07 3016 lda 18,dl 013531 aa 6 00110 7551 00 3017 sta pr6|rts_code for accept in cobol_rts_ 013532 0a 013536 3500 00 3018 epp0 return_from_accept preset the return pointer 013533 aa 6 00024 2501 00 3019 spri0 pr6|stack_frame.return_ptr 013534 0a 000336 7100 00 3020 tra call_rts_from_op 013535 aa 000000 0110 03 3021 even 013536 3022 return_from_accept: 013536 aa 6 00050 2341 00 3023 szn pr6|40 013537 0a 013555 6010 00 3024 tnz accept_error output the error message 013540 aa 6 00116 3521 20 3025 epp2 pr6|78,* obtain the buff_ptr 013541 aa 6 00121 7251 00 3026 lxl5 pr6|81 load the actual record length 013542 0a 013552 6000 00 3027 tze return_accept return 013543 aa 000001 1650 03 3028 sbx5 1,du get rid of the new line character 013544 aa 6 00121 4451 00 3029 sxl5 pr6|81 store the actual lengthwith new_line off 013545 aa 6 00120 2351 00 3030 lda pr6|80 load the buffer length 013546 aa 6 00121 1751 00 3031 sba pr6|81 get the length for the unfilled buffer 013547 aa 040155 1004 00 3032 mlr (),(pr,rl,x5),fill(040) fill the unfilled area with spaces 013550 aa 000000 000000 3033 desc9a 0,0 013551 aa 200000 000005 3034 desc9a pr2|0,al 013552 3035 return_accept: 013552 aa 000001 2350 03 3036 lda 1,du 013553 aa 6 00101 0551 00 3037 asa pr6|return_to_main_off skip the retry error instruction 013554 0a 000330 7100 00 3038 tra return_to_reset return 013555 3039 accept_error: 013555 aa 000006 2350 07 3040 lda 6,dl 013556 aa 6 00131 7551 00 3041 sta pr6|89 store the cobol error code 013557 0a 012134 7100 00 3042 tra cobol_error_from_op join the common error label to output the error message 3043 " 3044 " 3045 " **********OPERATOR(44)********** 3046 " This operator is for the use of "accept from date. 3047 " 3048 " 013560 3049 accept_date: 013560 3050 inhibit on 013560 aa 6 00101 7403 00 3051 stx0 pr6|return_to_main_off 013561 3052 inhibit off 3053 " RTS(22) 013561 aa 000026 2350 07 3054 lda 22,dl 013562 aa 6 00110 7551 00 3055 sta pr6|rts_code save the rts_code 013563 0a 000336 7100 00 3056 tra call_rts_from_op 3057 " 3058 " 3059 " **********OPERATOR(45)********** 3060 " This operator is for "accept from day". 3061 " 013564 3062 accept_day: 013564 3063 inhibit on 013564 aa 6 00101 7403 00 3064 stx0 pr6|return_to_main_off 013565 3065 inhibit off 013565 0a 013572 3500 00 3066 epp0 return_from_day reset the retunr point 013566 aa 6 00024 2501 00 3067 spri0 pr6|stack_frame.return_ptr 3068 " RTS(20) 013567 aa 000024 2350 07 3069 lda 20,dl 013570 aa 6 00110 7551 00 3070 sta pr6|rts_code save the rts_code 013571 0a 000336 7100 00 3071 tra call_rts_from_op 3072 even 013572 3073 return_from_day: 013572 aa 0 00100 3015 00 3074 btd (pr),(pr) 013573 aa 600126 000004 3075 desc9a pr6|86,4 013574 aa 600120 430003 3076 desc9ns pr6|80(2),3,0 013575 aa 0 00100 3015 00 3077 btd (pr),(pr) 013576 aa 600116 000004 3078 desc9a pr6|78,4 013577 aa 600117 430004 3079 desc9ns pr6|79(2),4,0 013600 0a 000330 7100 00 3080 tra return_to_reset return 3081 " 3082 " **********OPERATOR(46)********** 3083 " This operator is for accept from time. 3084 " 013601 3085 accept_time: 013601 3086 inhibit on 013601 aa 6 00101 7403 00 3087 stx0 pr6|return_to_main_off 013602 3088 inhibit off 013602 0a 013610 3500 00 3089 epp0 return_from_time reset the return point 013603 aa 6 00024 2501 00 3090 spri0 pr6|stack_frame.return_ptr 013604 aa 000025 2350 07 3091 lda 21,dl load the rts_code 013605 aa 6 00110 7551 00 3092 sta pr6|rts_code 013606 0a 000336 7100 00 3093 tra call_rts_from_op 013607 aa 000000 0110 03 3094 even 013610 3095 return_from_time: 013610 aa 6 00120 2371 00 3096 ldaq pr6|80 load the time of day(tod) 013611 aa 011610 5070 07 3097 dvf 5000,dl 013612 aa 000044 7730 00 3098 lrl 36 013613 aa 013560 5060 07 3099 div 6000,dl 013614 aa 6 00133 7551 00 3100 sta pr6|91 013615 aa 000074 5060 07 3101 div 60,dl 013616 aa 6 00132 7551 00 3102 sta pr6|90 013617 aa 6 00127 7561 00 3103 stq pr6|87 013620 aa 0 00100 3015 00 3104 btd (pr),(pr) 013621 aa 600127 000004 3105 desc9a pr6|87,4 013622 aa 600130 030002 3106 desc9ns pr6|88,2,0 013623 aa 0 00100 3015 00 3107 btd (pr),(pr) 013624 aa 600132 000004 3108 desc9a pr6|90,4 013625 aa 600130 430002 3109 desc9ns pr6|88(2),2,0 013626 aa 0 00100 3015 00 3110 btd (pr),(pr) 013627 aa 600133 000004 3111 desc9a pr6|91,4 013630 aa 600131 030004 3112 desc9ns pr6|89,4,0 013631 0a 000330 7100 00 3113 tra return_to_reset 3114 " 3115 " **********OPERATOR(47)********** 3116 " This operator is for accepr from day of week. 3117 " 013632 3118 accept_day_of_week: 013632 3119 inhibit on 013632 aa 6 00101 7403 00 3120 stx0 pr6|return_to_main_off 013633 3121 inhibit off 013633 0a 013640 3500 00 3122 epp0 return_from_dow 013634 aa 6 00024 2501 00 3123 spri0 pr6|stack_frame.return_ptr reset return pointer 3124 " RTS(21) 013635 aa 000025 2350 07 3125 lda 21,dl 013636 aa 6 00110 7551 00 3126 sta pr6|rts_code 013637 0a 000336 7100 00 3127 tra call_rts_from_op 3128 even 013640 3129 return_from_dow: 013640 aa 6 00122 2351 00 3130 lda pr6|82 load the day of the week 013641 aa 000033 7350 00 3131 als 27 convert to decimal 013642 aa 060000 2750 03 3132 ora 24576,du 013643 aa 6 00122 7551 00 3133 sta pr6|82 store the converted decimal back 013644 0a 000330 7100 00 3134 tra return_to_reset return 3135 " 3136 " 3137 " init_delete check file condition **********OPERATOR(56)********** 3138 " 3139 " 013645 3140 init_delete: 013645 3141 inhibit on 013645 aa 6 00101 7403 00 3142 stx0 pr6|return_to_main_off 013646 3143 inhibit off 013646 aa 6 00126 2515 00 3144 spri1 pr6|86 set fsb_ptr 013647 aa 6 00051 4501 00 3145 stz pr6|icode each entry to zero 013650 aa 1 00002 2341 00 3146 szn pr1|2 is file opened 013651 aa 6 00046 6011 70 3147 tnz pr6|text_base_ptr,*0 YES, 3148 " set status 013652 0a 012003 2350 00 3149 lda io30_con 013653 0a 012033 2360 00 3150 ldq s7031con 013654 aa 6 00052 7571 00 3151 staq pr6|status12 013655 aa 000030 2210 03 3152 ldx1 24,du attempt to perform io on an unopened file 013656 0a 013066 7100 00 3153 tra return_thru_text_base_pone 3154 " 3155 " 3156 " delete_error **********OPERATOR(54)********** 3157 " X5 = error number for RTS interface 3158 " 013657 3159 delete_error: 013657 3160 inhibit on 013657 aa 6 00101 7403 00 3161 stx0 pr6|return_to_main_off 013660 3162 inhibit off 013660 aa 6 00055 4451 00 3163 sxl5 pr6|45 io_error_no 3164 " RTS(16) 013661 aa 000020 2350 07 3165 lda 16,dl 013662 aa 6 00110 7551 00 3166 sta pr6|rts_code store rts_code 013663 0a 000336 7100 00 3167 tra call_rts_from_op 3168 " 3169 " **********OPERATOR(55)********** 3170 " read_key call iox_$read_key 3171 " A = offset for TEMP key storage 3172 " 1st word = length of saved key 3173 " remainder = actual key 3174 " 3175 " 013664 3176 read_key: 013664 3177 inhibit on 013664 aa 6 00101 7403 00 3178 stx0 pr6|return_to_main_off 013665 3179 inhibit off 013665 aa 6 00126 2515 00 3180 spri1 pr6|86 set iocb_ptr 013666 aa 6 00112 2515 00 3181 spri1 pr6|74 iocb_ptr 013667 aa 6 00064 6521 00 3182 spri6 pr6|52 get any pointer value in area 013670 aa 6 00065 0751 00 3183 ada pr6|53 013671 aa 6 00065 7551 00 3184 sta pr6|53 insert correct value in pointer offset 013672 aa 6 00064 3521 20 3185 epp2 pr6|52,* point to TEMP area 013673 aa 6 00132 2521 00 3186 spri2 pr6|90 store pointer to key length 013674 aa 000001 0520 03 3187 adwp2 1,du 013675 3188 read_delete_join: 013675 aa 6 00130 2521 00 3189 spri2 pr6|88 store pointer to key area 013676 aa 6 00050 3521 00 3190 epp2 pr6|mcode 013677 aa 6 00134 2521 00 3191 spri2 pr6|92 store pointer to mcode 013700 aa 6 00114 2521 00 3192 spri2 pr6|76 mcode_ptr 013701 aa 6 00124 6211 00 3193 eax1 pr6|84 013702 aa 020000 4310 07 3194 fld 8192,dl 4 args 013703 aa 1 00000 3521 20 3195 epp2 pr1|0,* 013704 aa 2 00116 3521 00 3196 epp2 pr2|78 offset for iox_$read_key 013705 0a 013710 3500 00 3197 epp0 return_read_key 013706 aa 6 00024 2501 00 3198 spri0 pr6|stack_frame.return_ptr 013707 0a 000143 7100 00 3199 tra call_ent_var_from_op 3200 even 013710 3201 return_read_key: 013710 aa 6 00123 4501 00 3202 stz pr6|83 set read_key_eof to zero 013711 aa 6 00050 2341 00 3203 szn pr6|mcode 013712 0a 000330 6000 00 3204 tze return_to_reset 013713 aa 6 00044 3701 20 3205 epp4 pr6|linkage_ptr,* reset linkage pointer 013714 aa 6 00050 3521 00 3206 epp2 pr6|mcode 013715 aa 6 00114 2521 00 3207 spri2 pr6|76 3208 " RTS(17) 013716 aa 000021 2350 07 3209 lda 17,dl 013717 aa 6 00110 7551 00 3210 sta pr6|rts_code store rts code 013720 0a 013723 3500 00 3211 epp0 return_rts_read_key 013721 aa 6 00024 2501 00 3212 spri0 pr6|stack_frame.return_ptr 013722 0a 000336 7100 00 3213 tra call_rts_from_op handle read key errors 013723 3214 return_rts_read_key: 013723 aa 6 00050 2341 00 3215 szn pr6|mcode 013724 0a 000330 6000 00 3216 tze return_to_reset 013725 aa 000033 2210 03 3217 ldx1 27,du set read error code 013726 0a 000326 7100 00 3218 tra io_return_to_reset 3219 " 3220 " **********OPERATOR(69)********** 3221 " 3222 " 013727 3223 read_key_for_read: 013727 3224 inhibit on 013727 aa 6 00101 7403 00 3225 stx0 pr6|return_to_main_off 013730 3226 inhibit off 013730 aa 6 00126 2515 00 3227 spri1 pr6|86 set fsb_ptr 013731 aa 6 00112 2515 00 3228 spri1 pr6|74 iocb_ptr 013732 aa 6 00064 6521 00 3229 spri6 pr6|52 get any pointer value in area 013733 aa 6 00065 0751 00 3230 ada pr6|53 013734 aa 6 00065 7551 00 3231 sta pr6|53 insert correct value in pointer offset 013735 aa 6 00064 3521 20 3232 epp2 pr6|52,* point to TEMP area 013736 aa 6 00132 2521 00 3233 spri2 pr6|90 store pointer to key length 013737 aa 1 00007 3521 00 3234 epp2 pr1|7 013740 aa 6 00130 2521 00 3235 spri2 pr6|88 store pointer to key area 013741 aa 6 00050 3521 00 3236 epp2 pr6|mcode 013742 aa 6 00134 2521 00 3237 spri2 pr6|92 store pointer to mcode 013743 aa 6 00114 2521 00 3238 spri2 pr6|76 mcode_ptr 013744 aa 6 00124 6211 00 3239 eax1 pr6|84 013745 aa 020000 4310 07 3240 fld 8192,dl 4 args 013746 aa 1 00000 3521 20 3241 epp2 pr1|0,* 013747 aa 2 00116 3521 00 3242 epp2 pr2|78 offset for iox_$read_key 013750 0a 013754 3500 00 3243 epp0 return_for_read_key 013751 aa 6 00024 2501 00 3244 spri0 pr6|stack_frame.return_ptr 013752 0a 000143 7100 00 3245 tra call_ent_var_from_op 013753 aa 000000 0110 03 3246 even 013754 3247 return_for_read_key: 013754 aa 6 00050 2341 00 3248 szn pr6|mcode 013755 0a 000330 6000 00 3249 tze return_to_reset 013756 aa 6 00044 3701 20 3250 epp4 pr6|linkage_ptr,* reset linkage pointer 013757 aa 6 00050 3521 00 3251 epp2 pr6|mcode 013760 aa 6 00114 2521 00 3252 spri2 pr6|76 3253 " RTS(26) 013761 aa 000032 2350 07 3254 lda 26,dl 013762 aa 6 00110 7551 00 3255 sta pr6|rts_code store rts code 013763 0a 013766 3500 00 3256 epp0 return_rts_for_read_key 013764 aa 6 00024 2501 00 3257 spri0 pr6|stack_frame.return_ptr 013765 0a 000336 7100 00 3258 tra call_rts_from_op handle read key errors 013766 3259 return_rts_for_read_key: 013766 aa 000033 2210 03 3260 ldx1 27,du set read error code 013767 0a 000326 7100 00 3261 tra io_return_to_reset 3262 " 3263 " **********OPERATOR(53)********** 3264 " delete call iox_$delete_record 3265 " 3266 " 013770 3267 delete: 013770 3268 inhibit on 013770 aa 6 00101 7403 00 3269 stx0 pr6|return_to_main_off 013771 3270 inhibit off 013771 aa 6 00126 2515 00 3271 spri1 pr6|86 set fsb_ptr 013772 aa 0 14002 7061 00 3272 tsx6 pr0|subr_delete 013773 aa 6 00050 2341 00 3273 szn pr6|mcode 013774 0a 000330 6000 00 3274 tze return_to_reset 3275 " set status 013775 0a 012003 2350 00 3276 lda io30_con 013776 0a 012034 2360 00 3277 ldq s7430con 013777 aa 6 00052 7571 00 3278 staq pr6|status12 014000 aa 000036 2210 03 3279 ldx1 30,du Unable to delete record 014001 0a 000326 7100 00 3280 tra io_return_to_reset 3281 " 3282 " 3283 " SUBROUTINE to iox_$delete_record 3284 " 3285 " 014002 3286 subr_delete: 014002 aa 6 00153 7461 00 3287 stx6 pr6|subr_return_save_off 014003 aa 6 00050 3521 00 3288 epp2 pr6|mcode 014004 aa 6 00130 2521 00 3289 spri2 pr6|88 store pointer to mcode 014005 aa 6 00124 6211 00 3290 eax1 pr6|84 014006 aa 010000 4310 07 3291 fld 4096,dl 2 args 014007 aa 1 00000 3521 20 3292 epp2 pr1|0,* 014010 aa 2 00106 3521 00 3293 epp2 pr2|70 offset for iox_$delete_record 014011 aa 6 00152 3501 20 3294 epp0 pr6|subr_return_save,* EXIT FROM SUBROUTINE 014012 aa 6 00024 2501 00 3295 spri0 pr6|stack_frame.return_ptr 014013 0a 000143 7100 00 3296 tra call_ent_var_from_op 3297 " 3298 " **********OPERATOR(57)********** 3299 " special_delete seek BUFF, delete, seek TEMP, if EOF position 3300 " 3301 " 014014 3302 special_delete: 014014 3303 inhibit on 014014 aa 6 00101 7403 00 3304 stx0 pr6|return_to_main_off 014015 3305 inhibit off 014015 aa 6 00065 7551 00 3306 sta pr6|53 save a for future use 014016 aa 6 00126 2515 00 3307 spri1 pr6|86 set fsb_ptr 014017 aa 1 00007 3521 00 3308 epp2 pr1|7 014020 aa 6 00130 2521 00 3309 spri2 pr6|88 014021 aa 6 00076 3521 00 3310 epp2 pr6|62 work area not used as seek key returns length 014022 aa 6 00132 2521 00 3311 spri2 pr6|90 3312 " RTS(25) 014023 aa 000031 2350 07 3313 lda 25,dl 014024 aa 6 00110 7551 00 3314 sta pr6|rts_code store rts code 014025 aa 0 00515 7061 00 3315 tsx6 pr0|subr_seek_op from BUFF area 014026 aa 6 00050 2341 00 3316 szn pr6|mcode 014027 0a 000326 6010 00 3317 tnz io_return_to_reset 014030 aa 6 00126 3515 20 3318 epp1 pr6|86,* 014031 aa 0 14002 7061 00 3319 tsx6 pr0|subr_delete 014032 aa 6 00050 2341 00 3320 szn pr6|mcode 014033 0a 014041 6000 00 3321 tze return_special_delete 3322 " set status 014034 0a 012003 2350 00 3323 lda io30_con 014035 0a 012034 2360 00 3324 ldq s7430con 014036 aa 6 00052 7571 00 3325 staq pr6|status12 014037 aa 000036 2210 03 3326 ldx1 30,du Unable to delete record 014040 0a 000326 7100 00 3327 tra io_return_to_reset 014041 3328 return_special_delete: 014041 aa 6 00126 3515 20 3329 epp1 pr6|86,* 014042 aa 6 00123 2341 00 3330 szn pr6|83 is read_key_eof set 014043 0a 014056 6010 00 3331 tnz eof_position 014044 aa 6 00065 2351 00 3332 lda pr6|53 reset A from previous save 014045 aa 6 00064 6521 00 3333 spri6 pr6|52 set any pointer value in area 014046 aa 6 00065 0751 00 3334 ada pr6|53 014047 aa 6 00065 7551 00 3335 sta pr6|53 insert correct value in pointer offset 014050 aa 6 00064 3521 20 3336 epp2 pr6|52,* point to TEMP area 014051 aa 6 00132 2521 00 3337 spri2 pr6|90 store pointer to key length 014052 aa 000001 0520 03 3338 adwp2 1,du increment pointer offset up by one 014053 aa 6 00130 2521 00 3339 spri2 pr6|88 store pointer to key area 014054 aa 0 00515 7061 00 3340 tsx6 pr0|subr_seek_op from TEMP area 014055 0a 000330 7100 00 3341 tra return_to_reset 014056 3342 eof_position: 014056 aa 6 00064 4501 00 3343 stz pr6|52 014057 aa 6 00064 0541 00 3344 aos pr6|52 set to +1 014060 aa 6 00065 4501 00 3345 stz pr6|53 014061 aa 6 00064 3521 00 3346 epp2 pr6|52 014062 aa 6 00130 2521 00 3347 spri2 pr6|88 store pointer to type = +1 014063 aa 6 00065 3521 00 3348 epp2 pr6|53 014064 aa 6 00132 2521 00 3349 spri2 pr6|90 store pointer for n = 0 014065 aa 6 00050 3521 00 3350 epp2 pr6|40 014066 aa 6 00134 2521 00 3351 spri2 pr6|92 store pointer to mcode 014067 aa 6 00124 6211 00 3352 eax1 pr6|84 014070 aa 020000 4310 07 3353 fld 8192,dl 4args 014071 aa 1 00000 3521 20 3354 epp2 pr1|0,* 014072 aa 2 00062 3521 00 3355 epp2 pr2|50 offset for iox_$position 014073 0a 000330 3500 00 3356 epp0 return_to_reset 014074 aa 6 00024 2501 00 3357 spri0 pr6|stack_frame.return_ptr 014075 0a 000143 7100 00 3358 tra call_ent_var_from_op 3359 " 3360 " 3361 " special_rewrite seek and position**********OPERATOR(58)********** 3362 " 3363 " 014076 3364 special_rewrite: 014076 3365 inhibit on 014076 aa 6 00101 7403 00 3366 stx0 pr6|return_to_main_off 014077 3367 inhibit off 014077 aa 6 00065 7551 00 3368 sta pr6|53 save offset to key area 014100 aa 6 00126 2515 00 3369 spri1 pr6|86 set fsb_ptr 014101 aa 6 00074 6515 00 3370 spri5 pr6|60 save pr 5 for rewrite 014102 aa 1 00007 3521 00 3371 epp2 pr1|7 014103 aa 6 00130 2521 00 3372 spri2 pr6|88 014104 aa 6 00076 3521 00 3373 epp2 pr6|62 work area not used as seek key returns length 014105 aa 6 00132 2521 00 3374 spri2 pr6|90 3375 " RTS(25) 014106 aa 000031 2350 07 3376 lda 25,dl 014107 aa 6 00110 7551 00 3377 sta pr6|rts_code store rts code 014110 aa 0 00515 7061 00 3378 tsx6 pr0|subr_seek_op from BUFF area 014111 aa 6 00050 2341 00 3379 szn pr6|mcode 014112 0a 000326 6010 00 3380 tnz io_return_to_reset 014113 aa 6 00126 3515 20 3381 epp1 pr6|86,* 014114 aa 6 00074 3715 20 3382 epp5 pr6|60,* save area points to buffer area 014115 aa 0 00534 7061 00 3383 tsx6 pr0|subr_write_record 014116 aa 2 00102 3521 00 3384 epp2 pr2|66 offset for iox_$rewrite_record 014117 0a 014122 3500 00 3385 epp0 return_special_rewrite 014120 aa 6 00024 2501 00 3386 spri0 pr6|stack_frame.return_ptr 014121 0a 000143 7100 00 3387 tra call_ent_var_from_op 014122 3388 return_special_rewrite: 014122 aa 6 00126 3515 20 3389 epp1 pr6|86,* 014123 aa 6 00050 2341 00 3390 szn pr6|mcode 014124 0a 014041 6000 00 3391 tze return_special_delete 3392 " set status 014125 0a 012003 2350 00 3393 lda io30_con 014126 0a 012026 2360 00 3394 ldq s5432con 014127 aa 6 00052 7571 00 3395 staq pr6|status12 014130 aa 000053 2210 03 3396 ldx1 43,du Attempt to rewrite a file not opened as i-o 014131 0a 000326 7100 00 3397 tra io_return_to_reset 3398 " 3399 " 3400 " rewrite **********OPERATOR(59)********** 3401 " 3402 " 014132 3403 rewrite: 014132 3404 inhibit on 014132 aa 6 00101 7403 00 3405 stx0 pr6|return_to_main_off 014133 3406 inhibit off 014133 aa 6 00126 2515 00 3407 spri1 pr6|86 set fsb_ptr 014134 aa 0 00534 7061 00 3408 tsx6 pr0|subr_write_record 014135 aa 2 00102 3521 00 3409 epp2 pr2|66 offset for iox_$rewrite_record 3410 " RTS(64) 014136 aa 000100 2350 07 3411 lda 64,dl [5.3-1] 014137 aa 6 00110 7551 00 3412 sta pr6|rts_code [5.3-1] 014140 0a 014143 3500 00 3413 epp0 return_rewrite_record 014141 aa 6 00024 2501 00 3414 spri0 pr6|stack_frame.return_ptr 014142 0a 000336 7100 00 3415 tra call_rts_from_op [5.3-1] 014143 3416 return_rewrite_record: 014143 aa 6 00050 2341 00 3417 szn pr6|mcode 014144 0a 000330 6000 00 3418 tze return_to_reset 3419 " set status 3420 " lda io30_con [5.3-1] 3421 " ldq s5432con [5.3-1] 3422 " staq pr6|status12 [5.3-1] 014145 aa 000053 2210 03 3423 ldx1 43,du Attempt to rewrite a file not opened as i-o 014146 0a 000326 7100 00 3424 tra io_return_to_reset 3425 " 3426 " 3427 " init_read check file condition **********OPERATOR(63)********** 3428 " 3429 " 014147 3430 init_read: 014147 3431 inhibit on 014147 aa 6 00101 7403 00 3432 stx0 pr6|return_to_main_off 014150 3433 inhibit off 014150 aa 6 00126 2515 00 3434 spri1 pr6|86 set fsb_ptr 014151 aa 6 00051 4501 00 3435 stz pr6|icode reset on each entry to zero 014152 aa 6 00056 4501 00 3436 stz pr6|46 014153 aa 1 00002 2341 00 3437 szn pr1|2 is file open 014154 aa 6 00046 6011 70 3438 tnz pr6|text_base_ptr,*0 YES, 3439 " check if optional bit is on perform AT END condition 014155 aa 1 00132 2351 00 3440 lda pr1|90 014156 0a 012040 1150 00 3441 cmpa optional_int 014157 0a 014167 6000 00 3442 tze read_optional 014160 0a 012041 1150 00 3443 cmpa optional_ext 014161 0a 014167 6000 00 3444 tze read_optional 3445 " set status 014162 0a 012003 2350 00 3446 lda io30_con 014163 0a 012014 2360 00 3447 ldq s3031con 014164 aa 6 00052 7571 00 3448 staq pr6|status12 014165 aa 000050 2210 03 3449 ldx1 40,du attempt to perform io on unopened file 014166 0a 013066 7100 00 3450 tra return_thru_text_base_pone 014167 3451 read_optional: 014167 0a 012001 2350 00 3452 lda io10_con set status for at end condition 014170 0a 012016 2360 00 3453 ldq s3410con 014171 aa 6 00052 7571 00 3454 staq pr6|status12 014172 aa 6 00051 0541 00 3455 aos pr6|icode 014173 aa 6 00056 0541 00 3456 aos pr6|46 014174 0a 000326 7100 00 3457 tra io_return_to_reset 3458 " 3459 " **********OPERATOR(64)********** 3460 " get_line used for cobol_read_gen 3461 " 3462 " 014175 3463 get_line: 014175 3464 inhibit on 014175 aa 6 00101 7403 00 3465 stx0 pr6|return_to_main_off 014176 3466 inhibit off 014176 aa 6 00126 3515 20 3467 epp1 pr6|86,* set iocb_ptr 014177 aa 6 00116 6515 00 3468 spri5 pr6|78 store buff_ptr 014200 aa 6 00116 3521 00 3469 epp2 pr6|78 014201 aa 6 00130 2521 00 3470 spri2 pr6|88 store pointer to buff_ptr 014202 aa 6 00120 3521 00 3471 epp2 pr6|80 014203 aa 6 00132 2521 00 3472 spri2 pr6|90 store pointer to buff_len 014204 aa 6 00057 4501 00 3473 stz pr6|47 014205 aa 6 00057 3521 00 3474 epp2 pr6|47 014206 aa 6 00134 2521 00 3475 spri2 pr6|92 no of bytes read into buffer output 014207 aa 6 00050 3521 00 3476 epp2 pr6|mcode 014210 aa 6 00136 2521 00 3477 spri2 pr6|94 store pointer to mcode 014211 aa 6 00124 6211 00 3478 eax1 pr6|84 014212 aa 024000 4310 07 3479 fld 10240,dl 5 args 014213 aa 1 00000 3521 20 3480 epp2 pr1|0,* indirect thru fsb to iocb 014214 aa 2 00042 3521 00 3481 epp2 pr2|34 offset for iox_$get_line 014215 0a 014220 3500 00 3482 epp0 return_get_line 014216 aa 6 00024 2501 00 3483 spri0 pr6|stack_frame.return_ptr 014217 0a 000143 7100 00 3484 tra call_ent_var_from_op iox_get_line 3485 even 014220 3486 return_get_line: 014220 aa 6 00050 2341 00 3487 szn pr6|mcode 014221 0a 000330 6000 00 3488 tze return_to_reset 014222 aa 6 00044 3701 20 3489 epp4 pr6|linkage_ptr,* 014223 aa 6 00050 3521 00 3490 epp2 pr6|mcode 014224 aa 6 00114 2521 00 3491 spri2 pr6|76 3492 " RTS(28) 014225 aa 000034 2350 07 3493 lda 28,dl 014226 aa 6 00110 7551 00 3494 sta pr6|rts_code 014227 0a 014562 3500 00 3495 epp0 return_read_record_exit 014230 aa 6 00024 2501 00 3496 spri0 pr6|stack_frame.return_ptr 014231 0a 000336 7100 00 3497 tra call_rts_from_op 3498 even 3499 "[3.0-1] 3500 "[3.0-1] alt_start **********OPERATOR(79)********** 3501 "[3.0-1] 3502 "[3.0-1] 3503 " 014232 3504 alt_start: 014232 3505 inhibit on 014232 aa 6 00101 7403 00 3506 stx0 pr6|return_to_main_off 014233 3507 inhibit off 3508 " 014233 aa 6 00120 6535 00 3509 spri7 pr6|80 set file descr ptr 3510 " 014234 aa 000060 2350 07 3511 lda 48,dl RTS(48) 014235 aa 6 00110 7551 00 3512 sta pr6|rts_code set fields in FSB 014236 0a 014241 3500 00 3513 epp0 return_from_alt_start 014237 aa 6 00024 2501 00 3514 spri0 pr6|stack_frame.return_ptr 014240 0a 000336 7100 00 3515 tra call_rts_from_op 3516 " 014241 3517 return_from_alt_start: 014241 0a 000330 7100 00 3518 tra return_to_reset 3519 " 3520 "[3.0-1] 3521 "[3.0-1] alt_read_next **********OPERATOR(80)********** 3522 "[3.0-1] 3523 "[3.0-1] 3524 " 014242 3525 alt_read_next: 014242 3526 inhibit on 014242 aa 6 00101 7403 00 3527 stx0 pr6|return_to_main_off 014243 3528 inhibit off 3529 " 014243 aa 6 00120 6535 00 3530 spri7 pr6|80 set file descr ptr 3531 " 014244 aa 000061 2350 07 3532 lda 49,dl RTS(49) 014245 aa 6 00110 7551 00 3533 sta pr6|rts_code set fields in FSB 014246 0a 014251 3500 00 3534 epp0 return_from_alt_read 014247 aa 6 00024 2501 00 3535 spri0 pr6|stack_frame.return_ptr 014250 0a 000336 7100 00 3536 tra call_rts_from_op 3537 " 014251 3538 return_from_alt_read: 014251 0a 000330 7100 00 3539 tra return_to_reset 3540 " 3541 "[3.0-1] 3542 "[3.0-1] alt_read_record **********OPERATOR(81)********** 3543 "[3.0-1] 3544 "[3.0-1] 3545 " 014252 3546 alt_read_record: 014252 3547 inhibit on 014252 aa 6 00101 7403 00 3548 stx0 pr6|return_to_main_off 014253 3549 inhibit off 3550 " 014253 aa 6 00120 6535 00 3551 spri7 pr6|80 set file descr ptr 3552 " 014254 aa 000062 2350 07 3553 lda 50,dl RTS(50) 014255 aa 6 00110 7551 00 3554 sta pr6|rts_code set fields in FSB 014256 0a 014261 3500 00 3555 epp0 return_from_alt_key 014257 aa 6 00024 2501 00 3556 spri0 pr6|stack_frame.return_ptr 014260 0a 000336 7100 00 3557 tra call_rts_from_op 3558 " 014261 3559 return_from_alt_key: 014261 0a 000330 7100 00 3560 tra return_to_reset 3561 " 3562 "[3.0-1] 3563 "[3.0-1] alt_seek_key **********OPERATOR(82)********** 3564 "[3.0-1] 3565 "[3.0-1] 3566 " 014262 3567 alt_seek_key: 014262 3568 inhibit on 014262 aa 6 00101 7403 00 3569 stx0 pr6|return_to_main_off 014263 3570 inhibit off 3571 " 014263 aa 6 00112 2515 00 3572 spri1 pr6|74 loc of file key for start 014264 aa 6 00120 6535 00 3573 spri7 pr6|80 set file descr ptr 014265 aa 6 00125 7551 00 3574 sta pr6|85 store key number 3575 " 014266 aa 000066 2350 07 3576 lda 54,dl RTS(54) 014267 aa 6 00110 7551 00 3577 sta pr6|rts_code move key in FSB one position 014270 0a 014273 3500 00 3578 epp0 return_from_alt_seek prefix by key number 014271 aa 6 00024 2501 00 3579 spri0 pr6|stack_frame.return_ptr 014272 0a 000336 7100 00 3580 tra call_rts_from_op 3581 " 014273 3582 return_from_alt_seek: 014273 0a 000330 7100 00 3583 tra return_to_reset 3584 " 3585 "[4.0-3] 3586 " 3587 " 3588 " iox_$control perform control order on io switch.**********OPERATOR(83)********** 3589 " 3590 " 014274 3591 alt_start_control: 014274 3592 inhibit on 014274 aa 6 00101 7403 00 3593 stx0 pr6|return_to_main_off 014275 3594 inhibit off 014275 aa 6 00126 3515 20 3595 epp1 pr6|86,* set iocb_ptr 014276 aa 6 00060 6521 00 3596 spri6 pr6|48 store stack_offset ptr for order name 014277 aa 6 00062 6521 00 3597 spri6 pr6|50 014300 aa 6 00061 0651 00 3598 adx5 pr6|49 add base offset to x5 014301 aa 6 00061 7451 00 3599 stx5 pr6|49 set correct offset 014302 aa 000002 0650 03 3600 adx5 2,du 014303 aa 6 00063 7451 00 3601 stx5 pr6|51 014304 aa 6 00060 2515 20 3602 spri1 pr6|48,* store fsb pointer 014305 aa 6 00062 3521 20 3603 epp2 pr6|50,* 014306 aa 000002 0520 03 3604 adwp2 2,du 014307 aa 6 00062 2521 20 3605 spri2 pr6|50,* store control pointer 014310 aa 6 00050 3521 00 3606 epp2 pr6|mcode 014311 aa 6 00114 2521 00 3607 spri2 pr6|76 store mcode_ptr 014312 aa 000074 2350 07 3608 lda 60,dl RTS(60) 014313 aa 6 00110 7551 00 3609 sta pr6|rts_code 014314 0a 014317 3500 00 3610 epp0 return_alt_start_control 014315 aa 6 00024 2501 00 3611 spri0 pr6|stack_frame.return_ptr 014316 0a 000336 7100 00 3612 tra call_rts_from_op iox_control 014317 3613 return_alt_start_control: 014317 aa 6 00050 2341 00 3614 szn pr6|mcode 014320 0a 000330 6000 00 3615 tze return_to_reset 3616 " set status 014321 aa 000046 2210 03 3617 ldx1 38,du unable to start a file with specified key 014322 0a 000326 7100 00 3618 tra io_return_to_reset 3619 " 3620 "[3.0-1] 3621 "[3.0-1] alt_read_key **********OPERATOR(84)********** 3622 "[3.0-1] 3623 "[3.0-1] 3624 " 014323 3625 alt_read_key: 014323 3626 inhibit on 014323 aa 6 00101 7403 00 3627 stx0 pr6|return_to_main_off 014324 3628 inhibit off 3629 " 014324 aa 6 00112 2515 00 3630 spri1 pr6|74 loc of file key 014325 aa 6 00120 6535 00 3631 spri7 pr6|80 set file descr ptr 014326 aa 6 00125 7551 00 3632 sta pr6|85 store key number 3633 " 014327 aa 000073 2350 07 3634 lda 59,dl RTS(59) 014330 aa 6 00110 7551 00 3635 sta pr6|rts_code 3636 " 014331 0a 014334 3500 00 3637 epp0 return_from_alt_read_key 014332 aa 6 00024 2501 00 3638 spri0 pr6|stack_frame.return_ptr 014333 0a 000336 7100 00 3639 tra call_rts_from_op 3640 " 014334 3641 return_from_alt_read_key: 014334 0a 000330 7100 00 3642 tra return_to_reset 3643 "[3.0-1] 3644 "[3.0-1] alt_special_delete **********OPERATOR(85)********** 3645 "[3.0-1] 3646 "[3.0-1] 3647 " 014335 3648 alt_special_delete: 014335 3649 inhibit on 014335 aa 6 00101 7403 00 3650 stx0 pr6|return_to_main_off 014336 3651 inhibit off 3652 " 014336 aa 6 00112 2515 00 3653 spri1 pr6|74 loc of file key [4.4-2] 014337 aa 6 00120 2351 00 3654 lda pr6|80 save rec length 014340 aa 6 00144 7551 00 3655 sta pr6|100 014341 aa 6 00120 6535 00 3656 spri7 pr6|80 set file descr ptr 014342 aa 6 00050 3735 00 3657 epp7 pr6|mcode mcode_ptr 014343 aa 6 00114 6535 00 3658 spri7 pr6|76 3659 " 014344 aa 000067 2350 07 3660 lda 55,dl RTS(55) 014345 aa 6 00110 7551 00 3661 sta pr6|rts_code move key in FSB one pos 014346 0a 014351 3500 00 3662 epp0 return_from_alt_spec prefix by 511 014347 aa 6 00024 2501 00 3663 spri0 pr6|stack_frame.return_ptr 014350 0a 000336 7100 00 3664 tra call_rts_from_op 3665 " 014351 3666 return_from_alt_spec: 014351 aa 6 00144 2351 00 3667 lda pr6|100 restore rec length 014352 aa 6 00120 7551 00 3668 sta pr6|80 014353 0a 000330 7100 00 3669 tra return_to_reset 3670 "[3.0-1] 3671 "[3.0-1] alt_delete **********OPERATOR(86)********** 3672 "[3.0-1] 3673 "[3.0-1] 3674 " 014354 3675 alt_delete: 014354 3676 inhibit on 014354 aa 6 00101 7403 00 3677 stx0 pr6|return_to_main_off 014355 3678 inhibit off 3679 " 014355 aa 000065 2350 07 3680 lda 53,dl RTS(53) 014356 aa 6 00110 7551 00 3681 sta pr6|rts_code set fields in FSB after rewrite 014357 0a 014362 3500 00 3682 epp0 return_from_alt_fsb 014360 aa 6 00024 2501 00 3683 spri0 pr6|stack_frame.return_ptr 014361 0a 000336 7100 00 3684 tra call_rts_from_op 3685 " 014362 3686 return_from_alt_fsb: 014362 0a 000330 7100 00 3687 tra return_to_reset 3688 "[3.0-1] 3689 "[3.0-1] alt_key_delete **********OPERATOR(87)********** 3690 "[3.0-1] 3691 "[3.0-1] 3692 " 014363 3693 alt_key_delete: 014363 3694 inhibit on 014363 aa 6 00101 7403 00 3695 stx0 pr6|return_to_main_off 014364 3696 inhibit off 3697 " 014364 aa 6 00050 4501 00 3698 stz pr6|mcode 014365 aa 6 00050 3735 00 3699 epp7 pr6|mcode mcode_ptr 014366 aa 6 00114 6535 00 3700 spri7 pr6|76 3701 " 014367 aa 000064 2350 07 3702 lda 52,dl RTS(52) 014370 aa 6 00110 7551 00 3703 sta pr6|rts_code $control("record_status") 014371 0a 014374 3500 00 3704 epp0 return_from_rew_del delete alt key values 014372 aa 6 00024 2501 00 3705 spri0 pr6|stack_frame.return_ptr 014373 0a 000336 7100 00 3706 tra call_rts_from_op 3707 " 014374 3708 return_from_rew_del: 014374 aa 6 00050 2341 00 3709 szn pr6|mcode 014375 0a 000330 6000 00 3710 tze return_to_reset 3711 " 014376 0a 012000 2350 00 3712 lda io9_con status-key-1,2 014377 0a 012034 2360 00 3713 ldq s7430con [5.3-1] status-key-3 014400 aa 6 00052 7571 00 3714 staq pr6|status12 014401 aa 000101 2210 03 3715 ldx1 65,du unable to delete keys 014402 0a 000326 7100 00 3716 tra io_return_to_reset 3717 "[3.0-1] 3718 "[3.0-1] alt_rewrite_add **********OPERATOR(88)********** 3719 "[3.0-1] 3720 "[3.0-1] 3721 " 014403 3722 alt_rewrite_add: 014403 3723 inhibit on 014403 aa 6 00101 7403 00 3724 stx0 pr6|return_to_main_off 014404 3725 inhibit off 3726 " 014404 aa 6 00050 4501 00 3727 stz pr6|mcode 014405 aa 6 00050 3735 00 3728 epp7 pr6|mcode mcode_ptr 014406 aa 6 00114 6535 00 3729 spri7 pr6|76 3730 " 014407 aa 000072 2350 07 3731 lda 58,dl RTS(58) 014410 aa 6 00110 7551 00 3732 sta pr6|rts_code $control("record_status) 014411 0a 014414 3500 00 3733 epp0 return_from_rew_add add alt key values 014412 aa 6 00024 2501 00 3734 spri0 pr6|stack_frame.return_ptr set fields in FSB after rewrite 014413 0a 000336 7100 00 3735 tra call_rts_from_op 3736 " 014414 3737 return_from_rew_add: 014414 aa 6 00050 2341 00 3738 szn pr6|mcode 014415 0a 000330 6000 00 3739 tze return_to_reset 3740 " 014416 0a 012000 2350 00 3741 lda io9_con status-key-1,2 014417 0a 012027 2360 00 3742 ldq s5730con status-key-3 014420 aa 6 00052 7571 00 3743 staq pr6|status12 014421 aa 000100 2210 03 3744 ldx1 64,du unable to add key 014422 0a 000326 7100 00 3745 tra io_return_to_reset 3746 "[3.0-1] 3747 "[3.0-1] alt_add_write_keys **********OPERATOR(90)********** 3748 "[3.0-1] 3749 "[3.0-1] 3750 " 014423 3751 alt_add_write_keys: 014423 3752 inhibit on 014423 aa 6 00101 7403 00 3753 stx0 pr6|return_to_main_off 014424 3754 inhibit off 3755 " 014424 aa 6 00120 6535 00 3756 spri7 pr6|80 set file descr ptr 014425 aa 6 00050 4501 00 3757 stz pr6|mcode 014426 aa 6 00050 3735 00 3758 epp7 pr6|mcode mcode_ptr 014427 aa 6 00114 6535 00 3759 spri7 pr6|76 3760 " 014430 aa 000070 2350 07 3761 lda 56,dl RTS(56) 014431 aa 6 00110 7551 00 3762 sta pr6|rts_code add alt rec keys 014432 0a 014435 3500 00 3763 epp0 return_from_alt_add set fields in FSB 014433 aa 6 00024 2501 00 3764 spri0 pr6|stack_frame.return_ptr 014434 0a 000336 7100 00 3765 tra call_rts_from_op 3766 " 014435 3767 return_from_alt_add: 014435 aa 6 00050 2341 00 3768 szn pr6|mcode 014436 0a 000330 6000 00 3769 tze return_to_reset 3770 " 014437 0a 012000 2350 00 3771 lda io9_con status-key-1,2 014440 0a 012025 2360 00 3772 ldq s4730con status-key-3 014441 aa 6 00052 7571 00 3773 staq pr6|status12 014442 aa 000100 2210 03 3774 ldx1 64,du unable to add keys 014443 0a 000326 7100 00 3775 tra io_return_to_reset 3776 " 3777 "[3.0-1] 3778 "[3.0-1] alt_write_seek_key **********OPERATOR(91)********** 3779 "[3.0-1] 3780 "[3.0-1] 3781 " 014444 3782 alt_write_seek_key: 014444 3783 inhibit on 014444 aa 6 00101 7403 00 3784 stx0 pr6|return_to_main_off 014445 3785 inhibit off 3786 " 014445 aa 6 00120 2351 00 3787 lda pr6|80 014446 aa 6 00144 7551 00 3788 sta pr6|100 save record size 014447 aa 6 00120 6535 00 3789 spri7 pr6|80 set file descr ptr 014450 aa 6 00116 6515 00 3790 spri5 pr6|78 store buff ptr 014451 aa 6 00050 3735 00 3791 epp7 pr6|mcode mcode_ptr 014452 aa 6 00114 6535 00 3792 spri7 pr6|76 014453 aa 6 00050 4501 00 3793 stz pr6|mcode 3794 " 014454 aa 000063 2350 07 3795 lda 51,dl RTS(51) 014455 aa 6 00110 7551 00 3796 sta pr6|rts_code if necessary: test key order, SAVE_CRP 014456 0a 014461 3500 00 3797 epp0 return_from_write_seek test alt key values for legality 014457 aa 6 00024 2501 00 3798 spri0 pr6|stack_frame.return_ptr move key in FSB one pos to right 014460 0a 000336 7100 00 3799 tra call_rts_from_op 3800 " 014461 3801 return_from_write_seek: 014461 aa 6 00144 2351 00 3802 lda pr6|100 014462 aa 6 00120 7551 00 3803 sta pr6|80 restore record size 014463 aa 6 00050 2341 00 3804 szn pr6|mcode 014464 0a 000330 6000 00 3805 tze return_to_reset 3806 " 014465 0a 012000 2350 00 3807 lda io9_con status-key-1,2 014466 0a 012021 2360 00 3808 ldq s4430con status-key-3 014467 aa 6 00052 7571 00 3809 staq pr6|status12 014470 aa 000025 2210 03 3810 ldx1 21,du unable to write record 014471 0a 000326 7100 00 3811 tra io_return_to_reset 3812 "[3.0-1] 3813 "[3.0-1] alt_find_rec **********OPERATOR(92)********** 3814 "[3.0-1] 3815 "[3.0-1] 3816 " 014472 3817 alt_find_rec: 014472 3818 inhibit on 014472 aa 6 00101 7403 00 3819 stx0 pr6|return_to_main_off 014473 3820 inhibit off 3821 " 014473 aa 6 00120 6535 00 3822 spri7 pr6|80 set file descr ptr 014474 aa 6 00051 4501 00 3823 stz pr6|icode 014475 aa 6 00050 3735 00 3824 epp7 pr6|mcode mcode_ptr 014476 aa 6 00114 6535 00 3825 spri7 pr6|76 3826 " 014477 aa 000071 2350 07 3827 lda 57,dl RTS(57) 014500 aa 6 00110 7551 00 3828 sta pr6|rts_code if necessary then RESTORE_CRP 014501 0a 014504 3500 00 3829 epp0 return_from_alt_find 014502 aa 6 00024 2501 00 3830 spri0 pr6|stack_frame.return_ptr 014503 0a 000336 7100 00 3831 tra call_rts_from_op 3832 " 014504 3833 return_from_alt_find: 3834 " 014504 aa 6 00050 2341 00 3835 szn pr6|mcode 014505 0a 000330 6000 00 3836 tze return_to_reset 3837 " 014506 0a 014552 7100 00 3838 tra read_record_exit 3839 " 3840 " alt_rewrite **********OPERATOR(93)********** 3841 " 014507 3842 alt_rewrite: 014507 3843 inhibit on 014507 aa 6 00101 7403 00 3844 stx0 pr6|return_to_main_off 014510 3845 inhibit off 3846 " 014510 aa 6 00116 6515 00 3847 spri5 pr6|78 loc of buffer 014511 aa 6 00050 4501 00 3848 stz pr6|mcode mcode ptr 014512 aa 6 00050 3735 00 3849 epp7 pr6|mcode 014513 aa 6 00114 6535 00 3850 spri7 pr6|76 3851 " 014514 aa 000075 2350 07 3852 lda 61,dl RTS(61) 014515 aa 6 00110 7551 00 3853 sta pr6|rts_code 014516 0a 014374 3500 00 3854 epp0 return_from_rew_del 014517 aa 6 00024 2501 00 3855 spri0 pr6|stack_frame.return_ptr 014520 0a 000336 7100 00 3856 tra call_rts_from_op 3857 " 3858 " 3859 " read_record used by cobol_read_gen **********OPERATOR(66)********** 3860 " 014521 3861 nonseq_read_record: 014521 3862 inhibit on 014521 aa 6 00101 7403 00 3863 stx0 pr6|return_to_main_off 014522 3864 inhibit off 014522 aa 000001 2350 07 3865 lda 1,dl 014523 aa 6 00066 7551 00 3866 sta pr6|54 014524 0a 014527 7100 00 3867 tra read_common 3868 " 3869 " **********OPERATOR(65)********** 3870 " 3871 " 014525 3872 read_record: 014525 3873 inhibit on 014525 aa 6 00101 7403 00 3874 stx0 pr6|return_to_main_off 014526 3875 inhibit off 014526 aa 6 00066 4501 00 3876 stz pr6|54 014527 3877 read_common: 014527 aa 6 00126 3515 20 3878 epp1 pr6|86,* set iocb_ptr 014530 aa 6 00116 6515 00 3879 spri5 pr6|78 store buff_ptr 014531 aa 6 00116 3521 00 3880 epp2 pr6|78 014532 aa 6 00130 2521 00 3881 spri2 pr6|88 store pointer to buff_ptr 014533 aa 6 00120 3521 00 3882 epp2 pr6|80 014534 aa 6 00132 2521 00 3883 spri2 pr6|90 store pointer to buff_len 014535 aa 6 00057 4501 00 3884 stz pr6|47 014536 aa 6 00057 3521 00 3885 epp2 pr6|47 014537 aa 6 00134 2521 00 3886 spri2 pr6|92 length of record in bytes output 014540 aa 6 00050 3521 00 3887 epp2 pr6|mcode 014541 aa 6 00136 2521 00 3888 spri2 pr6|94 store pointer to mcode 3889 " RTS(63) 014542 aa 6 00050 4501 00 3890 stz pr6|mcode [5.3-1] 014543 aa 000077 2350 07 3891 lda 63,dl [5.3-1] 014544 aa 6 00110 7551 00 3892 sta pr6|rts_code [5.3-1] 014545 0a 014550 3500 00 3893 epp0 return_read_record 014546 aa 6 00024 2501 00 3894 spri0 pr6|stack_frame.return_ptr 014547 0a 000336 7100 00 3895 tra call_rts_from_op [5.3-1] 3896 even 014550 3897 return_read_record: 014550 aa 6 00050 2341 00 3898 szn pr6|mcode 014551 0a 000330 6000 00 3899 tze return_to_reset 014552 3900 read_record_exit: 014552 aa 6 00044 3701 20 3901 epp4 pr6|linkage_ptr,* 014553 aa 6 00050 3521 00 3902 epp2 pr6|mcode 014554 aa 6 00114 2521 00 3903 spri2 pr6|76 3904 " RTS(27) 014555 aa 000033 2350 07 3905 lda 27,dl 014556 aa 6 00110 7551 00 3906 sta pr6|rts_code 014557 0a 014562 3500 00 3907 epp0 return_read_record_exit 014560 aa 6 00024 2501 00 3908 spri0 pr6|stack_frame.return_ptr 014561 0a 000336 7100 00 3909 tra call_rts_from_op 3910 even 014562 3911 return_read_record_exit: 014562 aa 6 00050 2341 00 3912 szn pr6|mcode 014563 0a 000330 6000 00 3913 tze return_to_reset 014564 aa 000031 2210 03 3914 ldx1 25,du 014565 0a 000326 7100 00 3915 tra io_return_to_reset 3916 " 3917 " 3918 " init_start check file condition**********OPERATOR(21)********** 3919 " 3920 " 014566 3921 init_start: 014566 3922 inhibit on 014566 aa 6 00101 7403 00 3923 stx0 pr6|return_to_main_off 014567 3924 inhibit off 3925 " 014567 aa 6 00126 2515 00 3926 spri1 pr6|86 set fsb_ptr 014570 aa 6 00051 4501 00 3927 stz pr6|icode 014571 aa 1 00002 2341 00 3928 szn pr1|2 is file open 014572 aa 6 00046 6011 70 3929 tnz pr6|text_base_ptr,*0 YES 3930 " set status 014573 0a 012003 2350 00 3931 lda io30_con 014574 0a 012031 2360 00 3932 ldq s6031con 014575 aa 6 00052 7571 00 3933 staq pr6|status12 014576 aa 000030 2210 03 3934 ldx1 24,du attempt to perform io on unopened file 014577 0a 000326 7100 00 3935 tra io_return_to_reset 3936 " 3937 " 3938 " iox_$control perform control order on io switch.**********OPERATOR(23)********** 3939 " 3940 " 014600 3941 start_control: 014600 3942 inhibit on 014600 aa 6 00101 7403 00 3943 stx0 pr6|return_to_main_off 014601 3944 inhibit off 3945 " 014601 aa 6 00126 3515 20 3946 epp1 pr6|86,* set iocb_ptr 014602 aa 6 00060 6521 00 3947 spri6 pr6|48 store stack_offset ptr for order name 014603 aa 6 00062 6521 00 3948 spri6 pr6|50 014604 aa 6 00061 0651 00 3949 adx5 pr6|49 add base offset to x5 014605 aa 6 00061 7451 00 3950 stx5 pr6|49 set correct offset 014606 aa 000002 0650 03 3951 adx5 2,du 014607 aa 6 00063 7451 00 3952 stx5 pr6|51 014610 aa 6 00060 2515 20 3953 spri1 pr6|48,* store fsb pointer 014611 aa 6 00062 3521 20 3954 epp2 pr6|50,* 014612 aa 000002 0520 03 3955 adwp2 2,du 014613 aa 6 00062 2521 20 3956 spri2 pr6|50,* store control pointer 014614 aa 6 00050 3521 00 3957 epp2 pr6|40 014615 aa 6 00114 2521 00 3958 spri2 pr6|76 store mcode_ptr 3959 " RTS(11) 014616 aa 000013 2350 07 3960 lda 11,dl 014617 aa 6 00110 7551 00 3961 sta pr6|rts_code 014620 0a 014623 3500 00 3962 epp0 return_start_control 014621 aa 6 00024 2501 00 3963 spri0 pr6|stack_frame.return_ptr 014622 0a 000336 7100 00 3964 tra call_rts_from_op iox_control 3965 " 014623 3966 return_start_control: 014623 aa 6 00050 2341 00 3967 szn pr6|mcode 014624 0a 000330 6000 00 3968 tze return_to_reset 3969 " set status 014625 aa 000046 2210 03 3970 ldx1 38,du unable to start a file with specified key 014626 0a 000326 7100 00 3971 tra io_return_to_reset 3972 " 3973 " close_reel **********OPERATOR(76)********** 3974 " 014627 3975 close_reel: 014627 3976 inhibit on 014627 aa 6 00101 7403 00 3977 stx0 pr6|return_to_main_off 014630 3978 inhibit off 014630 aa 1 00002 2351 00 3979 lda pr1|2 get open_mode 014631 0a 014733 6000 00 3980 tze file_unopen file not open yet, error 014632 0a 012051 3500 00 3981 epp0 ptr_desc 014633 aa 6 00144 2501 00 3982 spri0 pr6|100 014634 aa 6 00150 2501 00 3983 spri0 pr6|104 014635 0a 012052 3500 00 3984 epp0 fb35_desc 014636 aa 6 00152 2501 00 3985 spri0 pr6|106 014637 aa 6 00134 2515 00 3986 spri1 pr6|92 set parameter for iocb_ptr 014640 aa 6 00114 3501 00 3987 epp0 pr6|76 tvstat_ptr for input reel 014641 aa 6 00140 2501 00 3988 spri0 pr6|96 014642 aa 6 00050 3501 00 3989 epp0 pr6|mcode mcode_ptr 014643 aa 6 00142 2501 00 3990 spri0 pr6|98 014644 aa 000025 1150 07 3991 cmpa 21,dl input reel? 014645 0a 014663 6000 00 3992 tze input_reel yes 014646 aa 000021 1150 07 3993 cmpa 17,dl input reel? 014647 0a 014663 6000 00 3994 tze input_reel yes 014650 0a 004002 2370 00 3995 ldaq null_con 014651 aa 6 00114 7571 00 3996 staq pr6|76 null info_ptr 014652 0a 012047 3500 00 3997 epp0 feov_desc 014653 aa 6 00146 2501 00 3998 spri0 pr6|102 014654 0a 012050 3500 00 3999 epp0 feov_con char "feov" 014655 aa 6 00136 2501 00 4000 spri0 pr6|94 014656 aa 6 00132 6211 00 4001 eax1 pr6|90 014657 aa 020000 4310 07 4002 fld 8192,dl 014660 aa 1 00000 3521 20 4003 epp2 pr1|0,* iocb_ptr 014661 aa 2 00066 3521 00 4004 epp2 pr2|54 entry iocb.control 014662 0a 000137 7100 00 4005 tra call_ent_var_desc_from_op 014663 4006 input_reel: 014663 aa 6 00130 2501 00 4007 spri0 pr6|88 parameter mcode_ptr for position call 014664 aa 6 00122 2515 00 4008 spri1 pr6|82 014665 0a 012042 3500 00 4009 epp0 volume_desc 014666 aa 6 00146 2501 00 4010 spri0 pr6|102 014667 0a 012043 3500 00 4011 epp0 volume_con char "volume_status" 014670 aa 6 00136 2501 00 4012 spri0 pr6|94 014671 0a 004121 3500 00 4013 epp0 zero_con type 0 014672 aa 6 00124 2501 00 4014 spri0 pr6|84 014673 0a 004122 3500 00 4015 epp0 one_con 1 record for each position operation 014674 aa 6 00126 2501 00 4016 spri0 pr6|86 014675 aa 6 00116 4501 00 4017 stz pr6|78 initialize volume no. for comparison 014676 4018 vol_call: 014676 aa 6 00132 6211 00 4019 eax1 pr6|90 014677 aa 020000 4310 07 4020 fld 8192,dl 4 parameters 014700 aa 6 00134 3515 20 4021 epp1 pr6|92,* fsb_ptr 014701 aa 1 00000 3521 20 4022 epp2 pr1|0,* iocb_ptr 014702 aa 2 00066 3521 00 4023 epp2 pr2|54 iocb.control 014703 0a 014706 3500 00 4024 epp0 return_from_vol_call 014704 aa 6 00024 2501 00 4025 spri0 pr6|stack_frame.return_ptr 014705 0a 000137 7100 00 4026 tra call_ent_var_desc_from_op 014706 4027 return_from_vol_call: 014706 aa 6 00050 2341 00 4028 szn pr6|mcode check error code 014707 0a 014745 6010 00 4029 tnz reel_exit 014710 4030 vol_call_ok: 014710 aa 6 00114 3515 20 4031 epp1 pr6|76,* tvstat_ptr 014711 aa 1 00003 2351 00 4032 lda pr1|3 volume sequence no. 014712 aa 6 00116 2341 00 4033 szn pr6|78 first call? 014713 0a 014716 6010 00 4034 tnz vol_comp no, goto compare 014714 aa 6 00116 7551 00 4035 sta pr6|78 yes. save vol seq no. 014715 0a 014720 7100 00 4036 tra posi_call call position operation 014716 4037 vol_comp: 014716 aa 6 00116 1151 00 4038 cmpa pr6|78 comparing vol seq nos 014717 0a 014745 6010 00 4039 tnz reel_exit not equal, done. 014720 4040 posi_call: 014720 aa 6 00120 6211 00 4041 eax1 pr6|80 014721 aa 020000 4310 07 4042 fld 8192,dl 014722 aa 6 00122 3515 20 4043 epp1 pr6|82,* fsb_ptr 014723 aa 1 00000 3521 20 4044 epp2 pr1|0,* iocb_ptr 014724 aa 2 00062 3521 00 4045 epp2 pr2|50 position entry 014725 0a 014730 3500 00 4046 epp0 return_from_posi_call 014726 aa 6 00024 2501 00 4047 spri0 pr6|stack_frame.return_ptr 014727 0a 000143 7100 00 4048 tra call_ent_var_from_op 014730 4049 return_from_posi_call: 014730 aa 6 00050 2341 00 4050 szn pr6|mcode check mocde 014731 0a 014676 6000 00 4051 tze vol_call next volume_status call 014732 0a 014745 7100 00 4052 tra reel_exit return 014733 4053 file_unopen: 014733 aa 1 00132 2351 00 4054 lda pr1|90 optional bit 014734 0a 012040 1150 00 4055 cmpa optional_int optional internal 014735 0a 000330 6000 00 4056 tze return_to_reset 014736 0a 012041 1150 00 4057 cmpa optional_ext optional external 014737 0a 000330 6000 00 4058 tze return_to_reset 014740 0a 012003 2350 00 4059 lda io30_con 014741 0a 012012 2360 00 4060 ldq s2036con 014742 aa 6 00052 7571 00 4061 staq pr6|status12 014743 aa 000021 2210 03 4062 ldx1 17,du 014744 0a 013066 7100 00 4063 tra return_thru_text_base_pone 014745 4064 reel_exit: 014745 aa 6 00134 3515 20 4065 epp1 pr6|92,* 014746 0a 000330 7100 00 4066 tra return_to_reset 4067 " 4068 " 4069 " 4070 " 4071 " Please insert the next operator before this line. 4072 " 4073 " 014747 4074 segdef cobol_operators_end 014747 4075 cobol_operators_end: 014747 aa 000000 000000 4076 oct 0 4077 include cobol_operators_info 7-1 " File State Block 7-2 " 7-3 " 7-4 " 0 iocb_ptr ptr 7-5 " 1 7-6 " 2 open_mode fb 7-7 " 3 max_cra_size fb 7-8 " 4 relkeylen fb 7-9 " 5 relkey fb 7-10 " 6 keylen_sw fb length of key 7-11 " 7 key char(256) key for read, start 7-12 " ...... 7-13 " 71 open_close_name char(68) 7-14 " ...... 7-15 " 88 linage_counter char(8) 7-16 " 89 7-17 " 90 indicators bit(36) 7-18 " 7-19 " cobol_fsb.incl.pl1 7-20 " 7-21 " 91 page_size_reset fb 7-22 " 92 page_size fb 7-23 " 93 footing_size fb 7-24 " 94 top_size fb 7-25 " 95 bottom_size fb 7-26 " 96 --- 7-27 " 7-28 " cobol_make_link 7-29 " 7-30 " 91 dynkey_len fb 7-31 " 92 dynkey char(256) 7-32 " ...... 7-33 " 156 --- 7-34 " 7-35 " cobol_fsbskel.incl.pl1 7-36 " 7-37 " 91 vfile_open_mode fb 7-38 " 92 file_desc_ptr ptr 7-39 " 93 7-40 " 94 cobol_open_mode fb 7-41 " 95 last_cobol_op fb 7-42 " 96 code fb 7-43 " 97 key_of_ref fb 7-44 " 98 crp.prime_key char(256) varying 7-45 " ...... 7-46 " 163 crp.alt_key char(256) varying 7-47 " ...... 7-48 " 238 --- 4078 end LITERALS 014750 aa 000400 000000 NAME DEFINITIONS FOR ENTRY POINTS AND SEGDEFS 014751 5a 000003 000000 014752 5a 000102 600000 014753 aa 000000 000000 014754 55 000013 000002 014755 5a 000002 400003 014756 55 000006 000013 014757 aa 020 143 157 142 014760 aa 157 154 137 157 014761 aa 160 145 162 141 014762 aa 164 157 162 163 014763 aa 137 000 000 000 014764 55 000023 000003 014765 0a 014747 400000 014766 55 000016 000003 014767 aa 023 143 157 142 cobol_operators_end 014770 aa 157 154 137 157 014771 aa 160 145 162 141 014772 aa 164 157 162 163 014773 aa 137 145 156 144 014774 55 000034 000013 014775 0a 000654 400000 014776 55 000026 000003 014777 aa 024 143 157 142 cobol_opch_operator_ 015000 aa 157 154 137 157 015001 aa 160 143 150 137 015002 aa 157 160 145 162 015003 aa 141 164 157 162 015004 aa 137 000 000 000 015005 55 000043 000023 015006 0a 000206 400000 015007 55 000037 000003 015010 aa 017 145 156 164 entry_version_1 015011 aa 162 171 137 166 015012 aa 145 162 163 151 015013 aa 157 156 137 061 015014 55 000054 000034 015015 0a 000164 400000 015016 55 000046 000003 015017 aa 025 164 162 141 trace_entry_version_1 015020 aa 143 145 137 145 015021 aa 156 164 162 171 015022 aa 137 166 145 162 015023 aa 163 151 157 156 015024 aa 137 061 000 000 015025 55 000064 000043 015026 0a 000000 400000 015027 55 000057 000003 015030 aa 020 143 157 142 cobol_operators_ 015031 aa 157 154 137 157 015032 aa 160 145 162 141 015033 aa 164 157 162 163 015034 aa 137 000 000 000 015035 55 000073 000054 015036 0a 000000 400000 015037 55 000067 000003 015040 aa 016 157 160 145 operator_table 015041 aa 162 141 164 157 015042 aa 162 137 164 141 015043 aa 142 154 145 000 015044 55 000002 000064 015045 6a 000000 400002 015046 55 000076 000003 015047 aa 014 163 171 155 symbol_table 015050 aa 142 157 154 137 015051 aa 164 141 142 154 015052 aa 145 000 000 000 DEFINITIONS HASH TABLE 015053 aa 000000 000015 015054 5a 000064 000000 015055 aa 000000 000000 015056 aa 000000 000000 015057 aa 000000 000000 015060 5a 000013 000000 015061 5a 000043 000000 015062 5a 000054 000000 015063 5a 000073 000000 015064 aa 000000 000000 015065 5a 000034 000000 015066 aa 000000 000000 015067 aa 000000 000000 015070 5a 000023 000000 EXTERNAL NAMES 015071 aa 012 143 141 164 catch_pl1_ 015072 aa 143 150 137 160 015073 aa 154 061 137 000 015074 aa 005 164 162 141 trace 015075 aa 143 145 000 000 NO TRAP POINTER WORDS TYPE PAIR BLOCKS 015076 aa 000004 000000 015077 55 000123 000120 015100 aa 000001 000000 015101 aa 000000 000000 INTERNAL EXPRESSION WORDS 015102 5a 000125 000000 015103 aa 000000 000000 LINKAGE INFORMATION 000000 aa 000000 000000 000001 0a 014751 000000 000002 aa 000000 000000 000003 aa 000000 000000 000004 aa 000000 000000 000005 aa 000000 000000 000006 22 000010 000012 000007 a2 000000 000000 000010 9a 777770 0000 46 trace|catch_pl1_ 000011 5a 000131 0000 00 SYMBOL INFORMATION SYMBOL TABLE HEADER 000000 aa 000000 000001 000001 aa 163171 155142 000002 aa 164162 145145 000003 aa 000000 000010 000004 aa 000000 116606 000005 aa 116110 132154 000006 aa 000000 117220 000007 aa 250310 105222 000010 aa 141154 155040 000011 aa 040040 040040 000012 aa 000024 000040 000013 aa 000034 000040 000014 aa 000044 000100 000015 aa 000002 000002 000016 aa 000064 000000 000017 aa 000000 001167 000020 aa 000000 000243 000021 aa 001136 001132 000022 aa 001153 000243 000023 aa 000064 000000 000024 aa 101114 115040 000025 aa 126145 162163 000026 aa 151157 156040 000027 aa 070056 061063 000030 aa 040123 145160 000031 aa 164145 155142 000032 aa 145162 040061 000033 aa 071070 070040 000034 aa 110151 162156 000035 aa 145151 163145 000036 aa 156056 123171 000037 aa 163115 141151 000040 aa 156164 056141 000041 aa 040040 040040 000042 aa 040040 040040 000043 aa 040040 040040 000044 aa 055164 141162 000045 aa 147145 164040 000046 aa 154066 070040 000047 aa 040040 040040 000050 aa 040040 040040 000051 aa 040040 040040 000052 aa 040040 040040 000053 aa 040040 040040 000054 aa 040040 040040 000055 aa 040040 040040 000056 aa 040154 151163 000057 aa 164040 163171 000060 aa 155142 157154 000061 aa 163040 040040 000062 aa 040040 040040 000063 aa 040040 040040 000064 aa 000000 000001 000065 aa 000000 000010 000066 aa 000126 000056 000067 aa 172113 321123 000070 aa 000000 117220 000071 aa 217346 000000 000072 aa 000142 000042 000073 aa 147777 464111 000074 aa 000000 115000 000075 aa 507463 000000 000076 aa 000153 000041 000077 aa 052721 247134 000100 aa 000000 105272 000101 aa 317215 400000 000102 aa 000164 000036 000103 aa 043243 127522 000104 aa 000000 101621 000105 aa 351621 000000 000106 aa 000174 000046 000107 aa 106701 742403 000110 aa 000000 110670 000111 aa 212655 000000 000112 aa 000206 000046 000113 aa 106701 742166 000114 aa 000000 110670 000115 aa 212510 200000 000116 aa 000220 000035 000117 aa 043243 130223 000120 aa 000000 102727 000121 aa 712743 600000 000122 aa 000230 000052 000123 aa 106701 742216 000124 aa 000000 110670 000125 aa 212533 000000 000126 aa 076163 160145 >spec>install>MR12.3-1048>cobol_operators_.alm 000127 aa 143076 151156 000130 aa 163164 141154 000131 aa 154076 115122 000132 aa 061062 056063 000133 aa 055061 060064 000134 aa 070076 143157 000135 aa 142157 154137 000136 aa 157160 145162 000137 aa 141164 157162 000140 aa 163137 056141 000141 aa 154155 040040 000142 aa 076154 144144 >ldd>include>stack_header.incl.alm 000143 aa 076151 156143 000144 aa 154165 144145 000145 aa 076163 164141 000146 aa 143153 137150 000147 aa 145141 144145 000150 aa 162056 151156 000151 aa 143154 056141 000152 aa 154155 040040 000153 aa 076154 144144 >ldd>include>stack_frame.incl.alm 000154 aa 076151 156143 000155 aa 154165 144145 000156 aa 076163 164141 000157 aa 143153 137146 000160 aa 162141 155145 000161 aa 056151 156143 000162 aa 154056 141154 000163 aa 155040 040040 000164 aa 076154 144144 >ldd>include>eis_bits.incl.alm 000165 aa 076151 156143 000166 aa 154165 144145 000167 aa 076145 151163 000170 aa 137142 151164 000171 aa 163056 151156 000172 aa 143154 056141 000173 aa 154155 040040 000174 aa 076154 144144 >ldd>include>cobol_op_fix_con.incl.alm 000175 aa 076151 156143 000176 aa 154165 144145 000177 aa 076143 157142 000200 aa 157154 137157 000201 aa 160137 146151 000202 aa 170137 143157 000203 aa 156056 151156 000204 aa 143154 056141 000205 aa 154155 040040 000206 aa 076154 144144 >ldd>include>cobol_op_var_con.incl.alm 000207 aa 076151 156143 000210 aa 154165 144145 000211 aa 076143 157142 000212 aa 157154 137157 000213 aa 160137 166141 000214 aa 162137 143157 000215 aa 156056 151156 000216 aa 143154 056141 000217 aa 154155 040040 000220 aa 076154 144144 >ldd>include>on_unit.incl.alm 000221 aa 076151 156143 000222 aa 154165 144145 000223 aa 076157 156137 000224 aa 165156 151164 000225 aa 056151 156143 000226 aa 154056 141154 000227 aa 155040 040040 000230 aa 076154 144144 >ldd>include>cobol_operators_info.incl.alm 000231 aa 076151 156143 000232 aa 154165 144145 000233 aa 076143 157142 000234 aa 157154 137157 000235 aa 160145 162141 000236 aa 164157 162163 000237 aa 137151 156146 000240 aa 157056 151156 000241 aa 143154 056141 000242 aa 154155 040040 MULTICS ASSEMBLY CROSS REFERENCE LISTING Value Symbol Source file Line number 5 a eis_bits: 9. 1 ab cobol_operators_: 121. 12556 accept_comm cobol_operators_: 214, 2210. 13560 accept_date cobol_operators_: 187, 3049. 13564 accept_day cobol_operators_: 188, 3062. 13632 accept_day_of_week cobol_operators_: 190, 3118. 13555 accept_error cobol_operators_: 3024, 3039. 13521 accept_line cobol_operators_: 163, 3005. 13601 accept_time cobol_operators_: 189, 3085. 12170 add_on cobol_operators_: 1778, 1783. 5 al eis_bits: 10. 14423 alt_add_write_keys cobol_operators_: 233, 3751. 12655 alt_close_file cobol_operators_: 232, 2341. 14354 alt_delete cobol_operators_: 229, 3675. 14472 alt_find_rec cobol_operators_: 235, 3817. 14363 alt_key_delete cobol_operators_: 230, 3693. 13225 alt_open_file cobol_operators_: 221, 2746. 14323 alt_read_key cobol_operators_: 227, 3625. 14242 alt_read_next cobol_operators_: 223, 3525. 14252 alt_read_record cobol_operators_: 224, 3546. 14507 alt_rewrite cobol_operators_: 236, 3842. 14403 alt_rewrite_add cobol_operators_: 231, 3722. 14262 alt_seek_key cobol_operators_: 225, 3567. 14335 alt_special_delete cobol_operators_: 228, 3648. 14232 alt_start cobol_operators_: 222, 3504. 14274 alt_start_control cobol_operators_: 226, 3591. 14444 alt_write_seek_key cobol_operators_: 234, 3782. 1 and eis_bits: 23. 0 ap cobol_operators_: 120. 100 ar eis_bits: 1. 4400 ascii_ebcdic cobol_op_fix_con: 179. 12036 atd_con cobol_operators_: 2667, cobol_op_var_con: 44. 13166 attach_iocb cobol_operators_: 177, 2698. 1 au eis_bits: 5. 1033 bad_oph cobol_operators_: 1198, 1212. 3 bb cobol_operators_: 123. 4164 bin_18 cobol_op_fix_con: 149. 40 blank cobol_operators_: 126. 12457 blanks cobol_operators_: 2052, 2079. 2 bp cobol_operators_: 122. 1037 calc_length cobol_operators_: 963, 1069, 1221. 1065 calc_length_return cobol_operators_: 1274, 1283. 16 call_cnt cobol_operators_: 111, 391, 421, 422. 142 call_ent_var cobol_operators_: 144, 260. 141 call_ent_var_desc cobol_operators_: 143, 257. 137 call_ent_var_desc_from_op cobol_operators_: 254, 4005, 4026. 143 call_ent_var_from_op cobol_operators_: 256, 264, 678, 717, 749, 2825, 2917, 2952, 2987, 3199, 3245, 3296, 3358, 3387, 3484, 4048. 155 call_ext_in cobol_operators_: 147, 287. 154 call_ext_in_desc cobol_operators_: 145, 283. 152 call_ext_in_desc_from_op cobol_operators_: 279. 156 call_ext_in_from_op cobol_operators_: 282, 292. 155 call_ext_out cobol_operators_: 149, 288. 154 call_ext_out_desc cobol_operators_: 148, 284. 152 call_ext_out_desc_from_op cobol_operators_: 280. 156 call_ext_out_from_op cobol_operators_: 293. 1170 call_offset stack_header: 80. 333 call_rts cobol_operators_: 464. 336 call_rts_from_op cobol_operators_: 398, 471, 684, 1688, 1824, 1848, 1871, 1921, 1987, 2352, 2384, 2398, 2412, 2427, 2449, 2642, 2716, 2763, 2844, 2929, 2999, 3020, 3056, 3071, 3093, 3127, 3167, 3213, 3258, 3415, 3497, 3515, 3536, 3557, 3580, 3612, 3639, 3664, 3684, 3706, 3735, 3765, 3799, 3831, 3856, 3895, 3909, 3964. 335 call_rts_load_code cobol_operators_: 468, 2170, 2181, 2193, 2207, 2215, 2223, 2231, 2239, 2247. 334 call_rts_special cobol_operators_: 466. 12713 cancel cobol_operators_: 192, 2418. catch_pl1_ cobol_operators_: 353. 12470 char_count cobol_operators_: 2062, 2088. 13140 check_attach cobol_operators_: 176, 2655. 13254 check_file cobol_operators_: 180, 2791. 13375 check_if_open cobol_operators_: 2892, 2895. 715 check_target_sign cobol_operators_: 994, 1000. 0 clear eis_bits: 27. 12651 close_file cobol_operators_: 170, 2330. 13411 close_file_begin cobol_operators_: 2902, 2910. 12665 close_file_only cobol_operators_: 181, 2362. 13431 close_ok cobol_operators_: 2897, 2922, 2931. 13155 close_op_file cobol_operators_: 172, 2679. 14627 close_reel cobol_operators_: 219, 3975. 1 cobol_code cobol_operators_: 84. 10 cobol_data_ptr cobol_operators_: 107, 411, 414. 12054 cobol_error cobol_operators_: 1544, 1545, 1547, 1548, 1552, 1553, 1554, 1555, 1556, 1557, 1559, 1560, 1562, 1563, 1566, 1567, 1568, 1570, 1571, 1572, 1573, 1578, 1579, 1582, 1584, 1591, 1592, 1593, 1595, 1596, 1597, 1598, 1599, 1641, 1719, 2507, 2550. 12132 cobol_error_53 cobol_operators_: 1594, 1701, 1831, 1855, 1880, 1928. 131 cobol_error_code cobol_operators_: 103, 508. 12134 cobol_error_from_op cobol_operators_: 509, 1712, 3042. 12053 cobol_error_no_mcode cobol_operators_: 1542, 1543, 1546, 1549, 1550, 1551, 1558, 1561, 1564, 1565, 1569, 1574, 1575, 1576, 1577, 1580, 1581, 1583, 1585, 1586, 1587, 1588, 1589, 1590, 1600, 1601, 1602, 1603, 1604, 1605, 1606, 1607, 1608, 1609, 1610, 1611, 1612, 1613, 1614, 1615, 1616, 1617, 1618, 1619, 1620, 1621, 1622, 1623, 1639. 654 cobol_opch_operator_ cobol_operators_: 817, 885, 921. 0 cobol_operators_ cobol_operators_: 75, 128, 2122. 14747 cobol_operators_end cobol_operators_: 4074, 4075. 1017 common1 cobol_operators_: 1175, 1182. 12451 compare_next_word cobol_operators_: 2071, 2076. 12 control_ptr cobol_operators_: 108, 404, 1919, 1965, 2164, 2300. 13054 cont_open_ext cobol_operators_: 2565, 2573. 13101 cont_open_int cobol_operators_: 2599, 2606. 457 cont_write_stream cobol_operators_: 608, 612. 4000 con_sec cobol_op_fix_con: 23. 4016 dce_con cobol_op_fix_con: 45. 1107 dec_ns_source_desc cobol_operators_: 967, 1335. 1111 dec_ns_temp_source_desc cobol_operators_: 1341. 1106 dec_ts_target_desc cobol_operators_: 1079, 1332. 1105 dec_ts_temp_source_desc cobol_operators_: 1078, 1329. 13770 delete cobol_operators_: 196, 3267. 13657 delete_error cobol_operators_: 197, 3159. 42 descriptor_ptr cobol_operators_: 88, 362, 535, 2512. 13040 desc_error cobol_operators_: 2539, 2548. 13032 desc_exit cobol_operators_: 2532, 2541. 13015 desc_join cobol_operators_: 2522, 2526. 13020 desc_loop cobol_operators_: 2530, 2540. 12747 desc_mask cobol_operators_: 2481, 2492. 13466 detach_ok cobol_operators_: 2956, 2964. 13433 detach_op cobol_operators_: 2899, 2901, 2934. 1123 digit_table cobol_operators_: 1204, 1362. 12572 disable_comm cobol_operators_: 218, 2242. 353 display_op cobol_operators_: 495, 503. 40 display_ptr cobol_operators_: 87. 342 dsply_error_output cobol_operators_: 171, 488. 347 dsply_user_output cobol_operators_: 169, 496. 3 du eis_bits: 7. 4600 ebcdic_ascii cobol_op_fix_con: 312. 221 eed cobol_operators_: 354, 356. 1114 empty1 cobol_operators_: 1352. 1171 empty2 cobol_operators_: 1403. 12152 enable cobol_operators_: 151, 1765. 12152 enable_1 cobol_operators_: 152, 1761. 12567 enable_comm cobol_operators_: 217, 2234. 1174 entry_offset stack_header: 84. 0 entry_operators cobol_operators_: 142. 206 entry_version_1 cobol_operators_: 355. 14056 eof_position cobol_operators_: 3331, 3342. 12312 establish_cleanup cobol_operators_: 159, 1944. 12052 fb35_desc cobol_operators_: 3984, cobol_op_var_con: 56. 12050 feov_con cobol_operators_: 3999, cobol_op_var_con: 54. 12047 feov_desc cobol_operators_: 3997, cobol_op_var_con: 53. 14 file_info_ptr cobol_operators_: 110, 2296, 2308, 2312, 2318. 14733 file_unopen cobol_operators_: 3980, 4053. 13110 find_iocb cobol_operators_: 175, 2622. 12406 find_unit cobol_operators_: 2010, 2030. 635 finish_curr_page cobol_operators_: 774, 782. 635 force_page cobol_operators_: 763, 781. 162 forward_call cobol_operators_: 304. 12413 get_length cobol_operators_: 2033, 2036. 14175 get_line cobol_operators_: 207, 3463. 12174 have_on cobol_operators_: 1780, 1787. 12037 high_con cobol_operators_: 2874, cobol_op_var_con: 45. 4 ic eis_bits: 8. 51 icode cobol_operators_: 95, 551, 3145, 3435, 3455, 3823, 3927. 20 id eis_bits: 3. 164 ind_mask cobol_operators_: 109, 409, 410, 435. 12731 init_cd cobol_operators_: 220, 2457. 12742 init_cd_space cobol_operators_: 2463, 2469. 13645 init_delete cobol_operators_: 199, 3140. 14147 init_read cobol_operators_: 206, 3430. 231 init_stack_join cobol_operators_: 366. 14566 init_start cobol_operators_: 164, 3921. 412 init_write cobol_operators_: 182, 546. 14663 input_reel cobol_operators_: 3992, 3994, 4006. 732 insert_neg_op cobol_operators_: 1023, 1030. 723 insert_op_sign cobol_operators_: 1010, 1019. 1066 insert_scale_factor cobol_operators_: 969, 1080, 1291. 12721 inspect_replace cobol_operators_: 194, 2432. 12724 inspect_tally cobol_operators_: 193, 2441. 14 invert eis_bits: 28. 12001 io10_con cobol_operators_: 3452, cobol_op_var_con: 15. 12002 io22_con cobol_op_var_con: 16. 12003 io30_con cobol_operators_: 555, 617, 658, 722, 2567, 2580, 2601, 2610, 2647, 2722, 2904, 2959, 3149, 3276, 3323, 3393, 3446, 3931, 4059, cobol_op_var_con: 17. 12000 io9_con cobol_operators_: 3712, 3741, 3771, 3807, cobol_op_var_con: 14. 326 io_return_to_reset cobol_operators_: 446, 506, 611, 621, 657, 661, 726, 2651, 2726, 2850, 2908, 2927, 2963, 2997, 3218, 3261, 3280, 3317, 3327, 3380, 3397, 3424, 3457, 3618, 3716, 3745, 3775, 3811, 3915, 3935, 3971. 607 linage cobol_operators_: 195, 756. 12130 line_mask cobol_operators_: 1672, 1691. 12115 line_no_done cobol_operators_: 1654, 1666, 1677. 44 linkage_ptr cobol_operators_: 89, 364, 419, 436, 529, 680, 947, 1714, 2025, 2320, 2827, 2846, 2920, 2990, 3205, 3250, 3489, 3901. 13007 loop_compare cobol_operators_: 2518, 2547. 12460 masks1 cobol_operators_: 2051, 2080. 12464 masks2 cobol_operators_: 2067, 2084. 4004 mask_con cobol_operators_: 2298, 2663, 2799, cobol_op_fix_con: 30. 107 maxpr cobol_operators_: 85. 50 mcode cobol_operators_: 94, 505, 571, 613, 652, 669, 698, 719, 741, 1640, 1686, 1711, 2489, 2752, 2886, 2921, 2955, 2977, 2991, 3190, 3203, 3206, 3215, 3236, 3248, 3251, 3273, 3288, 3316, 3320, 3379, 3390, 3417, 3476, 3487, 3490, 3606, 3614, 3657, 3698, 3699, 3709, 3727, 3728, 3738, 3757, 3758, 3768, 3791, 3793, 3804, 3824, 3835, 3848, 3849, 3887, 3890, 3898, 3902, 3912, 3967, 3989, 4028, 4050. 12545 merge_comp cobol_operators_: 204, 2176. 12513 merge_init cobol_operators_: 203, 2142. 12550 merge_return cobol_operators_: 205, 2188. 1117 minus_dec_op_sign_table cobol_operators_: 1035, 1357. 3 move eis_bits: 22. 1164 mvt_data1 cobol_operators_: 1397. 1202 mvt_data2 cobol_operators_: 1413. 1203 mvt_data3 cobol_operators_: 1415. 1144 mvt_table cobol_operators_: 1190, 1380. 16 nand eis_bits: 25. 4075 neg_con cobol_op_fix_con: 94. 12435 next_length cobol_operators_: 2055, 2058. 12434 next_on_unit cobol_operators_: 2056, 2064, 2069, 2077. 12426 next_word cobol_operators_: 2045, 2049. 14521 nonseq_read_record cobol_operators_: 209, 3861. 4002 null_con cobol_operators_: 1905, 2013, 2167, 2297, 2314, 2662, 2798, 3995, cobol_op_fix_con: 29. 12773 n_args_error cobol_operators_: 2501, 2505. 4122 one_con cobol_operators_: 4015, cobol_op_fix_con: 115. 12164 on_1 cobol_operators_: 1779, 1782. 2 on_unit.body cobol_operators_: 1788, 1967, 2015, on_unit: 5. 6 on_unit.file on_unit: 9. 10 on_unit.file_copy on_unit: 10. 5 on_unit.flags cobol_operators_: 1792, 1971, on_unit: 8. 0 on_unit.name cobol_operators_: 1787, 1963, 2014, 2065, on_unit: 4. 5 on_unit.next cobol_operators_: 1781, 1785, 1960, 2020, 2057, on_unit: 7. 4 on_unit.size cobol_operators_: 1789, 1790, 1969, 2012, 2063, on_unit: 6. 36 on_unit_ptr cobol_operators_: 90. 654 opch cobol_operators_: 150, 818. 666 opch_dest cobol_operators_: 936, 942. 757 opch_opch cobol_operators_: 943, 1097. 42 opch_opch_ret cobol_operators_: 904, 1099, 1151. 662 opch_source cobol_operators_: 929, 933. 1110 opch_target_desc cobol_operators_: 968, 1338. 740 opch_udts cobol_operators_: 939, 1051, 1121. 41 opch_udts_ret cobol_operators_: 903, 1053, 1090. 13243 open_close_file cobol_operators_: 179, 2774. 13042 open_ext_file cobol_operators_: 173, 2559. 13215 open_file cobol_operators_: 178, 2731. 13070 open_int_file cobol_operators_: 174, 2593. 13334 open_ok cobol_operators_: 2690, 2741, 2852. 667 operator_exit cobol_operators_: 931, 940, 945. 0 operator_table cobol_operators_: 74, 135, 371, 538. 12041 optional_ext cobol_operators_: 2836, 2859, 2893, 3443, 4057, cobol_op_var_con: 47. 12040 optional_int cobol_operators_: 2834, 2857, 2891, 3441, 4055, cobol_op_var_con: 46. 37 op_return_offset cobol_operators_: 91. 721 op_ts cobol_operators_: 1005, 1012. 0 op_vector cobol_operators_: 141. 7 or eis_bits: 24. 12746 pack_mask cobol_operators_: 2479, 2534, 2537. 1114 plus_dec_op_sign_table cobol_operators_: 1028, 1351. 1113 plus_sign cobol_operators_: 986, 1347. 14720 posi_call cobol_operators_: 4036, 4040. 156 pr3_save cobol_operators_: 117, 413, 437, 526, 948, 1794, 2026, 2286. 154 pr4_save cobol_operators_: 115, 389, 403, 492, 500, 528, 1655, 1900, 1918, 1964, 2148, 2163, 2295, 2393, 2407, 2865, 2941. 160 pr5_save cobol_operators_: 118, 416, 438, 527, 949, 1795. 12421 previous_char cobol_operators_: 2043, 2053. 10 pr_store cobol_operators_: 898, 1103, 1142. 12051 ptr_desc cobol_operators_: 3981, cobol_op_var_con: 55. 12561 purge_comm cobol_operators_: 215, 2218. 1171 push_offset stack_header: 81. 6 q eis_bits: 11. 6 ql eis_bits: 12. 2 qu eis_bits: 6. 14527 read_common cobol_operators_: 3867, 3877. 13675 read_delete_join cobol_operators_: 3188. 13664 read_key cobol_operators_: 198, 3176. 13727 read_key_for_read cobol_operators_: 212, 3223. 14167 read_optional cobol_operators_: 3442, 3444, 3451. 14525 read_record cobol_operators_: 208, 3872. 14552 read_record_exit cobol_operators_: 3838, 3900. 466 read_seek_key cobol_operators_: 210, 627. 12504 real_to_real cobol_operators_: 158, 2118. 12553 receive_comm cobol_operators_: 213, 2202. 14745 reel_exit cobol_operators_: 4029, 4039, 4052, 4064. 54 retrycode cobol_operators_: 98, 507, 734, 2898, 2958. 13552 return_accept cobol_operators_: 3027, 3035. 14317 return_alt_start_control cobol_operators_: 3610, 3613. 13206 return_attach_iocb cobol_operators_: 2714, 2718. 12402 return_cond cobol_operators_: 1972, 2019, 2023, 2038, 2047, 2059. 13131 return_find_iocb cobol_operators_: 2640, 2643. 13754 return_for_read_key cobol_operators_: 3243, 3247. 13536 return_from_accept cobol_operators_: 3018, 3022. 14435 return_from_alt_add cobol_operators_: 3763, 3767. 12664 return_from_alt_close cobol_operators_: 2350, 2354. 14504 return_from_alt_find cobol_operators_: 3829, 3833. 14362 return_from_alt_fsb cobol_operators_: 3682, 3686. 14261 return_from_alt_key cobol_operators_: 3555, 3559. 13242 return_from_alt_open cobol_operators_: 2761, 2765. 14251 return_from_alt_read cobol_operators_: 3534, 3538. 14334 return_from_alt_read_key cobol_operators_: 3637, 3641. 14273 return_from_alt_seek cobol_operators_: 3578, 3582. 14351 return_from_alt_spec cobol_operators_: 3662, 3666. 14241 return_from_alt_start cobol_operators_: 3513, 3517. 320 return_from_call cobol_operators_: 401, 434, 454, 456, 524, 1715, 2500, 2511, 2544. 266 return_from_control cobol_operators_: 392, 394, 400. 13572 return_from_day cobol_operators_: 3066, 3073. 13640 return_from_dow cobol_operators_: 3122, 3129. 13420 return_from_io_close cobol_operators_: 2915, 2919. 13510 return_from_io_close_only cobol_operators_: 2985, 2989. 13456 return_from_io_detach cobol_operators_: 2950, 2954. 13306 return_from_open cobol_operators_: 2823, 2826. 13326 return_from_open_rts cobol_operators_: 2842, 2845. 316 return_from_pl1_op cobol_operators_: 430, 2126. 14730 return_from_posi_call cobol_operators_: 4046, 4049. 14414 return_from_rew_add cobol_operators_: 3733, 3737. 14374 return_from_rew_del cobol_operators_: 3704, 3708, 3854. 12214 return_from_sort_commence cobol_operators_: 1822, 1826. 12302 return_from_sort_init cobol_operators_: 1913, 1923. 12232 return_from_sort_release cobol_operators_: 1846, 1850. 12246 return_from_sort_return cobol_operators_: 1869, 1875. 12354 return_from_sort_term cobol_operators_: 1985, 1989. 12132 return_from_term cobol_operators_: 1709, 1995. 13610 return_from_time cobol_operators_: 3089, 3095. 14706 return_from_vol_call cobol_operators_: 4024, 4027. 14461 return_from_write_seek cobol_operators_: 3797, 3801. 14220 return_get_line cobol_operators_: 3482, 3486. 12143 return_mac cobol_operators_: 146, 1737. 1173 return_no_pop_offset stack_header: 83. 1172 return_offset stack_header: 82. 3 return_pr cobol_operators_: 911. 13710 return_read_key cobol_operators_: 3197, 3201. 14550 return_read_record cobol_operators_: 3893, 3897. 14562 return_read_record_exit cobol_operators_: 3495, 3907, 3911. 14143 return_rewrite_record cobol_operators_: 3413, 3416. 13766 return_rts_for_read_key cobol_operators_: 3256, 3259. 13723 return_rts_read_key cobol_operators_: 3211, 3214. 530 return_seek_key cobol_operators_: 676, 679. 14041 return_special_delete cobol_operators_: 3321, 3328, 3391. 14122 return_special_rewrite cobol_operators_: 3385, 3388. 14623 return_start_control cobol_operators_: 3962, 3966. 13066 return_thru_text_base_pone cobol_operators_: 559, 2572, 2578, 2585, 2605, 2614, 2669, 2800, 3153, 3450, 4063. 101 return_to_main_off cobol_operators_: 100, 262, 290, 448, 490, 498, 548, 567, 580, 629, 640, 711, 758, 1643, 1662, 1713, 1767, 1817, 1839, 1864, 1896, 1936, 1946, 1979, 2003, 2102, 2120, 2144, 2178, 2190, 2204, 2212, 2220, 2228, 2236, 2244, 2270, 2293, 2332, 2343, 2364, 2379, 2391, 2405, 2420, 2434, 2443, 2459, 2485, 2561, 2595, 2624, 2657, 2681, 2700, 2733, 2748, 2776, 2793, 3007, 3037, 3051, 3064, 3087, 3120, 3142, 3161, 3178, 3225, 3269, 3304, 3366, 3405, 3432, 3465, 3506, 3527, 3548, 3569, 3593, 3627, 3650, 3677, 3695, 3724, 3753, 3784, 3819, 3844, 3863, 3874, 3923, 3943, 3977. 100 return_to_main_ptr cobol_operators_: 99, 368, 388, 431, 440, 922, 1678. 330 return_to_reset cobol_operators_: 453, 572, 610, 614, 653, 720, 780, 797, 1937, 1991, 2336, 2355, 2370, 2645, 2720, 2766, 2785, 2878, 3038, 3080, 3113, 3134, 3204, 3216, 3249, 3274, 3341, 3356, 3418, 3488, 3518, 3539, 3560, 3583, 3615, 3642, 3669, 3687, 3710, 3739, 3769, 3805, 3836, 3899, 3913, 3968, 4056, 4058, 4066. 557 return_write_record cobol_operators_: 715, 718. 12362 revert_cleanup cobol_operators_: 161, 2001. 14132 rewrite cobol_operators_: 202, 3403. 40 rl eis_bits: 2. 1 round eis_bits: 30. 110 rts_code cobol_operators_: 102, 378, 397, 465, 469, 650, 1646, 1681, 1821, 1845, 1868, 1917, 1984, 2349, 2383, 2397, 2411, 2426, 2448, 2639, 2713, 2760, 2840, 2924, 2994, 3017, 3055, 3070, 3092, 3126, 3166, 3210, 3255, 3314, 3377, 3412, 3494, 3512, 3533, 3554, 3577, 3609, 3635, 3661, 3681, 3703, 3732, 3762, 3796, 3828, 3853, 3892, 3906, 3961. 102 rts_code_ptr cobol_operators_: 101, 376, 379, 467. 162 rts_save cobol_operators_: 116, 382, 472. 12750 runtime_check cobol_operators_: 155, 2483. 12004 s1032con cobol_operators_: 2581, cobol_op_var_con: 18. 12005 s1036con cobol_operators_: 2611, cobol_op_var_con: 19. 12006 s1090con cobol_operators_: 2568, 2602, cobol_op_var_con: 20. 12007 s1193con cobol_operators_: 2648, cobol_op_var_con: 21. 12010 s1293con cobol_operators_: 2723, cobol_op_var_con: 22. 12011 s1295con cobol_operators_: 2848, cobol_op_var_con: 23. 12012 s2036con cobol_operators_: 2905, 4060, cobol_op_var_con: 24. 12013 s2393con cobol_operators_: 2960, cobol_op_var_con: 25. 12014 s3031con cobol_operators_: 3447, cobol_op_var_con: 26. 12015 s3032con cobol_op_var_con: 27. 12016 s3410con cobol_operators_: 3453, cobol_op_var_con: 28. 12017 s4022con cobol_op_var_con: 29. 12020 s4031con cobol_operators_: 556, cobol_op_var_con: 30. 12021 s4430con cobol_operators_: 618, 3808, cobol_op_var_con: 31. 12022 s4432con cobol_operators_: 723, cobol_op_var_con: 32. 12023 s4532con cobol_op_var_con: 33. 12024 s4630con cobol_op_var_con: 34. 12030 s4632con cobol_operators_: 659, cobol_op_var_con: 38. 12025 s4730con cobol_operators_: 3772, cobol_op_var_con: 35. 12026 s5432con cobol_operators_: 3394, cobol_op_var_con: 36. 12027 s5730con cobol_operators_: 3742, cobol_op_var_con: 37. 12031 s6031con cobol_operators_: 3932, cobol_op_var_con: 39. 12032 s6732con cobol_op_var_con: 40. 12033 s7031con cobol_operators_: 3150, cobol_op_var_con: 41. 12034 s7430con cobol_operators_: 3277, 3324, 3713, cobol_op_var_con: 42. 12035 s7632con cobol_op_var_con: 43. 147 save_display cobol_operators_: 269. 227 save_link cobol_operators_: 363. 13 save_t_scale cobol_operators_: 900, 1113, 1136. 0 scales cobol_operators_: 890, 923. 1112 scale_factor_mask cobol_operators_: 1308, 1318, 1344. 474 seek_common cobol_operators_: 633, 643. 472 seek_key cobol_operators_: 184, 638. 12564 send_comm cobol_operators_: 216, 2226. 12615 set_file_status cobol_operators_: 168, 2291. 12575 set_lin_file_status cobol_operators_: 167, 2268. 13344 set_open_mode cobol_operators_: 2855, 2861. 1116 sign_table cobol_operators_: 1063, 1355. 13346 skip_open_mode cobol_operators_: 2858, 2860, 2864. 12206 sort_commence cobol_operators_: 165, 1815. 12474 sort_comp cobol_operators_: 162, 2100. 4146 sort_con cobol_operators_: 1962, 2008, cobol_op_fix_con: 135. 361 sort_entry_seq cobol_operators_: 153, 515. 12253 sort_exit cobol_operators_: 1894. 12307 sort_good cobol_operators_: 1828, 1852, 1877, 1925, 1934. 12253 sort_initiate cobol_operators_: 157, 1893. 12270 sort_initiate_call cobol_operators_: 1911. 12221 sort_release cobol_operators_: 154, 1837. 12237 sort_return cobol_operators_: 156, 1862. 12344 sort_terminate cobol_operators_: 160, 1977. 5 source_desc cobol_operators_: 896, 974, 1085, 1303, 1309. 2 source_pr cobol_operators_: 909, 985, 1126, 1167, 1188, 1336. 6 sp cobol_operators_: 124. 4006 space_con cobol_operators_: 2938, cobol_op_fix_con: 33. 14014 special_delete cobol_operators_: 200, 3302. 14076 special_rewrite cobol_operators_: 201, 3364. 73 stach_header.trace_top_ptr stack_header: 62. 32 stack_frame.arg_ptr cobol_operators_: 353, 355, 519, 2104, 2487, stack_frame: 16. 100 stack_frame.condition_bit cobol_operators_: 2031, stack_frame: 32. 20 stack_frame.condition_word cobol_operators_: 1950, 1953, 2032, 2035, stack_frame: 9. 2000 stack_frame.crawl_out_bit stack_frame: 28. 26 stack_frame.entry_ptr cobol_operators_: 365, 420, 536, 1650, 2488, stack_frame: 13. 20 stack_frame.flag_word stack_frame: 24. 400 stack_frame.link_trap_bit stack_frame: 30. 30 stack_frame.lp_ptr stack_frame: 15. 20000 stack_frame.main_proc_bit stack_frame: 25. 60 stack_frame.min_length stack_frame: 23. 22 stack_frame.next_sp cobol_operators_: 353, 355, 521, stack_frame: 10. 36 stack_frame.on_unit_rel_ptrs cobol_operators_: 1774, 1777, 1784, 1786, 1952, 1954, 1956, 1961, 2018, 2021, 2034, 2054, stack_frame: 19. 30 stack_frame.operator_ptr cobol_operators_: 372, 417, 439, 539, 1744, 2024, stack_frame: 14. 37 stack_frame.operator_ret_ptr cobol_operators_: 369, 1769, 1793, stack_frame: 20. 20 stack_frame.prev_sp cobol_operators_: 353, 355, 518, 1741, 1772, 1775, stack_frame: 8. 40 stack_frame.regs stack_frame: 22. 24 stack_frame.return_ptr cobol_operators_: 272, 305, 395, 402, 455, 525, 677, 683, 716, 748, 1716, 1745, 1746, 1823, 1847, 1870, 1914, 1986, 2351, 2641, 2715, 2762, 2824, 2843, 2916, 2928, 2951, 2986, 2998, 3019, 3067, 3090, 3123, 3198, 3212, 3244, 3257, 3295, 3357, 3386, 3414, 3483, 3496, 3514, 3535, 3556, 3579, 3611, 3638, 3663, 3683, 3705, 3734, 3764, 3798, 3830, 3855, 3894, 3908, 3963, 4025, 4047, stack_frame: 12. 10000 stack_frame.run_unit_manager stack_frame: 26. 1000 stack_frame.signaller_bit stack_frame: 29. 22 stack_frame.signaller_word stack_frame: 11. 4000 stack_frame.signal_bit stack_frame: 27. 34 stack_frame.static_ptr stack_frame: 17. 200 stack_frame.support_bit stack_frame: 31. 35 stack_frame.support_ptr stack_frame: 18. 37 stack_frame.translator_id stack_frame: 21. 66 stack_header.assign_linkage_ptr stack_header: 59. 32 stack_header.bar_mode_sp stack_header: 42. 36 stack_header.call_op_ptr stack_header: 44. 10 stack_header.clr_ptr stack_header: 27. 6 stack_header.combined_stat_ptr stack_header: 25. 4 stack_header.cpm_data_ptr stack_header: 24. 13 stack_header.cpm_enabled stack_header: 32. 13 stack_header.cur_lot_size stack_header: 31. 64 stack_header.ect_ptr stack_header: 58. 46 stack_header.entry_op_ptr stack_header: 49. 70 stack_header.heap_header_ptr stack_header: 60. 74 stack_header.in_trace stack_header: 63. 52 stack_header.isot_ptr stack_header: 52. 26 stack_header.lot_ptr cobol_operators_: 353, 355, stack_header: 39. 12 stack_header.main_proc_invoked stack_header: 29. 12 stack_header.max_lot_size stack_header: 28. 20 stack_header.parent_ptr stack_header: 36. 34 stack_header.pl1_operators_ptr stack_header: 43. 40 stack_header.push_op_ptr stack_header: 46. 42 stack_header.return_op_ptr stack_header: 47. 44 stack_header.ret_no_pop_op_ptr stack_header: 48. 62 stack_header.rnt_ptr stack_header: 57. 12 stack_header.run_unit_depth stack_header: 30. 54 stack_header.sct_ptr stack_header: 53. 30 stack_header.signal_ptr stack_header: 41. 22 stack_header.stack_begin_ptr stack_header: 37. 24 stack_header.stack_end_ptr cobol_operators_: 353, 355, 517, 522, 1740, stack_header: 38. 14 stack_header.system_free_ptr stack_header: 33. 60 stack_header.sys_link_info_ptr stack_header: 56. 72 stack_header.trace_frames stack_header: 61. 50 stack_header.trans_op_tv_ptr stack_header: 51. 56 stack_header.unwinder_ptr stack_header: 54. 16 stack_header.user_free_ptr stack_header: 34. 100 stack_header_end stack_header: 64. 14600 start_control cobol_operators_: 166, 3941. 52 status12 cobol_operators_: 96, 557, 619, 660, 724, 2569, 2582, 2603, 2612, 2649, 2724, 2849, 2906, 2961, 3151, 3278, 3325, 3395, 3448, 3454, 3714, 3743, 3773, 3809, 3933, 4061. 53 status3 cobol_operators_: 97. 12705 stop_cd_run cobol_operators_: 237, 2403. 12673 stop_literal cobol_operators_: 186, 2377. 12677 stop_run cobol_operators_: 191, 2389. 13364 subr_close_file cobol_operators_: 2335, 2884. 13473 subr_close_file_only cobol_operators_: 2367, 2687, 2784, 2975. 14002 subr_delete cobol_operators_: 3272, 3286, 3319. 13266 subr_open_file cobol_operators_: 2689, 2740, 2782, 2809. 566 subr_put_chars cobol_operators_: 504, 570, 583, 732, 2283. 152 subr_return_save cobol_operators_: 113, 418, 682, 703, 747, 2829, 2835, 2837, 2851, 2937, 2940, 2945, 2969, 2980, 2992, 3294. 153 subr_return_save_off cobol_operators_: 114, 668, 691, 733, 2810, 2885, 2976, 3287. 515 subr_seek_op cobol_operators_: 651, 667, 3315, 3340, 3378. 534 subr_write_record cobol_operators_: 690, 713, 3383, 3408. 1043 s_non_dec cobol_operators_: 1236, 1239. 1 s_scale cobol_operators_: 891, 979, 1133, 1164, 1179, 1234, 1243, 1304. 1064 target_big_enough cobol_operators_: 1266, 1276. 6 target_desc cobol_operators_: 897, 975, 1086, 1313, 1319. 1 target_pr cobol_operators_: 910, 1026, 1027, 1033, 1034, 1108, 1126, 1142, 1333, 1339. 2 temp1 cobol_operators_: 893, 1186, 1189, 1194, 1213, 1215, 1216, 1241, 1242, 1254, 1255, 1260, 1264, 1272, 1273. 3 temp2 cobol_operators_: 894. 4 temp3 cobol_operators_: 895. 14 temp_source cobol_operators_: 901, 1064, 1108, 1168, 1205, 1330, 1342. 0 text1 cobol_operators_: 63, 68, 69. 4000 text2 cobol_operators_: 64, 68, 1522. 4400 text3 cobol_operators_: 65, 68, cobol_op_fix_con: 172. 10000 text4 cobol_operators_: 66, 68, 1532. 12000 text5 cobol_operators_: 67, 68, 1627. 47 text_base_off cobol_operators_: 93. 46 text_base_ptr cobol_operators_: 92, 367, 432, 537, 553, 1770, 1948, 2005, 2110, 2123, 2321, 2468, 2473, 2490, 2576, 2587, 2608, 2672, 2803, 3147, 3438, 3929. trace cobol_operators_: 353. 164 trace_entry_version_1 cobol_operators_: 353. 0 trace_frames.count stack_header: 69. 1 trace_frames.top_ptr stack_header: 70. 714 trailing_dec_plus cobol_operators_: 988, 996. 1 truncate eis_bits: 31. 551 tv_offset stack_header: 75, 80, 81, 82, 83, 84. 1053 t_non_dec cobol_operators_: 1250, 1253. 1015 t_opch cobol_operators_: 1173, 1177. 0 t_scale cobol_operators_: 892, 1016, 1112, 1116, 1118, 1132, 1137, 1247, 1248, 1259, 1314. 664 udts_dest cobol_operators_: 938. 674 udts_source cobol_operators_: 930, 956, 1147. 736 udts_source_exit cobol_operators_: 1029, 1038. 40 udts_source_ret cobol_operators_: 902, 958, 1044. 1005 unpack_opch cobol_operators_: 1056, 1160. 13013 upper_half cobol_operators_: 2520, 2523. 150 var_call cobol_operators_: 271. 12043 volume_con cobol_operators_: 4011, cobol_op_var_con: 49. 12042 volume_desc cobol_operators_: 4009, cobol_op_var_con: 48. 14676 vol_call cobol_operators_: 4018, 4051. 14710 vol_call_ok cobol_operators_: 4030. 14716 vol_comp cobol_operators_: 4034, 4037. 5 work_pr cobol_operators_: 908, 923, 958, 974, 975, 979, 1016, 1044, 1053, 1064, 1085, 1086, 1090, 1099, 1103, 1104, 1108, 1112, 1113, 1116, 1118, 1132, 1133, 1136, 1137, 1142, 1143, 1151, 1164, 1168, 1179, 1186, 1189, 1194, 1205, 1213, 1215, 1216, 1234, 1241, 1242, 1243, 1247, 1248, 1254, 1255, 1259, 1260, 1264, 1272, 1273, 1303, 1304, 1309, 1313, 1314, 1319, 1330, 1342. 551 write_record cobol_operators_: 185, 709. 424 write_stream cobol_operators_: 183, 565. 461 write_stream_error cobol_operators_: 573, 616. 432 write_stream_linage cobol_operators_: 211, 578. 10 x0 eis_bits: 13. 11 x1 eis_bits: 14. 12 x2 eis_bits: 15. 13 x3 eis_bits: 16. 14 x4 eis_bits: 17. 15 x5 eis_bits: 18. 16 x6 eis_bits: 19. 144 x6_save cobol_operators_: 112, 2282, 2284. 17 x7 eis_bits: 20. 6 xor eis_bits: 26. 12 x_store cobol_operators_: 899, 1104, 1143. 4121 zero_con cobol_operators_: 4013, cobol_op_fix_con: 114. NO FATAL ERRORS ----------------------------------------------------------- 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