COMPILATION LISTING OF SEGMENT cobol_num_to_udts 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 0942.7 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_num_to_udts.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /*{*/ 23 24 /* format: style3 */ 25 cobol_num_to_udts: 26 proc (sf_ptr, rf_ptr); 27 28 /* 29*This procedure is called to generate code to convert any 30*numeric data item to an unpacked decimal, trailing separate 31*sign value. 32**/ 33 34 /* DECLARATION OF THE PARAMETERS */ 35 36 dcl sf_ptr ptr; 37 dcl rf_ptr ptr; 38 39 /* DESCRIPTION OF THE PARAMETERS */ 40 41 /* 42*PARAMETER DESCRIPTION 43*sf_ptr Pointer to the data name token for the 44* variable to be converted . (input) 45*rf_ptr Pointer to a buffer in which the data name 46* token for the unpacked decimal trailing 47* separate sign variable is built by this 48* procedure. If rf_ptr is null() on input, 49* then this procedure provides the buffer for 50* the token. (input) 51**/ 52 53 /*}*/ 54 55 /* DECLARATION OF INTERNAL VARIABLES */ 56 57 58 59 /* DECLARATIONS OF EXTERNAL ENTRIES */ 60 61 dcl cobol_move_gen ext entry (ptr); 62 dcl cobol_make_type9$decimal_9bit 63 ext entry (ptr, fixed bin, fixed bin (24), fixed bin, fixed bin); 64 dcl cobol_alloc$stack ext entry (fixed bin, fixed bin, fixed bin); 65 66 /* DECLARATIONS OF INTERNAL STATIC VARIABLES */ 67 68 /* Definition of an EOS token used in calls to the MOVE genarator. */ 69 70 dcl 1 move_eos_token int static, 71 2 size fixed bin (15), 72 2 line fixed bin (15), 73 2 column fixed bin (15), 74 2 type fixed bin (15), 75 2 verb fixed bin (15) init (18), /* MOVE */ 76 2 e fixed bin (15) init (1); /* One receiving field in the move */ 77 78 /* DECLARATIONS OF INTERNAL VARIABLES */ 79 80 dcl work_item_length fixed bin; 81 dcl dn_ptr ptr; 82 dcl ret_offset fixed bin; 83 dcl dum_buff (1:10) ptr; 84 85 86 /**************************************************/ 87 /* START OF EXECUTION */ 88 /* external procedure cobol_num_to_udts */ 89 /**************************************************/ 90 91 92 if sf_ptr -> data_name.bin_18 93 then work_item_length = 7; 94 else if sf_ptr -> data_name.bin_36 95 then work_item_length = 12; 96 else work_item_length = sf_ptr -> data_name.places_left + sf_ptr -> data_name.places_right + 1; 97 /* Add one for sign byte */ 98 99 /* Allocate space on the stack to receive the unpacked decimal value. */ 100 call cobol_alloc$stack (work_item_length, 0, ret_offset); 101 102 /* Make a data name token for the decimal value just allocated on the stack. */ 103 call cobol_make_type9$decimal_9bit (rf_ptr, 1000 /*STACK*/, fixed (ret_offset, 24), 104 fixed (sf_ptr -> data_name.places_left, 15), fixed (sf_ptr -> data_name.places_right, 15)); 105 106 /* Change the sign type in the token just built to trailing separate. */ 107 rf_ptr -> data_name.sign_type = "011"b; 108 109 /* Set up the input token for calling the move generator. */ 110 in_token_ptr = addr (dum_buff); 111 112 in_token.n = 4; 113 in_token.code = 0; 114 in_token.token_ptr (1) = null (); 115 in_token.token_ptr (2) = sf_ptr; 116 in_token.token_ptr (3) = rf_ptr; 117 in_token.token_ptr (4) = addr (move_eos_token); 118 119 /* Call the MOVE generator to generate code to move the data (and convert it to unpacked deciaml) */ 120 121 call cobol_move_gen (in_token_ptr); 122 123 124 /* INCLUDE FILES USED BY THIS PROCEDURE */ 125 126 127 /***** Declaration for builtin function *****/ 128 129 dcl (substr, mod, binary, fixed, addr, addrel, rel, length, string, unspec, null, index) 130 builtin; 131 132 /***** End of declaration for builtin function *****/ 133 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_type9.incl.pl1 */ 1 3 /* Last modified on 11/19/76 by ORN */ 1 4 1 5 /* 1 6*A type 9 data name token is entered into the name table by the data 1 7*division syntax phase for each data name described in the data division. 1 8*The replacement phase subsequently replaces type 8 user word references 1 9*to data names in the procedure division minpral file with the corresponding 1 10*type 9 tokens from the name table. 1 11**/ 1 12 1 13 /* dcl dn_ptr ptr; */ 1 14 1 15 /* BEGIN DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 1 16 dcl 1 data_name based (dn_ptr), 2 1 2 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 2 3 /* Last modified on 06/19/77 by ORN */ 2 4 /* Last modified on 12/28/76 by FCH */ 2 5 2 6 /* header */ 2 7 2 size fixed bin, 2 8 2 line fixed bin, 2 9 2 column fixed bin, 2 10 2 type fixed bin, 2 11 /* body */ 2 12 2 string_ptr ptr, 2 13 2 prev_rec ptr, 2 14 2 searched bit (1), 2 15 2 duplicate bit (1), 2 16 2 saved bit (1), 2 17 2 debug_ind bit (1), 2 18 2 filler2 bit (3), 2 19 2 used_as_sub bit (1), 2 20 2 def_line fixed bin, 2 21 2 level fixed bin, 2 22 2 linkage fixed bin, 2 23 2 file_num fixed bin, 2 24 2 size_rtn fixed bin, 2 25 2 item_length fixed bin(24), 2 26 2 places_left fixed bin, 2 27 2 places_right fixed bin, 2 28 /* description */ 2 29 2 file_section bit (1), 2 30 2 working_storage bit (1), 2 31 2 constant_section bit (1), 2 32 2 linkage_section bit (1), 2 33 2 communication_section bit (1), 2 34 2 report_section bit (1), 2 35 2 level_77 bit (1), 2 36 2 level_01 bit (1), 2 37 2 non_elementary bit (1), 2 38 2 elementary bit (1), 2 39 2 filler_item bit (1), 2 40 2 s_of_rdf bit (1), 2 41 2 o_of_rdf bit (1), 2 42 2 bin_18 bit (1), 2 43 2 bin_36 bit (1), 2 44 2 pic_has_l bit (1), 2 45 2 pic_is_do bit (1), 2 46 2 numeric bit (1), 2 47 2 numeric_edited bit (1), 2 48 2 alphanum bit (1), 2 49 2 alphanum_edited bit (1), 2 50 2 alphabetic bit (1), 2 51 2 alphabetic_edited bit (1), 2 52 2 pic_has_p bit (1), 2 53 2 pic_has_ast bit (1), 2 54 2 item_signed bit(1), 2 55 2 sign_separate bit (1), 2 56 2 display bit (1), 2 57 2 comp bit (1), 2 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 2 59 2 ascii_packed_dec bit (1), 2 60 2 ebcdic_packed_dec bit (1), 2 61 2 bin_16 bit (1), 2 62 2 bin_32 bit (1), 2 63 2 usage_index bit (1), 2 64 2 just_right bit (1), 2 65 2 compare_argument bit (1), 2 66 2 sync bit (1), 2 67 2 temporary bit (1), 2 68 2 bwz bit (1), 2 69 2 variable_length bit (1), 2 70 2 subscripted bit (1), 2 71 2 occurs_do bit (1), 2 72 2 key_a bit (1), 2 73 2 key_d bit (1), 2 74 2 indexed_by bit (1), 2 75 2 value_numeric bit (1), 2 76 2 value_non_numeric bit (1), 2 77 2 value_signed bit (1), 2 78 2 sign_type bit (3), 2 79 2 pic_integer bit (1), 2 80 2 ast_when_zero bit (1), 2 81 2 label_record bit (1), 2 82 2 sign_clause_occurred bit (1), 2 83 2 okey_dn bit (1), 2 84 2 subject_of_keyis bit (1), 2 85 2 exp_redefining bit (1), 2 86 2 sync_in_rec bit (1), 2 87 2 rounded bit (1), 2 88 2 ad_bit bit (1), 2 89 2 debug_all bit (1), 2 90 2 overlap bit (1), 2 91 2 sum_counter bit (1), 2 92 2 exp_occurs bit (1), 2 93 2 linage_counter bit (1), 2 94 2 rnm_01 bit (1), 2 95 2 aligned bit (1), 2 96 2 not_user_writable bit (1), 2 97 2 database_key bit (1), 2 98 2 database_data_item bit (1), 2 99 2 seg_num fixed bin, 2 100 2 offset fixed bin(24), 2 101 2 initial_ptr fixed bin, 2 102 2 edit_ptr fixed bin, 2 103 2 occurs_ptr fixed bin, 2 104 2 do_rec char(5), 2 105 2 bitt bit (1), 2 106 2 byte bit (1), 2 107 2 half_word bit (1), 2 108 2 word bit (1), 2 109 2 double_word bit (1), 2 110 2 half_byte bit (1), 2 111 2 filler5 bit (1), 2 112 2 bit_offset bit (4), 2 113 2 son_cnt bit (16), 2 114 2 max_red_size fixed bin(24), 2 115 2 name_size fixed bin, 2 116 2 name char(0 refer(data_name.name_size)); 2 117 2 118 2 119 2 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 2 121 1 17 1 18 /* END DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 1 19 1 20 /* END INCLUDE FILE ... cobol_type9.incl.pl1 */ 1 21 134 135 136 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_in_token.incl.pl1 */ 3 3 3 4 /* Last modified August 22, 1974 by AEG */ 3 5 3 6 3 7 declare in_token_ptr ptr; 3 8 3 9 declare 1 in_token aligned based(in_token_ptr), 3 10 2 n fixed bin aligned, 3 11 2 code fixed bin aligned, 3 12 2 token_ptr(0 refer(in_token.n)) ptr aligned; 3 13 3 14 3 15 /* END INCLUDE FILE ... cobol_in_token.incl.pl1 */ 3 16 137 138 139 end cobol_num_to_udts; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0830.4 cobol_num_to_udts.pl1 >spec>install>MR12.3-1048>cobol_num_to_udts.pl1 134 1 03/27/82 0439.9 cobol_type9.incl.pl1 >ldd>include>cobol_type9.incl.pl1 1-17 2 11/11/82 1712.7 cobol_TYPE9.incl.pl1 >ldd>include>cobol_TYPE9.incl.pl1 137 3 11/11/82 1712.7 cobol_in_token.incl.pl1 >ldd>include>cobol_in_token.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. addr builtin function dcl 129 ref 110 117 bin_18 21(13) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 92 bin_36 21(14) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 94 cobol_alloc$stack 000022 constant entry external dcl 64 ref 100 cobol_make_type9$decimal_9bit 000020 constant entry external dcl 62 ref 103 cobol_move_gen 000016 constant entry external dcl 61 ref 121 code 1 based fixed bin(17,0) level 2 dcl 3-9 set ref 113* data_name based structure level 1 unaligned dcl 1-16 dum_buff 000102 automatic pointer array dcl 83 set ref 110 fixed builtin function dcl 129 ref 103 103 103 103 103 103 in_token based structure level 1 dcl 3-9 in_token_ptr 000126 automatic pointer dcl 3-7 set ref 110* 112 113 114 115 116 117 121* move_eos_token 000010 internal static structure level 1 unaligned dcl 70 set ref 117 n based fixed bin(17,0) level 2 dcl 3-9 set ref 112* null builtin function dcl 129 ref 114 places_left 17 based fixed bin(17,0) level 2 dcl 1-16 ref 96 103 103 places_right 20 based fixed bin(17,0) level 2 dcl 1-16 ref 96 103 103 ret_offset 000101 automatic fixed bin(17,0) dcl 82 set ref 100* 103 103 rf_ptr parameter pointer dcl 37 set ref 25 103* 107 116 sf_ptr parameter pointer dcl 36 ref 25 92 94 96 96 103 103 103 103 115 sign_type 22(13) based bit(3) level 2 packed packed unaligned dcl 1-16 set ref 107* token_ptr 2 based pointer array level 2 dcl 3-9 set ref 114* 115* 116* 117* work_item_length 000100 automatic fixed bin(17,0) dcl 80 set ref 92* 94* 96* 100* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. addrel builtin function dcl 129 binary builtin function dcl 129 dn_ptr automatic pointer dcl 81 index builtin function dcl 129 length builtin function dcl 129 mod builtin function dcl 129 rel builtin function dcl 129 string builtin function dcl 129 substr builtin function dcl 129 unspec builtin function dcl 129 NAME DECLARED BY EXPLICIT CONTEXT. cobol_num_to_udts 000010 constant entry external dcl 25 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 224 250 143 234 Length 472 143 24 205 61 6 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_num_to_udts 112 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 move_eos_token cobol_num_to_udts STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_num_to_udts 000100 work_item_length cobol_num_to_udts 000101 ret_offset cobol_num_to_udts 000102 dum_buff cobol_num_to_udts 000126 in_token_ptr cobol_num_to_udts THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_alloc$stack cobol_make_type9$decimal_9bit cobol_move_gen NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 25 000004 92 000015 94 000026 96 000034 100 000040 103 000053 107 000105 110 000114 112 000116 113 000120 114 000121 115 000123 116 000126 117 000131 121 000134 139 000142 ----------------------------------------------------------- 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