/* Input structure for cobol_register$load */ declare 1 register_request aligned static, 2 requested_reg fixed bin aligned init(12), 2 assigned_reg bit(4) aligned, 2 lock fixed bin aligned init(1), 2 reg_set_now fixed bin aligned, 2 use_code fixed bin aligned init(0), 2 adjust_ptr_addr fixed bin aligned init(0), 2 content_ptr ptr aligned init(null), 2 literal_content bit(36) aligned init((36)"0"b); /* requested_reg is a code designating the register requested; 0 - a- or q- or any index-register 1 - a-register 2 - q-register 3 - a- and q-register 4 - a- or q-register 5 - any index-register 1n - index-register n assigned_reg is a code designating the register assigned. It has no significance if a specific register is requested. lock indicates locking requirements; 1 requests that the register be locked. reg_set_now not applicable for use_code = 0. use_code specifies how the register is to be used by the requester; 0 signifies that such information is not meaningful for register optimization. adjust_ptr_addr inserted to make evident that since all pointers must be allocated on even word boundaries, the pl1 compiler will allocate structures containing pointers and all pointers therein on even word boundaries leaving "gaps" where necessary. content_ptr not applicable for use_code = 0. literal_content not applicable for use_code = 0. */ /* Input structures for cobol_addr */ declare 1 target aligned static, 2 type fixed bin aligned init(1), 2 operand_no fixed bin aligned init(0), 2 lock fixed bin aligned init(0), 2 segno fixed bin aligned, 2 char_offset fixed bin(24) aligned, 2 send_receive fixed bin aligned init(0); declare 1 count aligned static, 2 type fixed bin aligned init(1), 2 operand_no fixed bin aligned init(0), 2 lock fixed bin aligned init(1), 2 segno fixed bin aligned init(2), 2 char_offset fixed bin(24) aligned, 2 send_receive fixed bin aligned init(0); /* type indicates type of addressing requested. Type 1 indicates basic; i.e., data to be addressed is specified by segno and char_offset. operand_no not applicable to type 1. lock indicates lock requirements for registers used in addressing; 0 - do not lock registers used. 1 - lock registers used. segno is the compiler designation of the segment in which the data to be addressed is located. char_offset is the character offset within segno of the data to be addressed. send_receive indicates whether the data being addressed is a sending or receiving field for the instruction whose address field is being set; 0 indicates sending. */ declare 1 input_struc aligned static, 2 type fixed bin aligned init(4), 2 operand_no fixed bin aligned init(1), 2 lock fixed bin aligned init(0), 2 operand, 3 token_ptr ptr aligned init(null), 3 send_receive fixed bin aligned init(0), 3 ic_mod fixed bin aligned, 3 size_sw fixed bin aligned init(0); /* type indicates type of addressing requested. 1 - no operand, 1 wd, basic 2 - 1 operand, 1 wd, non-EIS 3 - 1 operand, 1 wd, EIS 4 - 1 operand, 1 desc, 2wd, EIS 5 - 2 operands, 2 desc, 3 wd, EIS 6 - 3 operands, 3 desc, 4 wd, EIS operand_no number of operands associated with requested type. lock indicates lock requirements for registers used in addressing. 0 - do not lock registers used 1 - lock registers used 2 - unlock all registers token_ptr is a pointer to the operand token. send_receive indicates whether the operand being addressed is a sending or receiving field for the instruction. 0 - sending operand 1 - receiving operand ic_mod indicates whether ic modification is specified in the mf field of this operand (set by cobol_addr). 0 - no ic modification 1 - ic modification size_sw indicates size (length) handlhlng requirements to cobol_addr. 0 - cobol_addr may store the operand size in a register or in the instruction 1 - cobol_addr need not be concerned with size */ /* Input structure for cobol_pointer_register$get */ declare 1 ptr_register_request aligned static, 2 what_pointer fixed bin aligned init(2), 2 assigned_ptr fixed bin aligned, 2 lock fixed bin aligned init(1), 2 switch fixed bin aligned init(0), 2 segno fixed bin aligned init(0), 2 offset fixed bin aligned init(0), 2 reset fixed bin aligned; /* where: what_pointer is the number of the desired pointer register. (Input) assigned_ptr is the number of the register assigned. (Output) lock specifies locking requirements. (0 - do not lock requested register). (Input) switch specifies the significance of segno and offset. (0 - segno and word offset are not supplied). (Input) segno is the segment number that the pointer register is to contain. (Input) offset is the word or character offset that the pointer reginter is to contain. (Input) */ /* Static Data */ declare 1 equate_tag aligned static, 2 size fixed bin aligned init(0), 2 line fixed bin aligned init(0), 2 column fixed bin aligned init(0), 2 type fixed bin aligned init(31), 2 filler1 fixed bin aligned init(0), 2 equated_tag fixed bin aligned init(0), 2 true_tag fixed bin aligned init(0), 2 filler2 fixed bin aligned init(0), 2 filler3 fixed bin aligned init(0), 2 filler4 bit(16) aligned init((16)"0"b); declare 1 eos_token aligned static, 2 size fixed bin init(0), 2 line fixed bin init(0), 2 column fixed bin init(0), 2 type fixed bin init(19), 2 verb fixed bin init(0), 2 e fixed bin init(0), 2 h fixed bin init(0), 2 i fixed bin init(0), 2 j fixed bin init(0), 2 a bit(3) init("000"b), 2 b bit(1) init("0"b), 2 c bit(1) init("0"b), 2 d bit(2) init("00"b), 2 f bit(2) init("00"b), 2 g bit(2) init("00"b), 2 k bit(5) init("00000"b); declare 1 seg_ovfl_error aligned static, 2 my_name char(32) init("cobol_perform_gen"), 2 message_len fixed bin init(32), 2 message char(32) init ("Temp_token_area length exceeded!"); /* Declarations for instruction sequences */ dcl seq1(8) bit(18) unaligned static init ("000000000001000000"b, "011000101101000000"b, /* dtb (ar),(ar) */ "000000000000000000"b, "000000000000000000"b, /* ndsc9 id_10,l */ "000000000000000000"b, "000000000000000100"b, /* ndsc9 id10_fb,4 */ "000000000000000000"b, "110000100100000100"b); /* tmoz loc_b_relp,ic */ dcl seq2(8) bit(18) unaligned static init ("000000000000000000"b, "100101000001000000"b, /* stz count */ "000000000000000011"b, "110010010000000100"b, /* eax2 3,ic */ "000000000000000000"b, "100100010001000000"b, /* sxl2 target_a_PN2 */ "000000000000000000"b, "111001000000000100"b); /* tra PN1_relp1,ic */ dcl seq2i(10) bit(18) unaligned static init ("000000000000000000"b, "100101000001000000"b, /* stz count */ "000000000000000100"b, "110010010000000100"b, /* eax2 4,ic */ "000000000000000000"b, "100100010001000000"b, /* sxl2 target_a_PN2 */ "000000000000000000"b, "110011101000000100"b, /* eaa PN1_relp1,ic */ "000000000000000000"b, "111001000000000100"b); /* tra i_segm_relp,ic */ dcl seq3(14) bit(18) unaligned static init ("000000000000000000"b, "010011110001000000"b, /* ldq count */ "000000000000000001"b, "000111110000000111"b, /* adq 1,dl */ "000000000000000000"b, "111101110001000000"b, /* stq count */ "000000000000000000"b, "000000000000000000"b, /* cmpq id_10_fb or */ /* int_1,dl */ "000000000000000000"b, "110000001000000100"b, /* tnz PN1_relp2,ic */ "000000000000000000"b, "110010010000000100"b, /* eax2 t_relp,ic */ "000000000000000000"b, "100100010001000000"b); /* sxl2 target_a_PN2 */ dcl cmpq_id_10 bit(18) static init ("001001110001000000"b); dcl cmpq_int_1 bit(18) static init ("001001110000000111"b); dcl seq4(8) bit(18) unaligned static init ("000000000000000000"b, "100101000001000000"b, /* stz count */ "000000000000000000"b, "110010010000000100"b, /* eax2 loc_a_relp,ic */ "000000000000000000"b, "100100010001000000"b, /* sxl2 target_a_PN2 */ "000000000000000000"b, "111001000000000100"b); /* tra con_1_relp,ic */ dcl seq5(16) bit(18) unaligned static init ("000000000000000000"b, "110010010000000100"b, /* eax2 t_relp,ic */ "000000000000000000"b, "100100010001000000"b, /* sxl2 target_a_PN2 */ "000000000000000110"b, "111001000000000100"b, /* tra 6,ic */ "000000000000000000"b, "010011110001000000"b, /* ldq count */ "000000000000000000"b, "110000001000000100"b, /* tnz PN1_relp1,ic */ "000000000000000000"b, "000101100001000000"b, /* aos count */ "000000000000000000"b, "110011101000000100"b, /* eaa PN1_relp2,ic */ "000000000000000000"b, "111001000000000100"b); /* tra i_segm_relp,ic */ dcl tra_inst(6) bit(18) unaligned static init ("000000000000000000"b, "011101010100000100"b, /* epbp2 0,ic */ "110000000000000000"b, "010101010001000000"b, /* spri2 pr6|M */ "000000000000000000"b, "111001000000000100"b); /* tra loc_s_relp,ic */ dcl ret_inst(2) bit(18) unaligned static init ("110000000000000000"b, "110001000001000000"b); /* rtcd pr6|M */ dcl seq6(4) bit(18) unaligned static init ("110000000000000000"b, "111101000001000000"b, /* stc2 pr6|M+1 */ "000000000000000000"b, "111001000000000100"b); /* tra loc_e_relp,ic */ dcl seq8(6) bit(18) unaligned static init ("000000000000000011"b, "110010111000000100"b, /* eax7 3,ic */ "000000000000000000"b, "100100111001000000"b, /* sxl7 target_a_PN2 */ "000000000000000000"b, "111001000000000100"b); /* tra PN1_relp1,ic */ dcl move_in_token (1:10) ptr int static; dcl move_data_init fixed bin int static init (0); dcl 1 move_eos int static, 2 size fixed bin (15), 2 line fixed bin (15), 2 column fixed bin (15), 2 type fixed bin (15) init (19), 2 verb fixed bin (15) init (18), 2 e fixed bin (15) init (1); dcl szn_seq (2) bit (18) int static init ( "000000000000000000"b, "010011100001000000"b); /* szn 0 */ /* P__r_o_c_e_d_u_r_e_s_C__a_l_l_e_d:_ */ dcl cobol_add_gen entry (ptr, fixed bin), cobol_addr entry (ptr, ptr, ptr), cobol_alloc$cobol_data entry (fixed bin(24), fixed bin, fixed bin(24)), cobol_alloc$stack entry (fixed bin, fixed bin, fixed bin), cobol_arithop_gen entry (ptr), cobol_compare_gen entry (ptr), cobol_define_tag entry (fixed bin), cobol_define_tag_nc entry (fixed bin, fixed bin), cobol_emit entry (ptr, ptr, fixed bin), cobol_equate_tag entry (ptr), cobol_make_tagref entry (fixed bin, fixed bin, ptr), cobol_move_gen entry (ptr), cobol_pointer_register$get entry (ptr), cobol_pointer_register$priority entry (fixed bin, fixed bin, bit(3)), cobol_process_error entry (fixed bin, fixed bin, fixed bin), cobol_register$load entry (ptr), cobol_reset_r$in_line entry, cobol_set_gen entry (ptr), signal_ entry (char(*), ptr, ptr); dcl cobol_make_type9$long_bin ext entry (ptr,fixed bin,fixed bin); dcl cobol_num_to_udts ext entry (ptr,ptr); /* B__u_i_l_t-__i_n_F__u_n_c_t_i_o_n_s_U__s_e_d:_ */ dcl abs builtin, addr builtin, addrel builtin, binary builtin, null builtin, rel builtin, substr builtin, unspec builtin; %include cobol_seg_init_list; %include cobol_type10; %include cobol_type19; %include cobol_type1; %include cobol_type9; %include cobol_in_token; %include cobol_perform_list; %include cobol_type2; %include cobol_type18; %include cobol_type30; %include cobol_; */ ----------------------------------------------------------- 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 */