COMPILATION LISTING OF SEGMENT cobol_bin_const_ck 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 0939.1 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 16 /****^ HISTORY COMMENTS: 17* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 18* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 19* MCR8060 cobol_bin_const_ck.pl1 Reformatted code to new Cobol standard. 20* END HISTORY COMMENTS */ 21 22 23 /*{*/ 24 25 /* format: style3 */ 26 cobol_bin_const_ck: 27 proc (token_ptr, give_up, constant_code); 28 29 /* 30*This procedure determines whether a numeric literal constant can 31*be contained in either a half-word or full word fixed binary 32*datum. 33**/ 34 35 /* DECLARATIONS OF THE PARAMETERS */ 36 37 dcl token_ptr ptr; 38 dcl give_up bit (1); 39 dcl constant_code fixed bin; 40 41 /* DESCRIPTION OF THE PARAMETERS */ 42 43 /* 44*PARAMETER DESCRIPTION 45* 46*token_ptr Pointer to the numeric literal token whose 47* literal value is to be checked. (input) 48*give_up A flag which is set to "1"b to indicate that the 49* numeric literal cannot be contained in either a 50* long or short fixed binary datum. (output) 51*constant_code A code that indicates whether the constant can 52* be contained in a short or long fixed binary 53* datum. (output) This code can take on two values, 54* and is meaningful only if the output 55* parameter give_up is set to "1"b. 56* 57* constant_code | meaning 58* ------------------------------------------- 59* 1 | constant is short binary 60* 2 | constant is long binary 61* --------------------------------------------- 62* 63**/ 64 65 /* DECLARATION OF BUILTIN FUNCTIONS */ 66 67 dcl addr builtin; 68 69 /*}*/ 70 71 /* DECLARATIONS OF INTERNAL STATIC VARIABLES */ 72 73 dcl smallest_short_bin fixed dec (6, 0) int static init (-131072); 74 dcl largest_short_bin fixed dec (6, 0) int static init (131071); 75 76 dcl smallest_long_bin fixed dec (11, 0) int static init (-34359738368); 77 dcl largest_long_bin fixed dec (11, 0) int static init (34359738367); 78 79 80 /* DECLARATIONS OF INTERNAL VARIABLES */ 81 82 dcl work_fdec fixed dec (11, 0) aligned; 83 dcl work_ptr ptr; 84 dcl work_fdec_string char (12) based (work_ptr); 85 86 87 /**************************************************/ 88 /* START OF EXECUTION */ 89 /**************************************************/ 90 91 92 93 nlit_ptr = token_ptr; 94 give_up = "1"b; 95 96 if numeric_lit.places_left <= 0 97 then do; /* No places left, must definitely fit into a short binary. */ 98 give_up = "1"b; 99 constant_code = 1; /* short binary constant. */ 100 end; /* No places left, must definitely fit into a short binary. */ 101 102 103 else if numeric_lit.places_left <= 11 104 then do; /* Places left within range, check the value itself. */ 105 106 work_fdec = 0; 107 work_ptr = addr (work_fdec); 108 109 /* Build a fixed decimal number from the numeric literal token. */ 110 /* Insert sign. */ 111 if numeric_lit.sign = " " 112 then substr (work_fdec_string, 1, 1) = "+"; 113 else substr (work_fdec_string, 1, 1) = numeric_lit.sign; 114 115 /* Insert the integer part of the numeric literal */ 116 substr (work_fdec_string, 13 - numeric_lit.places_left, numeric_lit.places_left) = 117 substr (numeric_lit.literal, 1, numeric_lit.places_left); 118 119 if (smallest_short_bin <= work_fdec & work_fdec <= largest_short_bin) 120 then do; /* Short binary constant */ 121 give_up = "0"b; 122 constant_code = 1; 123 end; /* Short binary constant */ 124 125 else if (smallest_long_bin <= work_fdec & work_fdec <= largest_long_bin) 126 then do; /* Long binary constant */ 127 give_up = "0"b; 128 constant_code = 2; 129 end; /* Long binary constatn */ 130 131 132 end; /* Places left within range, check the value itself. */ 133 134 135 /* INCLUDE FILES USED BY THIS PROCEDURE */ 136 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_type2.incl.pl1 */ 1 3 /* Last modified on 11/19/76 by ORN */ 1 4 1 5 /* 1 6*A type 2 numeric literal token is entered into the minpral file by the 1 7*lexical analysis phase for each numeric literal encountered in the source 1 8*program. 1 9**/ 1 10 1 11 dcl nlit_ptr ptr; 1 12 1 13 /* BEGIN DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 1 14 dcl 1 numeric_lit based (nlit_ptr), 2 1 2 2 /* begin include file ... cobol_TYPE2.incl.pl1 */ 2 3 /* Last modified on 12/28/76 by FCH */ 2 4 2 5 /* header */ 2 6 2 size fixed bin, 2 7 2 line fixed bin, 2 8 2 column fixed bin, 2 9 2 type fixed bin, 2 10 /* body */ 2 11 2 integral bit(1), 2 12 2 floating bit(1), 2 13 2 seg_range bit(1), 2 14 2 filler1 bit(4), 2 15 2 subscript bit(1), 2 16 2 sign char(1), 2 17 2 exp_sign char(1), 2 18 2 exp_places fixed bin, 2 19 2 places_left fixed bin, 2 20 2 places_right fixed bin, 2 21 2 places fixed bin, 2 22 2 literal char(0 refer(numeric_lit.places)); 2 23 2 24 2 25 2 26 /* end include file ... cobol_TYPE2.incl.pl1 */ 2 27 1 15 1 16 /* END DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 1 17 1 18 /* END INCLUDE FILE ... cobol_type2.incl.pl1 */ 1 19 137 138 139 140 end cobol_bin_const_ck; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0830.3 cobol_bin_const_ck.pl1 >spec>install>MR12.3-1048>cobol_bin_const_ck.pl1 137 1 03/27/82 0439.8 cobol_type2.incl.pl1 >ldd>include>cobol_type2.incl.pl1 1-15 2 11/11/82 1712.8 cobol_TYPE2.incl.pl1 >ldd>include>cobol_TYPE2.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 67 ref 107 constant_code parameter fixed bin(17,0) dcl 39 set ref 26 99* 122* 128* give_up parameter bit(1) packed unaligned dcl 38 set ref 26 94* 98* 121* 127* largest_long_bin 000000 constant fixed dec(11,0) initial dcl 77 ref 125 largest_short_bin 000006 constant fixed dec(6,0) initial dcl 74 ref 119 literal 11 based char level 2 packed packed unaligned dcl 1-14 ref 116 nlit_ptr 000106 automatic pointer dcl 1-11 set ref 93* 96 103 111 113 116 116 116 116 numeric_lit based structure level 1 unaligned dcl 1-14 places 10 based fixed bin(17,0) level 2 dcl 1-14 ref 116 places_left 6 based fixed bin(17,0) level 2 dcl 1-14 ref 96 103 116 116 116 sign 4(09) based char(1) level 2 packed packed unaligned dcl 1-14 ref 111 113 smallest_long_bin 000003 constant fixed dec(11,0) initial dcl 76 ref 125 smallest_short_bin 000010 constant fixed dec(6,0) initial dcl 73 ref 119 token_ptr parameter pointer dcl 37 ref 26 93 work_fdec 000100 automatic fixed dec(11,0) dcl 82 set ref 106* 107 119 119 125 125 work_fdec_string based char(12) packed unaligned dcl 84 set ref 111* 113* 116* work_ptr 000104 automatic pointer dcl 83 set ref 107* 111 113 116 NAME DECLARED BY EXPLICIT CONTEXT. cobol_bin_const_ck 000021 constant entry external dcl 26 NAME DECLARED BY CONTEXT OR IMPLICATION. substr builtin function set ref 111 113* 116* 116 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 160 170 132 170 Length 366 132 10 162 26 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_bin_const_ck 73 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_bin_const_ck 000100 work_fdec cobol_bin_const_ck 000104 work_ptr cobol_bin_const_ck 000106 nlit_ptr cobol_bin_const_ck THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return_mac ext_entry NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 26 000015 93 000026 94 000032 96 000036 99 000040 100 000042 103 000043 106 000045 107 000050 111 000052 113 000064 116 000067 119 000075 121 000105 122 000110 123 000112 125 000113 127 000123 128 000126 140 000130 ----------------------------------------------------------- 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