COMPILATION LISTING OF SEGMENT gcos_print_call_
	Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983
	Compiled at: Honeywell LCPD Phoenix, System M
	Compiled on: 09/09/83  1143.1 mst Fri
	    Options: optimize map

        1 /* ***********************************************************
        2*   *                                                         *
        3*   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        4*   *                                                         *
        5*   *********************************************************** */
        6 gcos_print_call_: proc;
        7 
        8 /* Print the input arguments (strings) on error_output
        9*   stream with the following considerations:
       10*   strings containing "|" are justified
       11*   and information after the "|" are folded under this
       12*   character, e.g.,
       13*   abc | stuff xxx
       14*   d   | more stuff
       15*
       16*   Author: Dave Ward 06/05/81 (from print_calling_sequence_ 02/02/81).
       17**/
       18 	ll = get_line_length_$stream ("error_output", code);
       19 	call cu_$arg_count (na, code);
       20 	mm = 0;					/* Set initial max m. */
       21 
       22 /* Obtain parameter information. */
       23 	do i = 1 to na while (i <= hbound (a, 1));
       24 	     call cu_$arg_ptr (i, p (i), l (i), code);
       25 	     if code ^= 0 then do;
       26 		call com_err_ (
       27 		     code
       28 		     , "gcos_print_call_"
       29 		     , "Arg ^i"
       30 		     , i
       31 		     );
       32 		return;
       33 	     end;
       34 
       35 /* Measure for | location. */
       36 	     m (i) = index (argi, "|");
       37 	     mm = max (mm, m (i));
       38 	end;
       39 
       40 /* Print the strings. */
       41 	do i = 1 to (i-1);
       42 	     if (m (i) = 0) | (mm > (ll-5)) then do;	/* Either no |, or | too far to the right (a Reagen bar). */
       43 		if length (argi) <= ll then		/* Not more than ll characters to print. */
       44 		     call out (argi);
       45 		else				/* More than ll characters to print. */
       46 		call fold (argi);
       47 	     end;
       48 	     else do;				/* String contains |. */
       49 		call out (substr (argi, 1, m (i)-1));
       50 		if m (i)<mm then
       51 		     call out (substr ((100)" ", 1, mm-m (i)));
       52 		call out (" |");
       53 		if l (i)>m (i) then			/* There are characters after the |. */
       54 		     call pr_rest (after_bar);
       55 	     end;
       56 	     call out (NL);
       57 	end;
       58 fail:	;
       59 	return;
       60 
       61 fold:	proc (s);
       62 
       63 /* Output ll characters, break on space, fold remainder.
       64**/
       65 dcl  s                        char(*)parm;
       66 	     if length (s) <= ll then do;
       67 		call out (s);
       68 		return;
       69 	     end;
       70 	     k = search (reverse (substr (s, 1, ll)), " ,");
       71 	     if k>0 then do;
       72 		l = length (rtrim (substr (s, 1, ll-k+1)));
       73 		if l>0 then do;
       74 		     call out (substr (s, 1, l));
       75 		     call out (NL);
       76 		end;
       77 		l = ll - (k-1) + 1;			/* Location 1st character of remainder. */
       78 		if (length (s)-l+1)>ll then
       79 		     call fold (substr (s, l));
       80 		else do;				/* Right justify final piece. */
       81 		     call out (substr ((100)" ", 1, ll- (length (s)-l+1)));
       82 		     call out (substr (s, l));
       83 		end;
       84 		return;
       85 	     end;
       86 
       87 /* No blanks in string. */
       88 	     call out (substr (s, 1, ll));
       89 	     call out (NL);
       90 	     call fold (substr (s, ll+1));
       91 	     return;
       92 dcl  k                        fixed bin(24);
       93 dcl  l                        fixed bin(24);
       94 	end fold;
       95 
       96 out:	proc (s);
       97 
       98 /* Print string "s". */
       99 dcl  s                        char(*)parm;
      100 	     call iox_$put_chars (
      101 		iox_$error_output
      102 		, addr (s)
      103 		, length (s)
      104 		, code
      105 		);
      106 	     if code ^= 0 then do;
      107 		call com_err_ (
      108 		     code
      109 		     , "gcos_print_call_"
      110 		     , "String ""^a"""
      111 		     , s
      112 		     );
      113 		goto fail;
      114 	     end;
      115 	     return;
      116 	end out;
      117 
      118 pr_rest:	proc (s);
      119 
      120 /* Print the string "s" as the rest of the string
      121*   after |.
      122**/
      123 dcl  s                        char(*)parm;
      124 	     call out (" ");
      125 	     l = ll-mm-2;				/* Print characters available. */
      126 	     pl = length (s);
      127 	     if pl <= l then do;			/* Not more than ll characters to print. */
      128 		call out (s);
      129 		return;
      130 	     end;
      131 
      132 /* More than ll characters,
      133*   print up to ll characters on this line
      134*   and fold the remainder.
      135**/
      136 	     k = search (reverse (substr (s, 1, l)), " ,");
      137 	     if k = 0 then do;			/* No space or comma found. */
      138 		call out (substr (s, 1, l));
      139 		fc = l+1;
      140 		ln = pl-l;
      141 		if ln<1 then return;
      142 	     end;
      143 	     else do;				/* Print up to space. */
      144 		call out (rtrim (substr (s, 1, l-k+1)));
      145 		fc = l-k+2;
      146 		ln = pl-fc+1;
      147 		if ln<1 then return;
      148 	     end;
      149 	     call out (NL);
      150 	     call out (substr ((100)" ", 1, mm-1));
      151 	     call out (" |");
      152 	     call pr_rest (substr (s, fc, ln));
      153 	     return;
      154 dcl  fc                       fixed bin(24);
      155 dcl  k                        fixed bin(24);
      156 dcl  l                        fixed bin(24);
      157 dcl  ln                       fixed bin(24);
      158 dcl  pl                       fixed bin(24);
      159 	end pr_rest;
      160 
      161 /*   Variables for gcos_print_call_:		 */
      162 /*   IDENTIFIER		ATTRIBUTES	 */
      163 dcl  after_bar                char(l(i)-m(i))unal based(addr(ari(m(i)+1)))	/* i-th argument, characters after |. */;
      164 dcl  argi                     char(l(i))unal based(p(i))	/* i-th argument, character string. */;
      165 dcl  ari                      (l(i))char(1)unal based(p(i))	/* i-th argument, array of characters. */;
      166 dcl  code                     fixed bin(35);
      167 dcl  com_err_                 entry() options(variable);
      168 dcl  cu_$arg_count entry (fixed bin, fixed bin(35));
      169 dcl  cu_$arg_ptr              entry (fixed bin(24), ptr, fixed bin(21), fixed bin(35));
      170 dcl  get_line_length_$stream  entry (char(*), fixed bin(35)) returns(fixed bin);
      171 dcl  hbound                   builtin;
      172 dcl  i                        fixed bin(24);
      173 dcl  index                    builtin;
      174 dcl  iox_$error_output        ptr ext static;
      175 dcl  iox_$put_chars           entry (ptr, ptr, fixed bin(21), fixed bin(35));
      176 dcl  ll                       fixed bin(24);
      177 dcl  max                      builtin;
      178 dcl  min                      builtin;
      179 dcl  mm                       fixed bin(24);
      180 dcl  na                       fixed bin(17);
      181 dcl  reverse                  builtin;
      182 dcl  search                   builtin;
      183 dcl  substr                   builtin;
      184 
      185 dcl  NL                       char(1)static int options(constant)init("
      186 ");
      187 
      188 dcl 1 a	(64)aligned
      189 ,     2 p ptr
      190 ,     2 l fixed bin(21)
      191 ,     2 m fixed bin
      192 ;
      193      end gcos_print_call_;
	SOURCE FILES USED IN THIS COMPILATION.

LINE      NUMBER  DATE MODIFIED     NAME			PATHNAME
             0    09/09/83  1007.1  gcos_print_call_.pl1              >spec>on>09/07/83-gcos>gcos_print_call_.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.
NL                              000000 constant        char(1)                  initial unaligned dcl 185 set ref 56* 75* 89* 149*
a                               000106 automatic       structure                array level 1 dcl 188 set ref 23
after_bar                              based           char                     unaligned dcl 163 set ref 53*
argi                                   based           char                     unaligned dcl 164 set ref 36 43 43* 45* 49 49
ari                                    based           char(1)                  array unaligned dcl 165 set ref 53
code                            000100 automatic       fixed bin(35,0)          dcl 166 set ref 18* 19* 24* 25 26* 100* 106 107*
com_err_                        000010 constant        entry                    external dcl 167 ref 26 107
cu_$arg_count                   000012 constant        entry                    external dcl 168 ref 19
cu_$arg_ptr                     000014 constant        entry                    external dcl 169 ref 24
fc                              000100 automatic       fixed bin(24,0)          dcl 154 set ref 139* 145* 146 152 152
get_line_length_$stream         000016 constant        entry                    external dcl 170 ref 18
hbound                                                 builtin function         dcl 171 ref 23
i                               000101 automatic       fixed bin(24,0)          dcl 172 set ref 23* 23* 24* 24 24 26* 36 36 36 37*
                                                                                  41* 41* 42 43 43 43 43 43 45 45 45 49 49 49 49 49
                                                                                  49 50 50 50 53 53 53 53 53 53 53 53*
index                                                  builtin function         dcl 173 ref 36
iox_$error_output               000020 external static pointer                  dcl 174 set ref 100*
iox_$put_chars                  000022 constant        entry                    external dcl 175 ref 100
k                               000100 automatic       fixed bin(24,0)          dcl 92 in procedure "fold" set ref 70* 71 72 77
k                               000101 automatic       fixed bin(24,0)          dcl 155 in procedure "pr_rest" set ref 136* 137 144
                                                                                  144 145
l                               000102 automatic       fixed bin(24,0)          dcl 156 in procedure "pr_rest" set ref 125* 127 136
                                                                                  138 138 139 140 144 144 145
l                               000101 automatic       fixed bin(24,0)          dcl 93 in procedure "fold" set ref 72* 73 74 74 77*
                                                                                  78 78 78 81 81 82 82
l                         2     000106 automatic       fixed bin(21,0)          array level 2 in structure "a" dcl 188 in procedure
                                                                                  "gcos_print_call_" set ref 24* 36 43 43 43 45 45
                                                                                  49 49 53 53 53
ll                              000102 automatic       fixed bin(24,0)          dcl 176 set ref 18* 42 43 66 70 72 77 78 81 81 88 88
                                                                                  90 90 125
ln                              000103 automatic       fixed bin(24,0)          dcl 157 set ref 140* 141 146* 147 152 152
m                         3     000106 automatic       fixed bin(17,0)          array level 2 dcl 188 set ref 36* 37 42 49 49 50 50
                                                                                  50 53 53 53 53
max                                                    builtin function         dcl 177 ref 37
mm                              000103 automatic       fixed bin(24,0)          dcl 179 set ref 20* 37* 37 42 50 50 50 125 150 150
na                              000104 automatic       fixed bin(17,0)          dcl 180 set ref 19* 23
p                               000106 automatic       pointer                  array level 2 dcl 188 set ref 24* 36 43 43 45 49 49
                                                                                  53
pl                              000104 automatic       fixed bin(24,0)          dcl 158 set ref 126* 127 140 146
reverse                                                builtin function         dcl 181 ref 70 136
s                                      parameter       char                     unaligned dcl 123 in procedure "pr_rest" set ref 118
                                                                                  126 128* 136 138 138 144 144 152 152
s                                      parameter       char                     unaligned dcl 99 in procedure "out" set ref 96 100
                                                                                  100 100 100 107*
s                                      parameter       char                     unaligned dcl 65 in procedure "fold" set ref 61 66
                                                                                  67* 70 72 74 74 78 78 78 81 81 82 82 88 88 90 90
search                                                 builtin function         dcl 182 ref 70 136
substr                                                 builtin function         dcl 183 ref 49 49 50 50 70 72 74 74 78 78 81 81 82
                                                                                  82 88 88 90 90 136 138 138 144 144 150 150 152 152

NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED.
min                                                    builtin function         dcl 178

NAMES DECLARED BY EXPLICIT CONTEXT.
fail                            000414 constant        label                    dcl 58 ref 113
fold                            000417 constant        entry                    internal dcl 61 ref 45 78 90
gcos_print_call_                000033 constant        entry                    external dcl 6
out                             000751 constant        entry                    internal dcl 96 ref 43 49 50 52 56 67 74 75 81 82 88
                                                                                  89 124 128 138 144 149 150 151
pr_rest                         001054 constant        entry                    internal dcl 118 ref 53 152

NAMES DECLARED BY CONTEXT OR IMPLICATION.
addr                                                   builtin function         ref 53 100 100
length                                                 builtin function         ref 43 66 72 78 81 81 100 100 126
rtrim                                                  builtin function         ref 72 144 144

STORAGE REQUIREMENTS FOR THIS PROGRAM.

	Object	Text	Link	Symbol	Defs	Static
Start          0       0      1722        1746    1602        1732
Length      2126    1602        24         144     117           0

BLOCK NAME	         STACK SIZE     TYPE		WHY NONQUICK/WHO SHARES STACK FRAME
gcos_print_call_                    368 external procedure  is an external procedure.  
fold                                 80 internal procedure  is called during a stack extension.  
out                                 100 internal procedure  is called during a stack extension.  
pr_rest                              83 internal procedure  is called during a stack extension.  

STORAGE FOR AUTOMATIC VARIABLES.

STACK FRAME                 LOC IDENTIFIER                  BLOCK NAME
fold                     000100 k                           fold
                         000101 l                           fold
gcos_print_call_         000100 code                        gcos_print_call_
                         000101 i                           gcos_print_call_
                         000102 ll                          gcos_print_call_
                         000103 mm                          gcos_print_call_
                         000104 na                          gcos_print_call_
                         000106 a                           gcos_print_call_
pr_rest                  000100 fc                          pr_rest
                         000101 k                           pr_rest
                         000102 l                           pr_rest
                         000103 ln                          pr_rest
                         000104 pl                          pr_rest

THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM.
alloc_cs            call_ext_out_desc   call_ext_out        call_int_this_desc  call_int_other_desc return
tra_ext             shorten_stack       ext_entry           int_entry_desc

THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM.
com_err_                      cu_$arg_count                 cu_$arg_ptr                   get_line_length_$stream
iox_$put_chars

THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM.
iox_$error_output




   LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC   
      6 000032        18 000040        19 000067        20 000100        23 000101        24 000113        25 000131
     26 000133        32 000166        36 000167        37 000205        38 000211        41 000213        42 000223
     43 000233        45 000252        47 000264        49 000265        50 000310        52 000341        53 000354
     56 000402        57 000412        58 000414        59 000415        61 000416        66 000432        67 000435
     68 000447        70 000450        71 000465        72 000466        73 000504        74 000505        75 000524
     77 000536        78 000546        80 000604        81 000605        82 000633        83 000664        84 000665
     88 000666        89 000706        90 000720        91 000746        96 000750       100 000764       106 001005
    107 001010       113 001047       115 001052       118 001053       124 001067       125 001102       126 001107
    127 001115       128 001117       129 001131       136 001132       137 001147       138 001150       139 001170
    140 001174       141 001177       142 001202       144 001203       145 001240       146 001245       147 001251
    149 001254       150 001265       151 001310       152 001324       153 001347


                                          -----------------------------------------------------------


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