COMPILATION LISTING OF SEGMENT cobol_go_gen Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 0949.8 mst Wed Options: optimize map 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 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_go_gen.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 01/14/77 by ORN to signal command_abort rather than cobol_compiler_error */ 23 /* Modified since Version 2.0 */ 24 25 /*{*/ 26 /* format: style3 */ 27 cobol_go_gen: 28 proc (in_token_ptr); /* 29*The procedure cobol_go_gen generates the code necessary to implement 30*the COBOL GO statement and, in the case of alterable GO's, pro- 31*duces the data structures from which initialization code may be 32*subsequently generated. The format of the GO statement is: 33* 34*Format 1 - 35* 36* G_O_ TO [procedure-name-1] 37* 38*Format 2 - 39* 40* G_O_ TO procedure-name-1 [,procedure-name-2]..., procedure-name-n 41* 42* D_E_P_E_N_D_I_N_G_ ON identifier 43* 44*The implementation of a GO statement depends upon whether or not 45*it is the object of an ALTER statement. A Format 1 GO statement 46*with optional procedure-name-1 present may be modified by an 47*ALTER statement; a Format 1 GO statement without optional proce- 48*dure-name-1 present must be modified by an ALTER statement; and a 49*Format 2 GO statement may not be modified by an ALTER statement. 50*The determination of whether or not the GO statement being pro- 51*cessed is the object of an ALTER statement is made by examining 52*the variable cobol_$alter_flag. A value of 1 indicates that the GO 53*statement is the object of an ALTER statement and a value of 0, 54*that it is not. cobol_$alter_flag is set by cobol_paragraph_gen. 55* 56*The implementation of a GO statement which is not the object of 57*an ALTER statement is also dependent upon whether or not the 58*COBOL segment containing the procedure to which control is to be 59*transferred must first be initialized. Segment initialization is 60*not required if the procedure to which control is to be transfer- 61*red is in the same COBOL segment as the GO statement being imple- 62*mented, is in a fixed COBOL segment, or is in an independent 63*COBOL segment which contains no alterable GO's. The term alter- 64*able GO, as used here, refers to a GO statement that is the ob- 65*ject of an ALTER statement. 66* 67*U__s_a_g_e:_ 68* 69* declare cobol_go_gen entry (ptr); 70* 71* call cobol_go_gen (in_token_ptr); 72* 73* */ 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_in_token.incl.pl1 */ 1 3 1 4 /* Last modified August 22, 1974 by AEG */ 1 5 1 6 1 7 declare in_token_ptr ptr; 1 8 1 9 declare 1 in_token aligned based(in_token_ptr), 1 10 2 n fixed bin aligned, 1 11 2 code fixed bin aligned, 1 12 2 token_ptr(0 refer(in_token.n)) ptr aligned; 1 13 1 14 1 15 /* END INCLUDE FILE ... cobol_in_token.incl.pl1 */ 1 16 74 75 76 /* 77*G__e_n_e_r_a_t_e_d_C__o_d_e:_ 78* 79*Format 1 - 80* 81*The following code is generated for Format 1 GO statements which 82*are alterable: 83* 84* lda target_a 85* tra 0,al 86* 87*where: 88* 89*target_a is a 36-bit variable, allocated in COBOL data on a word 90* boundary and uniquely associated with the alterable GO 91* being implemented (see alter_list), which contains 92* transfer address data. For information on the setting 93* of target_a, see cobol_initgo_gen. 94* 95*If the optional procedure-name-1 is not present, the above two 96*instructions are followed by an execution time call to cobol_ 97*error_ generated by a compile time call to cobol_process_error. 98*This call will be executed only in the event that the GO state- 99*ment is executed prior to the execution of an ALTER statement re- 100*ferring to this GO statement. This is accomplished by initializ- 101*ing target_a such that control is passed to the first instruction 102*of the call to cobol_error_. Target_a is otherwise initialized 103*to pass control to the first instruction of procedure-name-1. 104*See cobol_seginit_gen for details on initialization. 105* 106*If it is found that a Format 1 GO statement without the optional 107*procedure-name-1 present is not the subject of an ALTER statement 108*then a compile time warning to this effect is issued to the user 109*via system subroutine signal_ and an execution time call to 110*cobol_error_ is generated by a call to cobol_process_error to signal 111*this error to the user at execution time and to prevent further 112*execution of the program in the event that this GO statement is 113*executed in the course of executing the program. 114* 115*In the case of non-alterable Format 1 GO statements, code se- 116*quence 1, below, is used if no segment initialization is required 117*and sequence 2, if segment initialization is requierd. 118* 119* Sequence 1 120* 121* tra pn_relp,ic 122* 123* Sequence 2 124* 125* eaa pn_relp,ic 126* tra s_init_relp,ic 127* 128*where: 129* 130*pn_relp is the offset, relative to the instruction in which 131* it appears, of the first instruction of the procedure 132* to the transfer is being made. 133* 134*s_init_relp is the offset, relative to the instruction in which 135* it appears, of the first instruction of the code se- 136* quence provided to initialize the alterable GO's in 137* the segment containing the procedure to which the 138* transfer is being made. 139* 140*Format 2 - 141* 142*The code generated to implement Format 2 GO statements is as 143*follows: 144* 145* stz ident_bin 146* dtb (pr),(pr) 147* ndsc9 ident 148* ndsc9 ident_bin 149* lda 1,du 150* ldq nt,du 151* dwl ident_bin 152* tnz nt+2mt+3,ic 153* eax2 ident_bin,*ic 154* tra 1,2 155* tra relp1,ic 156* tra relp2,ic 157* . . . 158* . . . 159* . . . 160* tra relpn,ic 161* eaa pn1_relp,ic 162* tra s(pn1)_init_relp,ic 163* eaa pn2_relp,ic 164* tra s(pn2)_init_relp,ic 165* . . . . . 166* . . . . . 167* . . . . . 168* eaa pnm_relp,ic 169* tra s(pnm)_init_relp,ic 170* 171*where: 172* 173*ident_bin is a fixed bin quantity allocated in the stack. 174* Its function is to contain the binary represen- 175* tation of the value of ident times 2**18. 176* 177*ident is the operand of the DEPENDING ON phrase of the 178* Format 2 GO statement. It is allocated in COBOL 179* data. 180* 181*nt is the number of procedure names given as oper- 182* ands of the Format 2 GO statement. 183* 184*mt is the number of procedure names given as oper- 185* ands of the Format 2 GO statement which are con- 186* tained in segments that must be initialized be- 187* fore the required transfer of control is made. 188* mt is less than or equal to nt. 189* 190*relpn for n = 1, 2, 3, ... nt is a constant whose 191* value is either: 192* 1) The offset, relative to the instruction in 193* which relpn appears, of the first instruction 194* of procedure pnn (procedure-name-n), if the 195* segment containing procedure pnn does not 196* have to be initialized before control is 197* transferred to the procedure. 198* 2) nt-n+2m-1 for n = 1, 2, 3, ... nt and m = 1, 199* 2, 3, ...mt if the segment containing proce- 200* dure pnn requires initialization before con- 201* trol is transferred to the procedure. 202* 203*pnm_relp for m = 1, 2, 3, ... mt is the offset, relative 204* to the instruction in which pnm_relp appears, of 205* the first instruction of procedure pnm where 206* procedure pnm is in a segment requiring initial- 207* ization before control is transferred to it. 208* 209*s(pnm)_init_relp for m = 1, 2, 3, ... mt is the offset, relative 210* to the instruction in which s(pnm)_init_relp ap- 211* pears, of the first instruction of the sequence 212* provided to initialize the segment containing 213* procedure pnn. 214* 215*R__e_l_o_c_a_t_i_o_n_I__n_f_o_r_m_a_t_i_o_n:_ 216* 217*All instructions generated directly by procedure cobol_go_gen (as 218*opposed to being generated by a utility called by cobol_go_gen) are 219*non-relocatable. 220* 221* */ 222 /* 223*D__a_t_a:_ 224* 225* % include cobol_; 226* 227* Items in cobol_ include file1 used (u) and/or set(s) by 228* cobol_go_gen: 229* 230* cobol_ptr (u) 231* alter_flag (u) 232* alter_index (u/s) 233* alter_list_ptr (u) 234* next_tag (u/s) 235* text_wd_off (u) 236* priority_no (u) 237* seg_init_list_ptr (u) 238* 239* */ 240 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_alter_list.incl.pl1 */ 2 3 2 4 /* Last modified July 17, 1974 by AEG */ 2 5 2 6 2 7 declare 1 alter_list aligned based( cobol_$alter_list_ptr), 2 8 2 n fixed bin aligned, 2 9 2 goto (0 refer(alter_list.n)) aligned, 2 10 3 proc_num fixed bin aligned, 2 11 3 priority fixed bin aligned, 2 12 3 target_a_segno fixed bin aligned, 2 13 3 target_a_offset fixed bin(24) aligned; 2 14 2 15 2 16 /* 2 17*alter_list_ptr is a pointer upon which the structure alter_list 2 18* is based. It is declared in mc_.incl.pl1. 2 19* 2 20*n is the number of alterable GO's in the source 2 21* program. 2 22* 2 23*goto is an array of alter_list.n structures containing 2 24* information about the alterable GO's. 2 25* 2 26*proc_num is the tag number associated with a COBOL procedure 2 27* containing an alterable GO. 2 28* 2 29*priority is the COBOL segment number of the section con- 2 30* taining COBOL procedure proc_num. 2 31* 2 32*target_a_segno and target_a_offset are the artificial MCOBOL 2 33* segment number and character offset, respectively, 2 34* of a 36-bit variable, allocated in the COBOL data 2 35* segment on a word boundary, which contains trans- 2 36* fer address information for the alterable GO con- 2 37* tained in COBOL procedure proc_num. 2 38* 2 39* */ 2 40 /* END INCLUDE FILE ... cobol_alter_list.incl.pl1 */ 2 41 241 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_seg_init_list.incl.pl1 */ 3 3 3 4 /* Last modified July 17, 1974 by AEG */ 3 5 3 6 3 7 declare 1 seg_init_list aligned based( cobol_$seg_init_list_ptr), 3 8 2 n fixed bin aligned, 3 9 2 extra fixed bin aligned, 3 10 2 seg (0 refer(seg_init_list.n)) aligned, 3 11 3 priority fixed bin aligned, 3 12 3 int_tag_no fixed bin aligned, 3 13 3 no_gos fixed bin aligned, 3 14 3 next_init_no fixed bin aligned, 3 15 3 init_ptr ptr aligned; 3 16 3 17 3 18 /* 3 19*seg_init_list_ptr is a pointer upon which the structure 3 20* seg_init_list is based. It is declared in 3 21* cobol_.incl.pl1 3 22* 3 23*n is the number of COBOL segments containing 3 24* alterable GO's. All fixed segments are counted 3 25* as one segment and assigned segment number 0. 3 26* 3 27*extra available for future use. 3 28* 3 29*seg is an array of seg_init_list.n structures which 3 30* contain information about the segments contain- 3 31* ing alterable GO's. seg(1) always conatins 3 32* information about fixed segments if there are 3 33* any in the procedure. 3 34* 3 35*priority is the COBOL segment number associated with 3 36* the "alterable" segment. 3 37* 3 38*int_tag_no is an internal tag number associated with the 3 39* first instruction of the code sequence generat- 3 40* ed to initialize the alterable GO's in the seg- 3 41* ment whose segment number is priority. For 3 42* priority = 0, int_tag_no = 0 since initializa- 3 43* tion of alterable GO's in fixed segments is 3 44* accomplished by cobol_prologue_gen. 3 45* 3 46*no_gos is the number of alterable GO's in the segment 3 47* whose segment number is priority. 3 48* 3 49*next_init_no is the number of the next alterable GO in the 3 50* segment whose segment number is priority for 3 51* which initialization data entries are to be 3 52* made in an area reserved for that purpose. The 3 53* base of this area is located by init_ptr. 3 54* 1<_next_init_no<_no_gos. 3 55* 3 56*init_ptr is a pointer to a block of 3 times no_gos words 3 57* reserved for the storage of initialization data 3 58* for the alterable GO's in the segment whose 3 59* segment number is priority. 3 60* 3 61* 3 62* */ 3 63 /* END INCLUDE FILE ... cobol_seg_init_list.incl.pl1 */ 3 64 242 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_type9.incl.pl1 */ 4 3 /* Last modified on 11/19/76 by ORN */ 4 4 4 5 /* 4 6*A type 9 data name token is entered into the name table by the data 4 7*division syntax phase for each data name described in the data division. 4 8*The replacement phase subsequently replaces type 8 user word references 4 9*to data names in the procedure division minpral file with the corresponding 4 10*type 9 tokens from the name table. 4 11**/ 4 12 4 13 /* dcl dn_ptr ptr; */ 4 14 4 15 /* BEGIN DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 4 16 dcl 1 data_name based (dn_ptr), 5 1 5 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 5 3 /* Last modified on 06/19/77 by ORN */ 5 4 /* Last modified on 12/28/76 by FCH */ 5 5 5 6 /* header */ 5 7 2 size fixed bin, 5 8 2 line fixed bin, 5 9 2 column fixed bin, 5 10 2 type fixed bin, 5 11 /* body */ 5 12 2 string_ptr ptr, 5 13 2 prev_rec ptr, 5 14 2 searched bit (1), 5 15 2 duplicate bit (1), 5 16 2 saved bit (1), 5 17 2 debug_ind bit (1), 5 18 2 filler2 bit (3), 5 19 2 used_as_sub bit (1), 5 20 2 def_line fixed bin, 5 21 2 level fixed bin, 5 22 2 linkage fixed bin, 5 23 2 file_num fixed bin, 5 24 2 size_rtn fixed bin, 5 25 2 item_length fixed bin(24), 5 26 2 places_left fixed bin, 5 27 2 places_right fixed bin, 5 28 /* description */ 5 29 2 file_section bit (1), 5 30 2 working_storage bit (1), 5 31 2 constant_section bit (1), 5 32 2 linkage_section bit (1), 5 33 2 communication_section bit (1), 5 34 2 report_section bit (1), 5 35 2 level_77 bit (1), 5 36 2 level_01 bit (1), 5 37 2 non_elementary bit (1), 5 38 2 elementary bit (1), 5 39 2 filler_item bit (1), 5 40 2 s_of_rdf bit (1), 5 41 2 o_of_rdf bit (1), 5 42 2 bin_18 bit (1), 5 43 2 bin_36 bit (1), 5 44 2 pic_has_l bit (1), 5 45 2 pic_is_do bit (1), 5 46 2 numeric bit (1), 5 47 2 numeric_edited bit (1), 5 48 2 alphanum bit (1), 5 49 2 alphanum_edited bit (1), 5 50 2 alphabetic bit (1), 5 51 2 alphabetic_edited bit (1), 5 52 2 pic_has_p bit (1), 5 53 2 pic_has_ast bit (1), 5 54 2 item_signed bit(1), 5 55 2 sign_separate bit (1), 5 56 2 display bit (1), 5 57 2 comp bit (1), 5 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 5 59 2 ascii_packed_dec bit (1), 5 60 2 ebcdic_packed_dec bit (1), 5 61 2 bin_16 bit (1), 5 62 2 bin_32 bit (1), 5 63 2 usage_index bit (1), 5 64 2 just_right bit (1), 5 65 2 compare_argument bit (1), 5 66 2 sync bit (1), 5 67 2 temporary bit (1), 5 68 2 bwz bit (1), 5 69 2 variable_length bit (1), 5 70 2 subscripted bit (1), 5 71 2 occurs_do bit (1), 5 72 2 key_a bit (1), 5 73 2 key_d bit (1), 5 74 2 indexed_by bit (1), 5 75 2 value_numeric bit (1), 5 76 2 value_non_numeric bit (1), 5 77 2 value_signed bit (1), 5 78 2 sign_type bit (3), 5 79 2 pic_integer bit (1), 5 80 2 ast_when_zero bit (1), 5 81 2 label_record bit (1), 5 82 2 sign_clause_occurred bit (1), 5 83 2 okey_dn bit (1), 5 84 2 subject_of_keyis bit (1), 5 85 2 exp_redefining bit (1), 5 86 2 sync_in_rec bit (1), 5 87 2 rounded bit (1), 5 88 2 ad_bit bit (1), 5 89 2 debug_all bit (1), 5 90 2 overlap bit (1), 5 91 2 sum_counter bit (1), 5 92 2 exp_occurs bit (1), 5 93 2 linage_counter bit (1), 5 94 2 rnm_01 bit (1), 5 95 2 aligned bit (1), 5 96 2 not_user_writable bit (1), 5 97 2 database_key bit (1), 5 98 2 database_data_item bit (1), 5 99 2 seg_num fixed bin, 5 100 2 offset fixed bin(24), 5 101 2 initial_ptr fixed bin, 5 102 2 edit_ptr fixed bin, 5 103 2 occurs_ptr fixed bin, 5 104 2 do_rec char(5), 5 105 2 bitt bit (1), 5 106 2 byte bit (1), 5 107 2 half_word bit (1), 5 108 2 word bit (1), 5 109 2 double_word bit (1), 5 110 2 half_byte bit (1), 5 111 2 filler5 bit (1), 5 112 2 bit_offset bit (4), 5 113 2 son_cnt bit (16), 5 114 2 max_red_size fixed bin(24), 5 115 2 name_size fixed bin, 5 116 2 name char(0 refer(data_name.name_size)); 5 117 5 118 5 119 5 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 5 121 4 17 4 18 /* END DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 4 19 4 20 /* END INCLUDE FILE ... cobol_type9.incl.pl1 */ 4 21 243 244 dcl dn_ptr ptr; 6 1 6 2 /* BEGIN INCLUDE FILE ... cobol_type18.incl.pl1 */ 6 3 /* Last modified on 11/19/76 by ORN */ 6 4 6 5 /* 6 6*A type 18 procedure reference token is entered into the procedure division 6 7*minpral file by the replacement phase to replace each type 8 user word 6 8*reference to a procedure name. A type 18 token is constructed by changing 6 9*the type field of the appropriate type 7 procedure definition token from 6 10*the name table to 18. 6 11**/ 6 12 6 13 dcl proc_ref_ptr ptr; 6 14 6 15 /* BEGIN DECLARATION OF TYPE18 (PROCEDURE REFERENCE) TOKEN */ 6 16 dcl 1 proc_ref based (proc_ref_ptr), 7 1 7 2 /* begin include file ... cobol_TYPE18.incl.pl1 */ 7 3 /* Last modified on 11/7/76 by ORN */ 7 4 7 5 /* header */ 7 6 2 size fixed bin, 7 7 2 line fixed bin, 7 8 2 column fixed bin, 7 9 2 type fixed bin, 7 10 /* body */ 7 11 2 string_ptr ptr, 7 12 2 prev_rec ptr, 7 13 2 searched bit (1), 7 14 2 duplicate bit (1), 7 15 2 filler1 bit (1), 7 16 2 debug_ind bit (1), 7 17 2 section_name bit (1), 7 18 2 declarative_proc bit (1), 7 19 2 filler2 bit (1), 7 20 2 alterable bit (1), 7 21 2 priority char (2), 7 22 2 sort_range bit (1), 7 23 2 input_range bit (1), 7 24 2 output_range bit (1), 7 25 2 merge_range bit(1), 7 26 2 filler3 bit (5), 7 27 2 section_num fixed bin, 7 28 2 proc_num fixed bin, 7 29 2 def_line fixed bin, 7 30 2 name_size fixed bin, 7 31 2 name char (30); 7 32 7 33 /* end include file ... cobol_TYPE18.incl.pl1 */ 7 34 6 17 6 18 /* END DECLARATION OF TYPE18 (PROCEDURE REFERENCE) TOKEN */ 6 19 6 20 /* END INCLUDE FILE ... cobol_type18.incl.pl1 */ 6 21 245 8 1 8 2 /* BEGIN INCLUDE FILE ... cobol_type19.incl.pl1 */ 8 3 /* last modified on 11/19/76 by ORN */ 8 4 8 5 /* 8 6*A type 19 end of statement token is created in the procedure division 8 7*minpral file at the end of each minpral statement generated by the 8 8*procedure division syntax phase. A minpral statement may be a complete or 8 9*partial source language statement. A type 19 token contains information 8 10*describing the statement which it delimits. 8 11**/ 8 12 8 13 dcl eos_ptr ptr; 8 14 8 15 /* BEGIN DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 8 16 dcl 1 end_stmt based (eos_ptr), 9 1 9 2 /* begin include file ... cobol_TYPE19.incl.pl1 */ 9 3 /* Last modified on 11/17/76 by ORN */ 9 4 9 5 /* header */ 9 6 2 size fixed bin, 9 7 2 line fixed bin, 9 8 2 column fixed bin, 9 9 2 type fixed bin, 9 10 /* body */ 9 11 2 verb fixed bin, 9 12 2 e fixed bin, 9 13 2 h fixed bin, 9 14 2 i fixed bin, 9 15 2 j fixed bin, 9 16 2 a bit (3), 9 17 2 b bit (1), 9 18 2 c bit (1), 9 19 2 d bit (2), 9 20 2 f bit (2), 9 21 2 g bit (2), 9 22 2 k bit (5), 9 23 2 always_an bit (1); 9 24 9 25 /* end include file ... cobol_TYPE19.incl.pl1 */ 9 26 8 17 8 18 /* END DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 8 19 8 20 /* 8 21*FIELD CONTENTS 8 22* 8 23*size The total size in bytes of this end of statement token. 8 24*line 0 8 25*column 0 8 26*type 19 8 27*verb A value indicating the verb in this statement 8 28* 1 = accept 8 29* 2 = add 8 30* 3 = on size error 8 31* 4 = alter 8 32* 5 = call 8 33* 7 = cancel 8 34* 8 = close 8 35* 9 = divide 8 36* 10 = multiply 8 37* 11 = subtract 8 38* 12 = exit 8 39* 14 = go 8 40* 15 = merge 8 41* 16 = initiate 8 42* 17 = inspect 8 43* 18 = move 8 44* 19 = open 8 45* 20 = perform 8 46* 21 = read 8 47* 23 = receive 8 48* 24 = release 8 49* 25 = return 8 50* 26 = search 8 51* 27 = rewrite 8 52* 29 = seek 8 53* 30 = send 8 54* 31 = set 8 55* 33 = stop 8 56* 34 = string 8 57* 35 = suspend 8 58* 36 = terminate 8 59* 37 = unstring 8 60* 38 = write 8 61* 39 = use 8 62* 40 = compute 8 63* 41 = disable 8 64* 42 = display 8 65* 43 = enable 8 66* 45 = generate 8 67* 46 = hold 8 68* 48 = process 8 69* 49 = sort 8 70* 52 = procedure 8 71* 53 = declaratives 8 72* 54 = section name 8 73* 55 = paragraph name 8 74* 98 = end 8 75*e,h,i,j The significance of these fields differs with each 8 76* statement. These fields are normally used as counters. 8 77*a,b,c,d,f,g,k The significance of these fields differs with each 8 78* statement. These fields are normally used as indicators. 8 79**/ 8 80 8 81 /* END INCLUDE FILE ... cobol_type19.incl.pl1 */ 8 82 246 247 248 /* Input structure for cobol_register$load */ 249 250 declare 1 register_request aligned static, 251 2 requested_reg fixed bin aligned, 252 2 assigned_reg bit (4) aligned, 253 2 lock fixed bin aligned init (0), 254 2 reg_set_now fixed bin aligned, 255 2 use_code fixed bin aligned init (0), 256 2 adjust_ptr_addr fixed bin aligned init (0), 257 2 content_ptr ptr aligned init (null), 258 2 literal_content bit (36) aligned init ((36)"0"b); 259 260 /* 261*requested_reg is a code designating the register requested; 262* 0 - a- or q- or any index-register 263* 1 - a-register 264* 2 - q-register 265* 3 - a- and q-register 266* 4 - a- or q-register 267* 5 - any index-register 268* 1n - index-register n 269* 270*assigned_reg is a code designating the register assigned. It 271* has no significance if a specific register is 272* requested. 273* 274*lock indicates locking requirements; 0 requests that 275* no change be made in register status. 276* 277*reg_set_now not applicable for use_code = 0. 278* 279*use_code specifies how the register is to be used by the 280* requester; 0 signifies that such information is 281* not meaningful for register optimization. 282* 283*adjust_ptr_addr inserted to make evident that since all pointers 284* must be allocated on even word boundaries, the 285* PLI compiler will allocate structures containing 286* pointers and all pointers therein on even word 287* boundaries leaving "gaps" where necessary. 288* 289*content_ptr not applicable for use_code = 0. 290* 291*literal_content not applicable for use_code = 0. 292* */ 293 294 295 /* Input structures for cobol_addr */ 296 297 declare 1 target aligned static, 298 2 type fixed bin aligned init (1), 299 2 operand_no fixed bin aligned init (0), 300 2 lock fixed bin aligned init (0), 301 2 segno fixed bin aligned, 302 2 char_offset fixed bin (24) aligned, 303 2 send_receive fixed bin aligned init (0); 304 305 /* 306*type indicates type of addressing requested. Type 1 307* indicates basic; i.e., data to be addressed is 308* specified by segno and char_offset. 309* 310*operand_no not applicable to type 1. 311* 312*lock indicates lock requirements for registers used in 313* addressing; 314* 0 - do not lock registers used. 315* 1 - lock registers used. 316* 317*segno is the compiler designation of the segment in which 318* the data to be addressed is located. 319* 320*char_offset is the character offset within segno of the data to 321* be addressed. 322* 323*send_receive indicates whether the data being addressed is a 324* sending or receiving field for the instruction whose 325* address field is being set; 0 indicates sending. 326* */ 327 328 declare 1 input_struc aligned static, 329 2 type fixed bin aligned init (4), 330 2 operand_no fixed bin aligned init (1), 331 2 lock fixed bin aligned init (0), 332 2 operand, 333 3 token_ptr ptr aligned init (null), 334 3 send_receive fixed bin aligned init (0), 335 3 ic_mod fixed bin aligned, 336 3 size_sw fixed bin aligned init (0); 337 338 /* 339*type indicates type of addressing requested. 340* 1 - no operand, 1 wd, basic 341* 2 - 1 operand, 1 wd, non-EIS 342* 3 - 1 operand, 1 wd, EIS 343* 4 - 1 operand, 1 desc, 2wd, EIS 344* 5 - 2 operands, 2 desc, 3 wd, EIS 345* 6 - 3 operands, 3 desc, 4 wd, EIS 346* 347*operand_no number of operands associated with requested type. 348* 349*lock indicates lock requirements for registers used in 350* addressing. 351* 0 - do not lock registers used 352* 1 - lock registers used 353* 2 - unlock all registers 354* 355*token_ptr is a pointer to the operand token. 356* 357*send_receive indicates whether the operand being addressed is a 358* sending or receiving field for the instruction. 359* 0 - sending operand 360* 1 - receiving operand 361* 362*ic_mod indicates whether ic modification is specified in 363* the mf field of this operand (set by cobol_addr). 364* 0 - no ic modification 365* 1 - ic modification 366* 367*size_sw indicates size (length) handlhlng requirements to 368* cobol_addr. 369* 0 - cobol_addr may store the operand size in a 370* register or in the instruction 371* 1 - cobol_addr need not be concerned with size 372* */ 373 374 /* Error message structure. */ 375 376 declare 1 error_info static aligned, 377 2 name char (32) aligned init ("cobol_go_gen"), 378 2 message_len fixed bin aligned, 379 2 message char (168) aligned; 380 381 dcl 1 comp7_type9 static, 382 2 header (4) fixed bin init (112, 0, 0, 9), 383 2 repl_ptr (2) ptr init ((2) null ()), 384 2 fill1 bit (108) init (""b), 385 2 file_key_info, 386 3 fb1 (3) fixed bin init (0, 0, 0), 387 3 size fixed bin init (2), 388 3 fb2 (2) fixed bin init (6, 0), 389 3 flags1 bit (36) init ("000000100100010001000000010000000000"b), 390 3 flags2 bit (36) init (""b), 391 3 seg fixed bin init (1000), 392 3 off fixed bin init (160), 393 2 fill2 (7) fixed bin init (0, 0, 0, 0, 0, 0, 0); 394 395 dcl 1 type19 static, 396 2 header (4) fixed bin init (38, 0, 0, 19), 397 2 verb fixed bin init (0), 398 2 e fixed bin init (1), 399 2 h fixed bin init (0), 400 2 ij (2) fixed bin init (0, 0), 401 2 abcdfgk bit (16) init ("0000000000000000"b); 402 403 dcl 1 mpout static, 404 2 n fixed bin init (4), 405 2 pt1 ptr, 406 2 pt2 ptr, 407 2 pt3 ptr, 408 2 pt4 ptr; 409 410 dcl seq_f1_a (4) bit (18) unaligned static init ("000000000000000000"b, "010011101001001101"b, 411 /* lda target_a */ 412 "000000000000000000"b, "111001000000000101"b); 413 /* tra 0,al */ 414 415 dcl seq_f1_b (2) bit (18) unaligned static init ("000000000000000000"b, "111001000000000100"b); 416 /* tra 0,ic */ 417 418 dcl seq_f1_c (4) bit (18) unaligned static init ("000000000000000000"b, "110011101000000100"b, 419 /* eaa pn_relp,ic */ 420 "000000000000000000"b, "111001000000000100"b); 421 /* tra s_init_relp,ic */ 422 423 dcl seq_f2_1 (14) bit (18) unaligned static init ("110000000000101000"b, "100101000001000000"b, 424 /* stz pr6|40 */ 425 "000000000000000001"b, "010011101000000011"b, 426 /* lda 1,du */ 427 "000000000000000000"b, "010011110000000011"b, 428 /* ldq nt,du */ 429 "110000000000101000"b, "001001001001000000"b, 430 /* cwl pr6|40 */ 431 "000000000000000000"b, "110000001000000100"b, 432 /* tnz nt+2mt+3,ic */ 433 "110000000000101000"b, "110010010001110100"b, 434 /* eax2 pr6|40,*ic */ 435 "000000000000000001"b, "111001000000001010"b); 436 /* tra 1,2 */ 437 438 dcl trans (768) bit (36); /* Automatic data */ 439 440 declare s_text_wd fixed bin, /* Saved value of cobol_$text_wd_off. */ 441 temp fixed bin, /* Temporary used in unspec function. */ 442 init_req_flag fixed bin, /* 1 if seg initialization is not */ 443 /* required; 2 if it is. */ 444 pnn_priority fixed bin, /* COBOL seg no of seg containing */ 445 /* procedure-name-n. */ 446 cnt_pri fixed bin, /* Priority of current procedure. */ 447 init_tag fixed bin, /* Tag associated with 1st inst. of */ 448 /* code generated to initialize alter-*/ 449 /* able GO's in COBOL seg containing */ 450 /* procedure-name-n. */ 451 pnn_num fixed bin, /* Procedure no (tag) of procedure- */ 452 /* name-n. */ 453 index fixed bin, /* Do loop index. */ 454 jndex fixed bin, /* Do loop index. */ 455 init_ptr ptr, /* Ptr to location in seg_init_list */ 456 /* where initialization data is to be */ 457 /* placed. */ 458 nt fixed bin, /* Number of procedure names given as */ 459 /* operands in Format 2 GO statement. */ 460 sum fixed bin; /* nt+2m where m is the current count */ 461 /* of procedure names given as oper- */ 462 /* ands in a Format 2 GO statement */ 463 /* that are in segments requiring */ 464 /* initialization. */ 465 466 /* Based structure used in placing initialization data in */ 467 /* seg_init_list. */ 468 469 declare 1 init_data aligned based (init_ptr), 470 2 target_a_segno fixed bin aligned, 471 2 target_a_offset fixed bin aligned, 472 2 pn1 fixed bin unaligned, 473 2 init fixed bin unaligned; 474 475 /* 476*P__r_o_c_e_d_u_r_e_s_C__a_l_l_e_d:_ 477* */ 478 479 dcl cobol_addr entry (ptr, ptr, ptr), 480 cobol_define_tag_nc entry (fixed bin, fixed bin), 481 cobol_emit entry (ptr, ptr, fixed bin), 482 cobol_make_tagref entry (fixed bin, fixed bin, ptr), 483 cobol_process_error entry (fixed bin, fixed bin, fixed bin), 484 cobol_move_gen entry (ptr), 485 cobol_register$load entry (ptr), 486 ioa_$rsnnl entry options (variable), 487 signal_ entry (char (*), ptr, ptr); 488 489 /* 490*B__u_i_l_t-__i_n_F__u_n_c_t_i_o_n_s_U__s_e_d:_ 491* */ 492 493 dcl addr builtin, 494 addrel builtin, 495 binary builtin, 496 null builtin, 497 substr builtin, 498 unspec builtin; 499 500 /*}*/ 501 10 1 10 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 10 3 /* last modified Feb 4, 1977 by ORN */ 10 4 10 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 10 6 10 7 /* POINTERS */ 10 8 dcl cobol_$text_base_ptr ptr ext; 10 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 10 10 dcl cobol_$con_end_ptr ptr ext; 10 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 10 12 dcl cobol_$def_base_ptr ptr ext; 10 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 10 14 dcl cobol_$link_base_ptr ptr ext; 10 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 10 16 dcl cobol_$sym_base_ptr ptr ext; 10 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 10 18 dcl cobol_$reloc_text_base_ptr ptr ext; 10 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 10 20 dcl cobol_$reloc_def_base_ptr ptr ext; 10 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 10 22 dcl cobol_$reloc_link_base_ptr ptr ext; 10 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 10 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 10 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 10 26 dcl cobol_$reloc_work_base_ptr ptr ext; 10 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 10 28 dcl cobol_$pd_map_ptr ptr ext; 10 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 10 30 dcl cobol_$fixup_ptr ptr ext; 10 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 10 32 dcl cobol_$initval_base_ptr ptr ext; 10 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 10 34 dcl cobol_$initval_file_ptr ptr ext; 10 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 10 36 dcl cobol_$perform_list_ptr ptr ext; 10 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 10 38 dcl cobol_$alter_list_ptr ptr ext; 10 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 10 40 dcl cobol_$seg_init_list_ptr ptr ext; 10 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 10 42 dcl cobol_$temp_token_area_ptr ptr ext; 10 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 10 44 dcl cobol_$temp_token_ptr ptr ext; 10 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 10 46 dcl cobol_$token_block1_ptr ptr ext; 10 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 10 48 dcl cobol_$token_block2_ptr ptr ext; 10 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 10 50 dcl cobol_$minpral5_ptr ptr ext; 10 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 10 52 dcl cobol_$tag_table_ptr ptr ext; 10 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 10 54 dcl cobol_$map_data_ptr ptr ext; 10 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 10 56 dcl cobol_$ptr_status_ptr ptr ext; 10 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 10 58 dcl cobol_$reg_status_ptr ptr ext; 10 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 10 60 dcl cobol_$misc_base_ptr ptr ext; 10 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 10 62 dcl cobol_$misc_end_ptr ptr ext; 10 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 10 64 dcl cobol_$list_ptr ptr ext; 10 65 dcl list_ptr ptr defined (cobol_$list_ptr); 10 66 dcl cobol_$allo1_ptr ptr ext; 10 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 10 68 dcl cobol_$eln_ptr ptr ext; 10 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 10 70 dcl cobol_$diag_ptr ptr ext; 10 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 10 72 dcl cobol_$xref_token_ptr ptr ext; 10 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 10 74 dcl cobol_$xref_chain_ptr ptr ext; 10 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 10 76 dcl cobol_$statement_info_ptr ptr ext; 10 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 10 78 dcl cobol_$reswd_ptr ptr ext; 10 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 10 80 dcl cobol_$op_con_ptr ptr ext; 10 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 10 82 dcl cobol_$ntbuf_ptr ptr ext; 10 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 10 84 dcl cobol_$main_pcs_ptr ptr ext; 10 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 10 86 dcl cobol_$include_info_ptr ptr ext; 10 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 10 88 10 89 /* FIXED BIN */ 10 90 dcl cobol_$text_wd_off fixed bin ext; 10 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 10 92 dcl cobol_$con_wd_off fixed bin ext; 10 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 10 94 dcl cobol_$def_wd_off fixed bin ext; 10 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 10 96 dcl cobol_$def_max fixed bin ext; 10 97 dcl def_max fixed bin defined (cobol_$def_max); 10 98 dcl cobol_$link_wd_off fixed bin ext; 10 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 10 100 dcl cobol_$link_max fixed bin ext; 10 101 dcl link_max fixed bin defined (cobol_$link_max); 10 102 dcl cobol_$sym_wd_off fixed bin ext; 10 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 10 104 dcl cobol_$sym_max fixed bin ext; 10 105 dcl sym_max fixed bin defined (cobol_$sym_max); 10 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 10 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 10 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 10 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 10 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 10 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 10 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 10 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 10 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 10 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 10 116 dcl cobol_$pd_map_index fixed bin ext; 10 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 10 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 10 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 10 120 dcl cobol_$stack_off fixed bin ext; 10 121 dcl stack_off fixed bin defined (cobol_$stack_off); 10 122 dcl cobol_$max_stack_off fixed bin ext; 10 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 10 124 dcl cobol_$init_stack_off fixed bin ext; 10 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 10 126 dcl cobol_$pd_map_sw fixed bin ext; 10 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 10 128 dcl cobol_$next_tag fixed bin ext; 10 129 dcl next_tag fixed bin defined (cobol_$next_tag); 10 130 dcl cobol_$data_init_flag fixed bin ext; 10 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 10 132 dcl cobol_$seg_init_flag fixed bin ext; 10 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 10 134 dcl cobol_$alter_flag fixed bin ext; 10 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 10 136 dcl cobol_$sect_eop_flag fixed bin ext; 10 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 10 138 dcl cobol_$para_eop_flag fixed bin ext; 10 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 10 140 dcl cobol_$priority_no fixed bin ext; 10 141 dcl priority_no fixed bin defined (cobol_$priority_no); 10 142 dcl cobol_$compile_count fixed bin ext; 10 143 dcl compile_count fixed bin defined (cobol_$compile_count); 10 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 10 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 10 146 dcl cobol_$reg_assumption_ind fixed bin ext; 10 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 10 148 dcl cobol_$perform_para_index fixed bin ext; 10 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 10 150 dcl cobol_$perform_sect_index fixed bin ext; 10 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 10 152 dcl cobol_$alter_index fixed bin ext; 10 153 dcl alter_index fixed bin defined (cobol_$alter_index); 10 154 dcl cobol_$list_off fixed bin ext; 10 155 dcl list_off fixed bin defined (cobol_$list_off); 10 156 dcl cobol_$constant_offset fixed bin ext; 10 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 10 158 dcl cobol_$misc_max fixed bin ext; 10 159 dcl misc_max fixed bin defined (cobol_$misc_max); 10 160 dcl cobol_$pd_map_max fixed bin ext; 10 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 10 162 dcl cobol_$map_data_max fixed bin ext; 10 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 10 164 dcl cobol_$fixup_max fixed bin ext; 10 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 10 166 dcl cobol_$tag_table_max fixed bin ext; 10 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 10 168 dcl cobol_$temp_token_max fixed bin ext; 10 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 10 170 dcl cobol_$allo1_max fixed bin ext; 10 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 10 172 dcl cobol_$eln_max fixed bin ext; 10 173 dcl eln_max fixed bin defined (cobol_$eln_max); 10 174 dcl cobol_$debug_enable fixed bin ext; 10 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 10 176 dcl cobol_$non_source_offset fixed bin ext; 10 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 10 178 dcl cobol_$initval_flag fixed bin ext; 10 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 10 180 dcl cobol_$date_compiled_sw fixed bin ext; 10 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 10 182 dcl cobol_$include_cnt fixed bin ext; 10 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 10 184 dcl cobol_$fs_charcnt fixed bin ext; 10 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 10 186 dcl cobol_$ws_charcnt fixed bin ext; 10 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 10 188 dcl cobol_$coms_charcnt fixed bin ext; 10 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 10 190 dcl cobol_$ls_charcnt fixed bin ext; 10 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 10 192 dcl cobol_$cons_charcnt fixed bin ext; 10 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 10 194 dcl cobol_$value_cnt fixed bin ext; 10 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 10 196 dcl cobol_$cd_cnt fixed bin ext; 10 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 10 198 dcl cobol_$fs_wdoff fixed bin ext; 10 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 10 200 dcl cobol_$ws_wdoff fixed bin ext; 10 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 10 202 dcl cobol_$coms_wdoff fixed bin ext; 10 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 10 204 10 205 /* CHARACTER */ 10 206 dcl cobol_$scratch_dir char (168) aligned ext; 10 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 10 208 dcl cobol_$obj_seg_name char (32) aligned ext; 10 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 10 210 10 211 /* BIT */ 10 212 dcl cobol_$xref_bypass bit(1) aligned ext; 10 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 10 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 10 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 10 216 10 217 10 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 10 219 10 220 502 503 504 505 /*************************************/ 506 start: 507 if in_token.token_ptr (in_token.n) -> end_stmt.a = "000"b 508 then go to format1; 509 else go to format2; 510 511 /*************************************/ 512 format1: 513 proc_ref_ptr = in_token.token_ptr (in_token.n - 1); 514 pnn_num = proc_ref.proc_num; 515 pnn_priority = binary (unspec (proc_ref.priority), 17); 516 if cobol_$alter_flag = 0 517 then /* GO statement is not object of ALTER statement. */ 518 do; 519 if pnn_num = 0 520 then /* Program is in erroor. */ 521 do; /* This statement must be revised when two part line */ 522 /* becomes available. */ 523 call ioa_$rsnnl ("Line no. ^d: GO TO ?", error_info.message, error_info.message_len, 524 in_token.token_ptr (1) -> proc_ref.line); 525 call signal_ ("command_error", null, addr (error_info)); 526 s_text_wd = cobol_$text_wd_off; 527 call cobol_process_error (20, in_token.token_ptr (1) -> proc_ref.line, 0); 528 temp = s_text_wd - cobol_$text_wd_off; 529 seq_f1_b (1) = substr (unspec (temp), 19, 18); 530 call cobol_emit (addr (seq_f1_b), null, 1); 531 end; 532 533 else do; 534 if cobol_$seg_init_list_ptr = null 535 then init_req_flag = 1; 536 537 else call is_init_req; 538 539 if init_req_flag = 1 540 then call cobol_emit (addr (seq_f1_b), null, 1); 541 542 else do; 543 register_request.requested_reg = 1; 544 call cobol_register$load (addr (register_request)); 545 call cobol_emit (addr (seq_f1_c), null, 2); 546 call cobol_make_tagref (init_tag, cobol_$text_wd_off - 1, null); 547 end; 548 549 call cobol_make_tagref (pnn_num, cobol_$text_wd_off - init_req_flag, null); 550 end; 551 552 end; 553 554 else /* GO statement is object of ALTER statement. */ 555 do; 556 s_text_wd = cobol_$text_wd_off; 557 target.segno = alter_list.goto.target_a_segno (cobol_$alter_index); 558 target.char_offset = alter_list.goto.target_a_offset (cobol_$alter_index); 559 cobol_$alter_index = cobol_$alter_index + 1; 560 call cobol_addr (addr (target), addr (seq_f1_a), null); 561 register_request.requested_reg = 1; 562 call cobol_register$load (addr (register_request)); 563 call cobol_emit (addr (seq_f1_a), null, 2); 564 565 /* Store initialization data. */ 566 567 cnt_pri = cobol_$priority_no; 568 if cnt_pri < 50 569 then cnt_pri = 0; 570 571 do jndex = 1 to seg_init_list.n; 572 if seg_init_list.seg.priority (jndex) = cnt_pri 573 then do; 574 init_ptr = 575 addrel (seg_init_list.seg.init_ptr (jndex), 576 3 * seg_init_list.seg.next_init_no (jndex)); 577 seg_init_list.seg.next_init_no (jndex) = seg_init_list.seg.next_init_no (jndex) + 1; 578 init_data.target_a_segno = target.segno; 579 init_data.target_a_offset = target.char_offset; 580 init_data.pn1 = pnn_num; 581 call is_init_req; 582 if init_req_flag = 1 583 then init_data.init = 0; 584 585 else init_data.init = init_tag; 586 587 goto next_step; 588 end; 589 590 end; 591 592 next_step: 593 if pnn_num = 0 594 then do; 595 init_data.pn1 = cobol_$next_tag; 596 call cobol_define_tag_nc (cobol_$next_tag, cobol_$text_wd_off); 597 cobol_$next_tag = cobol_$next_tag + 1; 598 call cobol_process_error (20, in_token.token_ptr (1) -> proc_ref.line, 0); 599 temp = s_text_wd - cobol_$text_wd_off; 600 seq_f1_b (1) = substr (unspec (temp), 19, 18); 601 call cobol_emit (addr (seq_f1_b), null, 1); 602 end; 603 604 end; 605 606 return; 607 608 609 /*************************************/ 610 format2: 611 nt = in_token.token_ptr (in_token.n) -> end_stmt.e; 612 sum = nt; 613 call cobol_emit (addr (seq_f2_1 (1)), null, 1); 614 mpout.pt1 = null (); 615 mpout.pt2 = in_token.token_ptr (nt + 2); 616 comp7_type9.flags1 = "000000100100010001000000010000000000"b; 617 mpout.pt3 = addr (comp7_type9); 618 mpout.pt4 = addr (type19); 619 call cobol_move_gen (addr (mpout)); 620 seq_f2_1 (5) = substr (unspec (nt), 19, 18); 621 if cobol_$seg_init_list_ptr = null 622 then do jndex = 1 to nt; 623 trans (jndex) = "000000000000000000111001000000000100"b; 624 pnn_num = in_token.token_ptr (in_token.n + jndex - nt - 2) -> proc_ref.proc_num; 625 call cobol_make_tagref (pnn_num, cobol_$text_wd_off + jndex + 5, addr (trans (jndex))); 626 end; 627 628 else do jndex = 1 to nt; 629 trans (jndex) = "000000000000000000111001000000000100"b; 630 proc_ref_ptr = in_token.token_ptr (in_token.n + jndex - nt - 2); 631 pnn_num = proc_ref.proc_num; 632 pnn_priority = binary (unspec (proc_ref.priority), 17); 633 call is_init_req; 634 if init_req_flag = 1 635 then call cobol_make_tagref (pnn_num, cobol_$text_wd_off + jndex + 5, addr (trans (jndex))); 636 637 else do; 638 sum = sum + 1; 639 temp = sum - jndex; 640 substr (trans (jndex), 1, 18) = substr (unspec (temp), 19, 18); 641 trans (sum) = "000000000000000000110011101000000100"b; 642 call cobol_make_tagref (pnn_num, cobol_$text_wd_off + sum + 5, addr (trans (sum))); 643 sum = sum + 1; 644 trans (sum) = "000000000000000000111001000000000100"b; 645 call cobol_make_tagref (init_tag, cobol_$text_wd_off + sum + 5, addr (trans (sum))); 646 end; 647 648 end; 649 650 temp = sum + 3; 651 seq_f2_1 (9) = substr (unspec (temp), 19, 18); 652 register_request.requested_reg = 1; 653 call cobol_register$load (addr (register_request)); 654 register_request.requested_reg = 12; 655 call cobol_register$load (addr (register_request)); 656 call cobol_emit (addr (seq_f2_1 (3)), null, 6); 657 call cobol_emit (addr (trans), null, sum); 658 659 return; 660 661 662 is_init_req: 663 proc; 664 665 if cobol_$priority_no ^= pnn_priority 666 then if pnn_priority > 49 667 then do index = 1 to seg_init_list.n; 668 if seg_init_list.seg.priority (index) = pnn_priority 669 then do; 670 init_req_flag = 2; 671 init_tag = seg_init_list.seg.int_tag_no (index); 672 goto finis; 673 end; 674 675 end; 676 init_req_flag = 1; 677 678 finis: 679 return; 680 681 end is_init_req; 682 683 end cobol_go_gen; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0831.0 cobol_go_gen.pl1 >spec>install>MR12.3-1048>cobol_go_gen.pl1 74 1 11/11/82 1712.7 cobol_in_token.incl.pl1 >ldd>include>cobol_in_token.incl.pl1 241 2 03/27/82 0439.6 cobol_alter_list.incl.pl1 >ldd>include>cobol_alter_list.incl.pl1 242 3 03/27/82 0439.8 cobol_seg_init_list.incl.pl1 >ldd>include>cobol_seg_init_list.incl.pl1 243 4 03/27/82 0439.9 cobol_type9.incl.pl1 >ldd>include>cobol_type9.incl.pl1 4-17 5 11/11/82 1712.7 cobol_TYPE9.incl.pl1 >ldd>include>cobol_TYPE9.incl.pl1 245 6 11/11/82 1712.8 cobol_type18.incl.pl1 >ldd>include>cobol_type18.incl.pl1 6-17 7 03/27/82 0439.6 cobol_TYPE18.incl.pl1 >ldd>include>cobol_TYPE18.incl.pl1 246 8 03/27/82 0439.8 cobol_type19.incl.pl1 >ldd>include>cobol_type19.incl.pl1 8-17 9 03/27/82 0439.6 cobol_TYPE19.incl.pl1 >ldd>include>cobol_TYPE19.incl.pl1 502 10 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. a 11 based bit(3) level 2 packed packed unaligned dcl 8-16 ref 506 addr builtin function dcl 493 ref 525 525 530 530 539 539 544 544 545 545 560 560 560 560 562 562 563 563 601 601 613 613 617 618 619 619 625 625 634 634 642 642 645 645 653 653 655 655 656 656 657 657 addrel builtin function dcl 493 ref 574 alter_list based structure level 1 dcl 2-7 binary builtin function dcl 493 ref 515 632 char_offset 4 000021 internal static fixed bin(24,0) level 2 dcl 297 set ref 558* 579 cnt_pri 001506 automatic fixed bin(17,0) dcl 440 set ref 567* 568 568* 572 cobol_$alter_flag 000242 external static fixed bin(17,0) dcl 10-134 ref 516 cobol_$alter_index 000246 external static fixed bin(17,0) dcl 10-152 set ref 557 558 559* 559 cobol_$alter_list_ptr 000232 external static pointer dcl 10-38 ref 557 558 cobol_$next_tag 000240 external static fixed bin(17,0) dcl 10-128 set ref 595 596* 597* 597 cobol_$priority_no 000244 external static fixed bin(17,0) dcl 10-140 ref 567 665 cobol_$seg_init_list_ptr 000234 external static pointer dcl 10-40 ref 534 571 572 574 574 577 577 621 665 668 671 cobol_$text_wd_off 000236 external static fixed bin(17,0) dcl 10-90 set ref 526 528 546 549 556 596* 599 625 634 642 645 cobol_addr 000210 constant entry external dcl 479 ref 560 cobol_define_tag_nc 000212 constant entry external dcl 479 ref 596 cobol_emit 000214 constant entry external dcl 479 ref 530 539 545 563 601 613 656 657 cobol_make_tagref 000216 constant entry external dcl 479 ref 546 549 625 634 642 645 cobol_move_gen 000222 constant entry external dcl 479 ref 619 cobol_process_error 000220 constant entry external dcl 479 ref 527 598 cobol_register$load 000224 constant entry external dcl 479 ref 544 562 653 655 comp7_type9 000112 internal static structure level 1 unaligned dcl 381 set ref 617 e 5 based fixed bin(17,0) level 2 dcl 8-16 ref 610 end_stmt based structure level 1 unaligned dcl 8-16 error_info 000027 internal static structure level 1 dcl 376 set ref 525 525 file_key_info 13 000112 internal static structure level 2 unaligned dcl 381 flags1 21 000112 internal static bit(36) initial level 3 packed packed unaligned dcl 381 set ref 616* goto 1 based structure array level 2 dcl 2-7 in_token based structure level 1 dcl 1-9 in_token_ptr parameter pointer dcl 1-7 ref 27 506 506 512 512 523 527 598 610 610 615 624 624 630 630 index 001511 automatic fixed bin(17,0) dcl 440 set ref 665* 668 671* init 2(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 469 set ref 582* 585* init_data based structure level 1 dcl 469 init_ptr 001514 automatic pointer dcl 440 in procedure "cobol_go_gen" set ref 574* 578 579 580 582 585 595 init_ptr 6 based pointer array level 3 in structure "seg_init_list" dcl 3-7 in procedure "cobol_go_gen" ref 574 init_req_flag 001504 automatic fixed bin(17,0) dcl 440 set ref 534* 539 549 582 634 670* 676* init_tag 001507 automatic fixed bin(17,0) dcl 440 set ref 546* 585 645* 671* int_tag_no 3 based fixed bin(17,0) array level 3 dcl 3-7 ref 671 ioa_$rsnnl 000226 constant entry external dcl 479 ref 523 jndex 001512 automatic fixed bin(17,0) dcl 440 set ref 571* 572 574 574 577 577* 621* 623 624 625 625 625* 628* 629 630 634 634 634 639 640* line 1 based fixed bin(17,0) level 2 dcl 6-16 set ref 523* 527* 598* message 11 000027 internal static char(168) level 2 dcl 376 set ref 523* message_len 10 000027 internal static fixed bin(17,0) level 2 dcl 376 set ref 523* mpout 000160 internal static structure level 1 unaligned dcl 403 set ref 619 619 n based fixed bin(17,0) level 2 in structure "seg_init_list" dcl 3-7 in procedure "cobol_go_gen" ref 571 665 n based fixed bin(17,0) level 2 in structure "in_token" dcl 1-9 in procedure "cobol_go_gen" ref 506 512 610 624 630 next_init_no 5 based fixed bin(17,0) array level 3 dcl 3-7 set ref 574 577* 577 nt 001516 automatic fixed bin(17,0) dcl 440 set ref 610* 612 615 620 621 624 628 630 null builtin function dcl 493 ref 525 525 530 530 534 539 539 545 545 546 546 549 549 560 560 563 563 601 601 613 613 614 621 656 656 657 657 pn1 2 based fixed bin(17,0) level 2 packed packed unaligned dcl 469 set ref 580* 595* pnn_num 001510 automatic fixed bin(17,0) dcl 440 set ref 514* 519 549* 580 592 624* 625* 631* 634* 642* pnn_priority 001505 automatic fixed bin(17,0) dcl 440 set ref 515* 632* 665 665 668 priority 2 based fixed bin(17,0) array level 3 in structure "seg_init_list" dcl 3-7 in procedure "cobol_go_gen" ref 572 668 priority 10(09) based char(2) level 2 in structure "proc_ref" packed packed unaligned dcl 6-16 in procedure "cobol_go_gen" ref 515 632 proc_num 12 based fixed bin(17,0) level 2 dcl 6-16 ref 514 624 631 proc_ref based structure level 1 unaligned dcl 6-16 proc_ref_ptr 000100 automatic pointer dcl 6-13 set ref 512* 514 515 630* 631 632 pt1 2 000160 internal static pointer level 2 dcl 403 set ref 614* pt2 4 000160 internal static pointer level 2 dcl 403 set ref 615* pt3 6 000160 internal static pointer level 2 dcl 403 set ref 617* pt4 10 000160 internal static pointer level 2 dcl 403 set ref 618* register_request 000010 internal static structure level 1 dcl 250 set ref 544 544 562 562 653 653 655 655 requested_reg 000010 internal static fixed bin(17,0) level 2 dcl 250 set ref 543* 561* 652* 654* s_text_wd 001502 automatic fixed bin(17,0) dcl 440 set ref 526* 528 556* 599 seg 2 based structure array level 2 dcl 3-7 seg_init_list based structure level 1 dcl 3-7 segno 3 000021 internal static fixed bin(17,0) level 2 dcl 297 set ref 557* 578 seq_f1_a 000172 internal static bit(18) initial array packed unaligned dcl 410 set ref 560 560 563 563 seq_f1_b 000174 internal static bit(18) initial array packed unaligned dcl 415 set ref 529* 530 530 539 539 600* 601 601 seq_f1_c 000176 internal static bit(18) initial array packed unaligned dcl 418 set ref 545 545 seq_f2_1 000200 internal static bit(18) initial array packed unaligned dcl 423 set ref 613 613 620* 651* 656 656 signal_ 000230 constant entry external dcl 479 ref 525 substr builtin function dcl 493 set ref 529 600 620 640* 640 651 sum 001517 automatic fixed bin(17,0) dcl 440 set ref 612* 638* 638 639 641 642 642 642 643* 643 644 645 645 645 650 657* target 000021 internal static structure level 1 dcl 297 set ref 560 560 target_a_offset 4 based fixed bin(24,0) array level 3 in structure "alter_list" dcl 2-7 in procedure "cobol_go_gen" ref 558 target_a_offset 1 based fixed bin(17,0) level 2 in structure "init_data" dcl 469 in procedure "cobol_go_gen" set ref 579* target_a_segno based fixed bin(17,0) level 2 in structure "init_data" dcl 469 in procedure "cobol_go_gen" set ref 578* target_a_segno 3 based fixed bin(17,0) array level 3 in structure "alter_list" dcl 2-7 in procedure "cobol_go_gen" ref 557 temp 001503 automatic fixed bin(17,0) dcl 440 set ref 528* 529 599* 600 639* 640 650* 651 token_ptr 2 based pointer array level 2 dcl 1-9 ref 506 512 523 527 598 610 615 624 630 trans 000102 automatic bit(36) array packed unaligned dcl 438 set ref 623* 625 625 629* 634 634 640* 641* 642 642 644* 645 645 657 657 type19 000146 internal static structure level 1 unaligned dcl 395 set ref 618 unspec builtin function dcl 493 ref 515 529 600 620 632 640 651 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. allo1_max defined fixed bin(17,0) dcl 10-171 allo1_ptr defined pointer dcl 10-67 alter_flag defined fixed bin(17,0) dcl 10-135 alter_index defined fixed bin(17,0) dcl 10-153 alter_list_ptr defined pointer dcl 10-39 cd_cnt defined fixed bin(17,0) dcl 10-197 cobol_$allo1_max external static fixed bin(17,0) dcl 10-170 cobol_$allo1_ptr external static pointer dcl 10-66 cobol_$cd_cnt external static fixed bin(17,0) dcl 10-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 10-118 cobol_$compile_count external static fixed bin(17,0) dcl 10-142 cobol_$coms_charcnt external static fixed bin(17,0) dcl 10-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 10-202 cobol_$con_end_ptr external static pointer dcl 10-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 10-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 10-192 cobol_$constant_offset external static fixed bin(17,0) dcl 10-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 10-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 10-180 cobol_$debug_enable external static fixed bin(17,0) dcl 10-174 cobol_$def_base_ptr external static pointer dcl 10-12 cobol_$def_max external static fixed bin(17,0) dcl 10-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 10-94 cobol_$diag_ptr external static pointer dcl 10-70 cobol_$eln_max external static fixed bin(17,0) dcl 10-172 cobol_$eln_ptr external static pointer dcl 10-68 cobol_$fixup_max external static fixed bin(17,0) dcl 10-164 cobol_$fixup_ptr external static pointer dcl 10-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 10-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 10-198 cobol_$include_cnt external static fixed bin(17,0) dcl 10-182 cobol_$include_info_ptr external static pointer dcl 10-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 10-124 cobol_$initval_base_ptr external static pointer dcl 10-32 cobol_$initval_file_ptr external static pointer dcl 10-34 cobol_$initval_flag external static fixed bin(17,0) dcl 10-178 cobol_$link_base_ptr external static pointer dcl 10-14 cobol_$link_max external static fixed bin(17,0) dcl 10-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 10-98 cobol_$list_off external static fixed bin(17,0) dcl 10-154 cobol_$list_ptr external static pointer dcl 10-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 10-190 cobol_$main_pcs_ptr external static pointer dcl 10-84 cobol_$map_data_max external static fixed bin(17,0) dcl 10-162 cobol_$map_data_ptr external static pointer dcl 10-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 10-122 cobol_$minpral5_ptr external static pointer dcl 10-50 cobol_$misc_base_ptr external static pointer dcl 10-60 cobol_$misc_end_ptr external static pointer dcl 10-62 cobol_$misc_max external static fixed bin(17,0) dcl 10-158 cobol_$non_source_offset external static fixed bin(17,0) dcl 10-176 cobol_$ntbuf_ptr external static pointer dcl 10-82 cobol_$obj_seg_name external static char(32) dcl 10-208 cobol_$op_con_ptr external static pointer dcl 10-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 10-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 10-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 10-160 cobol_$pd_map_ptr external static pointer dcl 10-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 10-126 cobol_$perform_list_ptr external static pointer dcl 10-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 10-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 10-150 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 10-144 cobol_$ptr_status_ptr external static pointer dcl 10-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 10-146 cobol_$reg_status_ptr external static pointer dcl 10-58 cobol_$reloc_def_base_ptr external static pointer dcl 10-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 10-108 cobol_$reloc_link_base_ptr external static pointer dcl 10-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 10-110 cobol_$reloc_sym_base_ptr external static pointer dcl 10-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 10-112 cobol_$reloc_text_base_ptr external static pointer dcl 10-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 10-106 cobol_$reloc_work_base_ptr external static pointer dcl 10-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 10-114 cobol_$reswd_ptr external static pointer dcl 10-78 cobol_$same_sort_merge_proc external static bit(1) dcl 10-214 cobol_$scratch_dir external static char(168) dcl 10-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 10-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 10-132 cobol_$stack_off external static fixed bin(17,0) dcl 10-120 cobol_$statement_info_ptr external static pointer dcl 10-76 cobol_$sym_base_ptr external static pointer dcl 10-16 cobol_$sym_max external static fixed bin(17,0) dcl 10-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 10-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 10-166 cobol_$tag_table_ptr external static pointer dcl 10-52 cobol_$temp_token_area_ptr external static pointer dcl 10-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 10-168 cobol_$temp_token_ptr external static pointer dcl 10-44 cobol_$text_base_ptr external static pointer dcl 10-8 cobol_$token_block1_ptr external static pointer dcl 10-46 cobol_$token_block2_ptr external static pointer dcl 10-48 cobol_$value_cnt external static fixed bin(17,0) dcl 10-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 10-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 10-200 cobol_$xref_bypass external static bit(1) dcl 10-212 cobol_$xref_chain_ptr external static pointer dcl 10-74 cobol_$xref_token_ptr external static pointer dcl 10-72 cobol_data_wd_off defined fixed bin(17,0) dcl 10-119 compile_count defined fixed bin(17,0) dcl 10-143 coms_charcnt defined fixed bin(17,0) dcl 10-189 coms_wdoff defined fixed bin(17,0) dcl 10-203 con_end_ptr defined pointer dcl 10-11 con_wd_off defined fixed bin(17,0) dcl 10-93 cons_charcnt defined fixed bin(17,0) dcl 10-193 constant_offset defined fixed bin(17,0) dcl 10-157 data_init_flag defined fixed bin(17,0) dcl 10-131 data_name based structure level 1 unaligned dcl 4-16 date_compiled_sw defined fixed bin(17,0) dcl 10-181 debug_enable defined fixed bin(17,0) dcl 10-175 def_base_ptr defined pointer dcl 10-13 def_max defined fixed bin(17,0) dcl 10-97 def_wd_off defined fixed bin(17,0) dcl 10-95 diag_ptr defined pointer dcl 10-71 dn_ptr automatic pointer dcl 244 eln_max defined fixed bin(17,0) dcl 10-173 eln_ptr defined pointer dcl 10-69 eos_ptr automatic pointer dcl 8-13 fixup_max defined fixed bin(17,0) dcl 10-165 fixup_ptr defined pointer dcl 10-31 fs_charcnt defined fixed bin(17,0) dcl 10-185 fs_wdoff defined fixed bin(17,0) dcl 10-199 include_cnt defined fixed bin(17,0) dcl 10-183 include_info_ptr defined pointer dcl 10-87 init_stack_off defined fixed bin(17,0) dcl 10-125 initval_base_ptr defined pointer dcl 10-33 initval_file_ptr defined pointer dcl 10-35 initval_flag defined fixed bin(17,0) dcl 10-179 input_struc internal static structure level 1 dcl 328 link_base_ptr defined pointer dcl 10-15 link_max defined fixed bin(17,0) dcl 10-101 link_wd_off defined fixed bin(17,0) dcl 10-99 list_off defined fixed bin(17,0) dcl 10-155 list_ptr defined pointer dcl 10-65 ls_charcnt defined fixed bin(17,0) dcl 10-191 main_pcs_ptr defined pointer dcl 10-85 map_data_max defined fixed bin(17,0) dcl 10-163 map_data_ptr defined pointer dcl 10-55 max_stack_off defined fixed bin(17,0) dcl 10-123 minpral5_ptr defined pointer dcl 10-51 misc_base_ptr defined pointer dcl 10-61 misc_end_ptr defined pointer dcl 10-63 misc_max defined fixed bin(17,0) dcl 10-159 next_tag defined fixed bin(17,0) dcl 10-129 non_source_offset defined fixed bin(17,0) dcl 10-177 ntbuf_ptr defined pointer dcl 10-83 obj_seg_name defined char(32) dcl 10-209 op_con_ptr defined pointer dcl 10-81 para_eop_flag defined fixed bin(17,0) dcl 10-139 pd_map_index defined fixed bin(17,0) dcl 10-117 pd_map_max defined fixed bin(17,0) dcl 10-161 pd_map_ptr defined pointer dcl 10-29 pd_map_sw defined fixed bin(17,0) dcl 10-127 perform_list_ptr defined pointer dcl 10-37 perform_para_index defined fixed bin(17,0) dcl 10-149 perform_sect_index defined fixed bin(17,0) dcl 10-151 priority_no defined fixed bin(17,0) dcl 10-141 ptr_assumption_ind defined fixed bin(17,0) dcl 10-145 ptr_status_ptr defined pointer dcl 10-57 reg_assumption_ind defined fixed bin(17,0) dcl 10-147 reg_status_ptr defined pointer dcl 10-59 reloc_def_base_ptr defined pointer dcl 10-21 reloc_def_max defined fixed bin(24,0) dcl 10-109 reloc_link_base_ptr defined pointer dcl 10-23 reloc_link_max defined fixed bin(24,0) dcl 10-111 reloc_sym_base_ptr defined pointer dcl 10-25 reloc_sym_max defined fixed bin(24,0) dcl 10-113 reloc_text_base_ptr defined pointer dcl 10-19 reloc_text_max defined fixed bin(24,0) dcl 10-107 reloc_work_base_ptr defined pointer dcl 10-27 reloc_work_max defined fixed bin(24,0) dcl 10-115 reswd_ptr defined pointer dcl 10-79 same_sort_merge_proc defined bit(1) dcl 10-215 scratch_dir defined char(168) dcl 10-207 sect_eop_flag defined fixed bin(17,0) dcl 10-137 seg_init_flag defined fixed bin(17,0) dcl 10-133 seg_init_list_ptr defined pointer dcl 10-41 stack_off defined fixed bin(17,0) dcl 10-121 statement_info_ptr defined pointer dcl 10-77 sym_base_ptr defined pointer dcl 10-17 sym_max defined fixed bin(17,0) dcl 10-105 sym_wd_off defined fixed bin(17,0) dcl 10-103 tag_table_max defined fixed bin(17,0) dcl 10-167 tag_table_ptr defined pointer dcl 10-53 temp_token_area_ptr defined pointer dcl 10-43 temp_token_max defined fixed bin(17,0) dcl 10-169 temp_token_ptr defined pointer dcl 10-45 text_base_ptr defined pointer dcl 10-9 text_wd_off defined fixed bin(17,0) dcl 10-91 token_block1_ptr defined pointer dcl 10-47 token_block2_ptr defined pointer dcl 10-49 value_cnt defined fixed bin(17,0) dcl 10-195 ws_charcnt defined fixed bin(17,0) dcl 10-187 ws_wdoff defined fixed bin(17,0) dcl 10-201 xref_bypass defined bit(1) dcl 10-213 xref_chain_ptr defined pointer dcl 10-75 xref_token_ptr defined pointer dcl 10-73 NAMES DECLARED BY EXPLICIT CONTEXT. cobol_go_gen 000025 constant entry external dcl 27 finis 001253 constant label dcl 678 ref 672 format1 000045 constant label dcl 512 ref 506 format2 000617 constant label dcl 610 ref 509 is_init_req 001211 constant entry internal dcl 662 ref 537 581 633 next_step 000525 constant label dcl 592 ref 587 start 000032 constant label dcl 506 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1460 1730 1254 1470 Length 2356 1254 250 412 204 200 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_go_gen 893 external procedure is an external procedure. is_init_req internal procedure shares stack frame of external procedure cobol_go_gen. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 register_request cobol_go_gen 000021 target cobol_go_gen 000027 error_info cobol_go_gen 000112 comp7_type9 cobol_go_gen 000146 type19 cobol_go_gen 000160 mpout cobol_go_gen 000172 seq_f1_a cobol_go_gen 000174 seq_f1_b cobol_go_gen 000176 seq_f1_c cobol_go_gen 000200 seq_f2_1 cobol_go_gen STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_go_gen 000100 proc_ref_ptr cobol_go_gen 000102 trans cobol_go_gen 001502 s_text_wd cobol_go_gen 001503 temp cobol_go_gen 001504 init_req_flag cobol_go_gen 001505 pnn_priority cobol_go_gen 001506 cnt_pri cobol_go_gen 001507 init_tag cobol_go_gen 001510 pnn_num cobol_go_gen 001511 index cobol_go_gen 001512 jndex cobol_go_gen 001514 init_ptr cobol_go_gen 001516 nt cobol_go_gen 001517 sum cobol_go_gen THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_addr cobol_define_tag_nc cobol_emit cobol_make_tagref cobol_move_gen cobol_process_error cobol_register$load ioa_$rsnnl signal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$alter_flag cobol_$alter_index cobol_$alter_list_ptr cobol_$next_tag cobol_$priority_no cobol_$seg_init_list_ptr cobol_$text_wd_off LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 27 000022 506 000032 509 000044 512 000045 514 000050 515 000052 516 000056 519 000060 523 000062 525 000114 526 000144 527 000147 528 000170 529 000174 530 000177 531 000217 534 000220 537 000227 539 000230 543 000255 544 000260 545 000270 546 000311 549 000331 552 000351 556 000352 557 000354 558 000362 559 000366 560 000367 561 000407 562 000412 563 000422 567 000443 568 000446 571 000451 572 000461 574 000471 577 000477 578 000500 579 000502 580 000504 581 000507 582 000510 585 000517 587 000522 590 000523 592 000525 595 000527 596 000534 597 000544 598 000546 599 000567 600 000573 601 000576 606 000616 610 000617 612 000621 613 000622 614 000642 615 000645 616 000654 617 000656 618 000660 619 000662 620 000672 621 000676 623 000711 624 000713 625 000724 626 000746 628 000751 629 000761 630 000763 631 000773 632 000775 633 001001 634 001002 638 001030 639 001031 640 001034 641 001041 642 001044 643 001065 644 001066 645 001071 648 001112 650 001114 651 001117 652 001123 653 001125 654 001135 655 001140 656 001150 657 001171 659 001210 662 001211 665 001212 668 001231 670 001241 671 001243 672 001246 675 001247 676 001251 678 001253 ----------------------------------------------------------- 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