COMPILATION LISTING OF SEGMENT indent
	Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985
	Compiled at: Honeywell Multics Op. - System M
	Compiled on: 12/17/85  0944.9 mst Tue
	    Options: optimize map single_symbol_list

        1 /* ***********************************************************
        2*   *                                                         *
        3*   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        4*   *                                                         *
        5*   *********************************************************** */
        6 
        7 
        8 /****^  HISTORY COMMENTS:
        9*  1) change(69-06-01,VanVleck), approve(), audit(), install():
       10*     created from a
       11*     MAD (Michigan Algorithmic Decode) Stan Dutton's CTSS program.
       12*  2) change(73-06-01,Morris), approve(), audit(), install():
       13*     modified to know
       14*     about IF statements.
       15*  3) change(73-12-01,VanVleck), approve(), audit(), install():
       16*     heavily
       17*     modified to take advantage of EIS instruction set.
       18*  4) change(74-08-01,Casey), approve(), audit(), install():
       19*     modified to -
       20*     check for missing quotes and other errors that are really caused by
       21*     missing quotes; and - refuse to replace the original segment when such
       22*     errors are detected; - rewrite argument processing to use less code and
       23*     allow control arguments anywhere on the line.
       24*  5) change(76-03-01,LJohnson), approve(), audit(), install():
       25*     modified to fix
       26*     bugs in indenting multiple line strings, to improve <NP> character
       27*     handling, and to support .cds suffix.
       28*  6) change(77-06-14,May), approve(), audit(), install():
       29*     modified to add
       30*     processing of source for the reduction_compiler, to generalize somewhat
       31*     for other possible dialects, and to fix a bug indenting factored structure
       32*     entries.
       33*  7) change(85-08-02,GDixon), approve(85-09-27,MCR7261), audit(85-09-27,GWMay),
       34*     install(85-12-16,MR12.0-1001):
       35*     support format_pl1's unchangeable comment syntax, which is a comment
       36*     beginning with /****^.  This is needed to prevent indent from messing up
       37*     history comments.
       38*                                                   END HISTORY COMMENTS */
       39 
       40 
       41 indent: ind: proc;
       42 
       43 /* The INDENT command indents PL1 programs to make them more readable.
       44*
       45*   Each DO, BEGIN, or PROCEDURE statement causes an additional level of indentation
       46*   until a corresponding END is encountered. (Multiple closure is not permitted.)
       47*   An IF statement or ELSE statement which is continued over multiple lines will also
       48*   indent its subsequent lines.
       49*
       50*   Comments are lined up in a standard column. A comment will be placed in column 1 if
       51*   it is the first thing on the line and if the preceding line was blank or another such comment.
       52*
       53*   Declaration statements are indented in a standard form, so that factoring and
       54*   structure nesting are exhibited.
       55*
       56*   Multiple spaces or tabs are replaced by a single space, except for the content of strings
       57*   and for non-leading spaces and tabs in comments.
       58*   Spaces are inserted around the operators = -> ^= >= and <=, after commas,
       59*   and before left parentheses and after right parentheses.
       60*   Spaces are removed if found before a comma or right paren, or after a left paren.
       61*   Tabs are used wherever possible to conserve space in the segment.
       62*
       63*   Parentheses are counted, and must balance at every semicolon. A warning will be printed.
       64*   Lines longer than 350 characters will be split with a warning message.
       65*   Illegal characters or non-pl1 characters not contained in a string will be commented upon.
       66*
       67*   Some uses of the identifiers begin, end, proc, procedure, do, if, then, and else
       68*   as variable names may cause the command to become confused. This is bad programming anyway.
       69*   The command knows when a new statement may begin and can complain about some obvious syntax errors.
       70*   */
       71 
       72 dcl  suffixes (3) char (4) init (".pl1", ".cds", ".rd"),	/* all the known dialects */
       73      suffix_lengths (3) fixed bin init (4, 4, 3),		/* and their lengths */
       74      suffix_len fixed bin;				/* one of the preceding */
       75 
       76 dcl  rd_source_sw bit (1),				/* flag for source to the reduction_compiler */
       77      copy_this_comment_unchanged bit (1);		/* flag to copy current comment without change */
       78 
       79 dcl (n1, n2) char (168) aligned,			/* input and output segment pathnames */
       80      dn char (168) aligned,				/* directory name */
       81      en char (32) aligned,				/* entry name */
       82      temp_en char (32) aligned,			/* entry name of temp seg. */
       83      ap ptr,					/* ptr to argument */
       84      al fixed bin,					/* lth of argument */
       85      an fixed bin,					/* current arg number */
       86      nargs fixed bin,				/* number of arguments */
       87      expecting fixed bin init (0),			/* ^=0 if expecting a numeric arg following a control arg */
       88      bchr char (al) based (ap) unaligned,		/* based char string */
       89     (linno, indent, ntab) fixed bin,			/* misc counters */
       90      ec fixed bin (35) init (0),			/* error code */
       91      offset fixed bin (24),				/* char offset in input */
       92     (string_offset, line_offset) fixed bin (24),		/* offsets where current string and line started */
       93      string_len fixed bin,				/* length of current string, for error checking */
       94     (p, p1) ptr,					/* pointers to input, output */
       95     (icb, ice, icol) fixed bin,			/* indices in line */
       96     (chars, temchars) char (400),			/* Working storage */
       97      char char (1),					/* temp */
       98      n fixed bin,					/* length of working line */
       99      lth fixed bin (24),				/* number of chars in input */
      100     (lth1, lth2) fixed bin,				/* length of args */
      101      end_count fixed bin,				/* number of END on this line */
      102      if_count fixed bin,				/* count of IF's encountered */
      103      old_if_count fixed bin,				/* previous value. */
      104     (scolsw,					/* TRUE if semicolon on line */
      105      dclfnd,					/* TRUE if DECLARE statement on line. */
      106      dclsw,					/* TRUE if in a declaration */
      107      condsw,					/* TRUE if now in if statement. */
      108      ifsw,					/* TRUE for if but not for else. */
      109      begin_ok,					/* TRUE if in an ON statement. */
      110      else_ok,					/* TRUE if else is now permitted. */
      111      strut,					/* TRUE if in structure */
      112      sixty,					/* TRUE if comment is to be pushed to col. 60 */
      113      bos,						/* TRUE if current char could be beginning of stmnt */
      114      blsw,					/* TRUE if preceding line blank */
      115      comment,					/* TRUE if currently in comment. */
      116      newpage,					/* TRUE if line contains newpage character */
      117      string,					/* TRUE if currently in string */
      118      pstring) bit (1) aligned,			/* TRUE if previous line ended in string */
      119      bfsw bit (1) aligned init ("0"b),			/* Brief mode switch */
      120      string_error bit (1) aligned init ("0"b),
      121     (false init ("0"b), true init ("1"b)) int static options (constant) bit (1) aligned, /* named bit values */
      122     (in, dent, dclind) fixed bin,			/* indentation */
      123      LMARGIN fixed bin init (11),			/* left margin */
      124      IN fixed bin init (5),				/* subsequent indent */
      125      CMC fixed bin init (61),				/* comment column */
      126      TABCOL fixed bin init (60),			/* nearest mult of 10 < CMC */
      127      NTAB fixed bin init (6),				/* number of tabs to get to TABCOL */
      128      nout fixed bin (24),				/* number of chars in output */
      129      colpos fixed bin,				/* Column pointer in output line. (last filled col) */
      130      parct fixed bin init (0),			/* paren count. must be 0 at semicolon */
      131      pdlx fixed bin,
      132      ifdent fixed bin,
      133      suffix char (4),
      134      suffix_assumed bit (1) init ("0"b),		/* set if indent is assuming the suffix */
      135     (i, j, k, kk, m) fixed bin (24);
      136 
      137 dcl 1 pdl (1024) aligned,				/* Pushdown list. */
      138     2 nif fixed bin (33) unal,			/* IF count. */
      139     2 swc bit (1) unal,				/* Conditional switch. IF and ELSE */
      140     2 sw bit (1) unal;				/* IF switch. */
      141 
      142 dcl  NP_NL_SP char (3) init static init ("
      143  ");
      144 dcl  SP char (1) int static init (" ");			/* Single space. */
      145 dcl  SP_TAB char (2) int static init ("	 ");		/* Tab and space, for verify etc. */
      146 dcl  SP_LP_NOT char (3) int static init (" (^");
      147 dcl  NOT_LES_GRT char (3) int static init ("^<>");
      148 dcl  SP_TAB_COM_SEMI char (4) int static init (" ,;	");
      149 dcl  SP_TAB_SEMI_NL char (4) int static init ("	 ;
      150 ");
      151 dcl  SP_TAB_SEMI_LP_NL char (5) int static init (" ;	(
      152 ");
      153 dcl  NL char (1) int static init ("
      154 ");
      155 dcl  TABS char (40) int static init ((40)"	");
      156 
      157 dcl  bcs char (lth) based (p) aligned;
      158 dcl  bcso char (1048576) based (p1) aligned;
      159 
      160 dcl  cv_dec_check_ entry (char (*) aligned, fixed bin (35)) returns (fixed bin),
      161      ioa_ entry options (variable),
      162      com_err_ entry options (variable),
      163      cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)),
      164      cu_$arg_count entry (fixed bin),
      165      expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)),
      166      hcs_$delentry_seg entry (ptr, fixed bin (35)),
      167      hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)),
      168      hcs_$terminate_noname entry (ptr, fixed bin (35)),
      169      hcs_$make_seg entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5),
      170      ptr, fixed bin (35)),
      171      hcs_$initiate_count entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (24),
      172      fixed bin (2), ptr, fixed bin (35)),
      173      get_pdir_ entry () returns (char (168) aligned),
      174      hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35));
      175 
      176 dcl (output_path_given, error_occurred) bit (1) aligned init ("0"b);
      177 
      178 
      179 
      180 dcl  moveseg char (nout) based aligned;			/* For copy of whole segment. */
      181 
      182 dcl  err_msg char (100) varying;
      183 
      184 dcl  error_table_$bad_arg fixed bin (35) ext;		/* Illegal command argument */
      185 dcl  error_table_$badopt fixed bin (35) ext;		/* Specified control arg not implemented by this command */
      186 dcl  error_table_$noarg fixed bin (35) ext;		/* Expected argument missing */
      187 dcl  error_table_$noentry fixed bin (35) ext;
      188 
      189 dcl (addr, divide, fixed, length, mod, min, null, substr, index, reverse,
      190      search, verify, unspec) builtin;
      191 
      192 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * 	*/
      193 
      194 
      195 	call cu_$arg_count (nargs);			/* get number of args */
      196 	if nargs = 0 then do;			/* gripe if no args */
      197 	     call com_err_ (0, "indent", "Usage: indent n1 -n2- -lm nn -in mm -cm kk -brief");
      198 	     return;
      199 	end;
      200 
      201 	lth1, lth2 = 0;				/* so we can tell if we have the pathnames yet */
      202 arg_loop:	do an = 1 to nargs;
      203 	     call cu_$arg_ptr (an, ap, al, ec);		/* pick off next arg */
      204 
      205 	     if ec ^= 0 then do;
      206 print_bad_arg:	err_msg = "^a";			/* control string to just print argument */
      207 arg_error:	call com_err_ (ec, "indent", err_msg, bchr);
      208 		return;
      209 	     end;
      210 
      211 	     if expecting ^= 0 then do;
      212 
      213 		en = bchr;			/* cv_dec_check_ needs aligned arg */
      214 		i = cv_dec_check_ (en, ec);
      215 
      216 		if expecting = 1 then do;		/* expecting left margin */
      217 		     expecting = 0;
      218 		     if ec ^= 0 then do;
      219 blm:			err_msg = "illegal left margin arg ^a";
      220 cv_dec_error:		ec = 0;			/* cv_dec_check_ does not return an error_table_ code */
      221 			goto arg_error;		/* go call com_err_ */
      222 		     end;
      223 		     if i < 1 then goto blm;
      224 		     if i > 100 then goto blm;
      225 		     LMARGIN = i;
      226 		end;
      227 
      228 		else if expecting = 2 then do;	/* expecting indent spaces */
      229 		     expecting = 0;
      230 		     if ec ^= 0 then do;
      231 bint:			err_msg = "illegal indent arg ^a";
      232 			goto cv_dec_error;
      233 		     end;
      234 		     if i < 0 then goto bint;
      235 		     if i > 100 then goto bint;
      236 		     IN = i;
      237 		end;
      238 
      239 		else do;				/* must be expecting comment column */
      240 		     expecting = 0;
      241 		     if ec ^= 0 then do;
      242 bcmc:			err_msg = "illegal comment column arg ^a";
      243 			goto cv_dec_error;
      244 		     end;
      245 		     if i < 1 then goto bcmc;
      246 		     if i > 350 then goto bcmc;
      247 		     CMC = i;
      248 		     TABCOL = 10 * divide (CMC-1, 10, 17, 0);
      249 		     NTAB = divide (TABCOL, 10, 17, 0);
      250 		end;
      251 
      252 	     end;					/* end of expecting argument do group */
      253 
      254 	     else do;				/* not-expected-argument */
      255 
      256 		if substr (bchr, 1, 1) = "-" then do;	/* Control argument? */
      257 		     if bchr = "-brief" then bfsw = true;
      258 		     else if bchr = "-bf" then bfsw = true;
      259 		     else if bchr = "-lmargin" then expecting = 1;
      260 		     else if bchr = "-lm" then expecting = 1;
      261 		     else if bchr = "-indent" then expecting = 2;
      262 		     else if bchr = "-ind" then expecting = 2;
      263 		     else if bchr = "-in" then expecting = 2;
      264 		     else if bchr = "-comment" then expecting = 3;
      265 		     else if bchr = "-cm" then expecting = 3;
      266 		     else do;
      267 			ec = error_table_$badopt;
      268 			goto print_bad_arg;
      269 		     end;
      270 		end;
      271 
      272 		else do;				/* Not control arg, must be filename */
      273 		     if lth1 = 0 then do;		/* if we don't have input filename then this is it */
      274 			n1 = bchr;		/* Pick up arg 1, input name */
      275 			lth1 = al;		/* Remember length for expand path */
      276 		     end;
      277 		     else if lth2 = 0 then do;	/* if we don't have output filename, this is it */
      278 			n2 = bchr;		/* User gave second name. Set it up. */
      279 			lth2 = al;		/* Set length of second arg. */
      280 			output_path_given = "1"b;
      281 		     end;
      282 		     else do;
      283 			ec = error_table_$bad_arg;	/* "Illegal command argument" */
      284 			goto print_bad_arg;		/* go call com_err_ to print the bad arg */
      285 		     end;
      286 		end;
      287 	     end;					/* end of not-expected-argument do group */
      288 	end arg_loop;				/* end of argument processing do group */
      289 
      290 	if lth1 = 0 then do;			/* if input filename not given */
      291 	     err_msg = "pathname of input file";
      292 noarg_err:     ec = error_table_$noarg;
      293 	     goto arg_error;
      294 	end;
      295 
      296 	if expecting ^= 0 then do;
      297 	     err_msg = "after ^a";
      298 	     goto noarg_err;
      299 	end;
      300 
      301 	if lth2 = 0 then do;			/* if output path not given, use input path */
      302 	     n2 = n1;
      303 	     lth2 = lth1;
      304 	end;
      305 
      306 
      307 /* END OF ARGUMENT PROCESSING */
      308 
      309 /* Initialization */
      310 
      311 	rd_source_sw, copy_this_comment_unchanged = false; /* flags for source to reduction_compiler */
      312 						/* and for unchangable comments. */
      313 	in, ifdent, if_count, old_if_count = 0;
      314 	strut, dclsw, condsw, ifsw, begin_ok, else_ok, comment, sixty, string, pstring = false;
      315 	bos, blsw = true;				/* Pretend line zero was empty. */
      316 	pdlx = 1;					/* Set pushdown list to empty. */
      317 	linno = 1;				/* This is line 1. */
      318 	offset, nout = 1;				/* read and write pointers */
      319 
      320 	i = index (reverse (substr (n1, 1, lth1)), ".");	/* get last component */
      321 	if i = 0 | i > 4 then go to in_suffix;		/* wrong size, don't bother */
      322 	suffix = substr (n1, lth1 - i + 1, i);		/* includes "." */
      323 	do j = 1 to 3;				/* .pl1, .cds, .rd */
      324 	     if suffix = suffixes (j)
      325 	     then do;
      326 		suffix_len = suffix_lengths (j);	/* for later suffix processing */
      327 		go to good_suffix;
      328 	     end;
      329 	end;
      330 
      331 /* Didn't match list of good suffices */
      332 
      333 in_suffix: suffix = ".pl1";				/* a good guess */
      334 	suffix_len = 4;
      335 	substr (n1, lth1+1, suffix_len) = suffix;	/* add to name */
      336 	lth1 = lth1+suffix_len;			/* adjust length */
      337 	suffix_assumed = "1"b;			/* remember, this was only a guess */
      338 
      339 good_suffix:
      340 	if suffix = ".rd" then rd_source_sw = "1"b;	/* remember to check for rd parse in comments */
      341 
      342 	call expand_path_ (addr (n1), lth1, addr (dn), addr (en), ec);
      343 	if ec ^= 0 then go to error;
      344 	call hcs_$initiate_count (dn, en, "", lth, 0, p, ec);
      345 	if p = null then do;			/* didn't find input seg */
      346 	     if ^suffix_assumed then go to error;	/* user gave suffix. Nothing more to try */
      347 	     if ec ^= error_table_$noentry then go to error; /* foo.pl1 not found is the only reason to continue */
      348 	     i = 34 - suffix_len - verify (reverse (en), " "); /* find suffix in entry name */
      349 	     suffix = ".cds";			/* try new suffix */
      350 	     suffix_len = 4;
      351 	     substr (en, i, suffix_len) = substr (suffix, 1, suffix_len);
      352 	     call hcs_$initiate_count (dn, en, "", lth, 0, p, ec);
      353 	     if p = null then do;			/* trouble with foo.cds too */
      354 		if ec = error_table_$noentry then
      355 		     go to error;			/* if foo.cds not found, print error about foo.pl1 */
      356 		substr (n1, lth1 - (suffix_len-1), suffix_len) = substr (suffix, 1, suffix_len);
      357 						/* for other errors, print message aboout foo.cds */
      358 		go to error;
      359 	     end;
      360 	end;
      361 	if lth2 < 4 then go to out_suffix;		/* out name shorter than x.rd, need suffix */
      362 	else if substr (n2, lth2 - (suffix_len-1), suffix_len) ^= substr (suffix, 1, suffix_len)
      363 	then do;					/* output suffix must match input */
      364 out_suffix:    substr (n2, lth2+1, suffix_len) = substr (suffix, 1, suffix_len);
      365 	     lth2 = lth2+suffix_len;
      366 	end;
      367 	lth = divide (lth+8, 9, 17, 0);		/* compute bit count of input seg */
      368 
      369 	temp_en = en;				/* Generate name of temp file. */
      370 	i = 34 -suffix_len - verify (reverse (temp_en), " "); /* Locate end. */
      371 	substr (temp_en, i, 4) = ".ind";
      372 	call hcs_$make_seg ((get_pdir_ ()), temp_en, "", 1010b, p1, ec);
      373 	if p1 = null then go to error;
      374 	call expand_path_ (addr (n2), lth2, addr (dn), addr (en), ec);
      375 	if ec ^= 0 then go to error;
      376 
      377 /* This is the loop for each line in the input segment. Starting at "offset" a line of "n" chars
      378*   is moved to the temporary buffer "chars". Trailing tabs and blanks are trimmed. */
      379 
      380 loop:	pstring = string;				/* remember if previous line ended inside quotes */
      381 	if offset > lth then go to eof;
      382 	i = index (substr (bcs, offset), NL);		/* Find length of line. */
      383 	if i = 0 then i = lth - offset + 1;		/* .. in case did not end in NL */
      384 	else if i = 1 then do;			/* Check for empty line. */
      385 	     substr (bcso, nout, 1) = NL;		/* insert in output */
      386 	     nout = nout + 1;
      387 	     linno = linno + 1;
      388 	     offset = offset + 1;
      389 	     blsw = true;
      390 	     go to loop;
      391 	end;
      392 	k = i - 1;
      393 	if k > 385 then do;				/* Line too big? */
      394 	     k, i = 385;				/* Take first 385 chars. */
      395 	     call ioa_ ("indent: line ^d of ""^a"" was too long & has been split.", linno, en);
      396 	     error_occurred = "1"b;
      397 	end;
      398 	chars = substr (bcs, offset, k);		/* Pick up line. */
      399 	substr (chars, k+1, 1) = NL;			/* Put in NL */
      400 	line_offset = offset;			/* remember where line started */
      401 	offset = offset + i;			/* Increase index. */
      402 	n = k + 1;				/* Set up length of line. */
      403 	if n = 1 then go to lemp;			/* Empty line? */
      404 	if ^pstring then				/* if not in string */
      405 	     if substr (chars, 1, 1) = "%" then do;	/* Is this an "include" line? */
      406 lemp:		blsw = true;			/* Yes, set switch. */
      407 		go to cpy;			/* And just copy line. */
      408 	     end;
      409 
      410 	icb, ice, icol, dent, end_count = 0;		/* Set up for loop. */
      411 	scolsw, dclfnd, newpage = false;
      412 
      413 /* The following section examines each character in the current line in "chars".
      414*   In this section, "i" is the character index which may be from 1 to "n". */
      415 
      416 	if pstring then do;				/* If we are now in a string, */
      417 	     kk = index (substr (chars, 1, n-1), """");	/* .. See if it ends on this line. */
      418 	     if kk = 0 then go to cpy;		/* Nope. Can't touch line at all. */
      419 	     else i = kk;				/* Yes. Skip string content. */
      420 	end;
      421 	else i = 1;				/* Examine each character in line. */
      422 l2s:	char = substr (chars, i, 1);			/* Pick up a character. */
      423 	if string then do;				/* Now in a string ? */
      424 	     if char = """" then do;			/* Watch for end */
      425 		string = false;			/* not any more */
      426 						/* While this ignoring of possible double quotes within a
      427*						   string works ok for indenting, it throws off string
      428*						   length checking. However, since this checking is to
      429*						   help locate missing quotes, it is not really necessary
      430*						   to check for double quotes here. */
      431 		string_len = line_offset+i-string_offset-1; /* compute length, excluding the quotes */
      432 		if string_len > 254 then		/* if string is too long, report line number
      433*						   to aid user in finding missing quote */
      434 		     if ^bfsw then			/* but only if user wants to be warned */
      435 			if ^string_error then do;	/* report only the first one - if there is a missing quote,
      436*						   there are probably a lot more long strings */
      437 			     call ioa_
      438 				("indent: possible syntax error in line ^d of ^a: string length (^d) > pl1 max.",
      439 				linno, en, string_len);
      440 			     string_error = "1"b;	/* remember not to report any more of these */
      441 			     error_occurred = "1"b;
      442 			end;
      443 	     end;
      444 	     go to l2e;				/* ... leaving all other chars */
      445 	end;
      446 	if comment then do;				/* are we now in a comment? */
      447 	     if substr (chars, i, 2) = "*/" then do;	/* Comment ends? */
      448 		comment = false;			/* Turn off switch. */
      449 		if copy_this_comment_unchanged then	/* Are we in rd reductions or in unchangable	*/
      450 						/* comment?  Then we are done with the comment.	*/
      451 		     copy_this_comment_unchanged = false;
      452 		else do;				/* Not in unchangable comment?		*/
      453 		     if i > 1 then if index (SP_TAB, substr (chars, i-1, 1)) = 0
      454 						/* chars on line prior to comment end delimiter?	*/
      455 			then call inb (i);		/* insert blank prior to comment end delimiter	*/
      456 		     if i < n-2 then		/* Chars on line after comment end delimiter?	*/
      457 			if index (SP_TAB_COM_SEMI, substr (chars, i+2, 1)) = 0 then
      458 			     call inb (i+2);	/* Nice blank after comment */
      459 		end;
      460 		ice = i;				/* save index of end of comment. */
      461 		i = i + 1;			/* Don't scan slash again. */
      462 		go to l2e;			/* Comment leaves state unchanged. */
      463 	     end;
      464 	     if i = 1 then do;			/* Continue comment. Trim leading blanks and tabs. */
      465 		k = verify (substr (chars, 1, n-1), SP_TAB) - 1;
      466 		if k = -1 then do;			/* if line of just white space inside comment */
      467 		     chars = "";			/* replace it wich just a newline */
      468 		     substr (chars, 1, 1) = NL;
      469 		     n = 1;
      470 		     go to cpy;
      471 		end;
      472 		if ^copy_this_comment_unchanged	/* don't disturb rd parse controls */
      473 		then do;
      474 		     substr (temchars, 1, n-k) = substr (chars, k+1, n-k);
      475 		     substr (chars, 1, 3) = "";	/* Stick in three blanks. */
      476 		     substr (chars, 4, n-k) = substr (temchars, 1, n-k);
      477 		     i = 4;
      478 		     n = n - k + 3;
      479 		end;
      480 	     end;
      481 	     kk = index (substr (chars, i, n-i), "*/");	/* Character inside comment. Skip out to end. */
      482 	     if kk = 0 then i = n-1;
      483 	     else i = i + kk - 2;			/* Set so we scan the comment end next. */
      484 	     go to l2e;
      485 	end;
      486 	k = fixed (unspec (char), 9);			/* See if char is ASCII */
      487 	if k < 0 then go to ilchr;
      488 	if k > 126 then go to ilchr;
      489 	go to case (k);				/* Dispatch on character. */
      490 
      491 /* Handlers for each character. */
      492 
      493 /* Punctuation. */
      494 
      495 case (009):					/* HT, octal 011 */
      496 	substr (chars, i, 1) = SP;
      497 case (032):					/* blank, octal 040 */
      498 	if i = 1 then go to squidge;
      499 	if substr (chars, i-1, 1) = SP then do;
      500 squidge:	     k = verify (substr (chars, i, n-i), SP_TAB) - 1;
      501 	     if k > 0 then call outb (i, k);		/* Remove multiple blanks and tabs. */
      502 	end;
      503 	go to l2e;				/* Ignore blank */
      504 case (034):					/* quote, octal 042 */
      505 	string = true;				/* now in string */
      506 	string_offset = line_offset+i;		/* remember where it started, for length checking */
      507 	kk = index (substr (chars, i+1, n-i), """");	/* Does string end on this line? */
      508 	if kk > 0 then i = i + kk - 1;		/* Yes. Skip string contents. */
      509 	else i = n-1;				/* No. Skip rest of line. */
      510 	go to cbs;
      511 case (040):					/* "(", octal 050 */
      512 	parct = parct + 1;				/* Increase count. */
      513 	if i > 1 then if index (SP_LP_NOT, substr (chars, i-1, 1)) = 0 then call inb (i);
      514 	if i < n-1 then if index (SP_TAB, substr (chars, i+1, 1)) ^= 0 then call outb (i+1, 1);
      515 	go to nxchr;				/* Condition prefix begins with paren. */
      516 case (041):					/* ")", octal 051 */
      517 	if i > 1 then if substr (chars, i-1, 1) = SP then call outb (i-1, 1);
      518 	parct = parct - 1;				/* decrease parenthesis count. */
      519 	if parct < 0 then do;			/* Check for more closes than opens. */
      520 	     call ioa_ ("indent: line ^d of ""^a"" has an extra "")"".", linno, en);
      521 	     error_occurred = "1"b;
      522 	     parct = 0;
      523 	end;
      524 	go to cbs;
      525 case (044):					/* ",", octal 054 */
      526 	if i > 1 then if substr (chars, i-1, 1) = SP then call outb (i-1, 1);
      527 	if i < n-1 then if substr (chars, i+1, 1) ^= SP then call inb (i+1);
      528 	go to cbs;
      529 case (045):					/* "-", octal 055 */
      530 	if substr (chars, i+1, 1) = ">" then do;	/* Is this a pointer digraph? */
      531 	     if i > 1 then if substr (chars, i-1, 1) ^= SP then call inb (i);
      532 	     if i < n-2 then if substr (chars, i+2, 1) ^= SP then call inb (i+2);
      533 	end;
      534 	go to cbs;
      535 case (047):					/* "/", octal 057 */
      536 	if substr (chars, i+1, 1) = "*" then do;	/* Comment begins? */
      537 	     comment = true;			/* Now in comment. */
      538 	     if i - length ("/") + length ("/****^") + length (NL) <= n
      539 	     then if substr (chars, i, length ("/****^")) = "/****^" then
      540 		     copy_this_comment_unchanged = true; /* check for comments which cannot be changed. */
      541 	     if ^copy_this_comment_unchanged then do;
      542 		if i > 1 then if substr (chars, i-1, 1) ^= SP then call inb (i);
      543 		if i < n - length ("/") - length (NL)
      544 		then if index (SP_TAB, substr (chars, i+2, 1)) = 0 /* need a blank? */
      545 		     then if ^rd_source_sw		/* check first for rd parse control */
      546 			then call inb (i+2);
      547 			else if substr (chars, i+2, 2) = "++"
      548 						/* beginning of rd parse specification? */
      549 			then copy_this_comment_unchanged = true;
      550 						/* yes. remember, and don't insert blank */
      551 			else call inb (i+2);	/* just a normal comment */
      552 	     end;
      553 	     icb = i;				/* Remember where comment began. */
      554 	     kk = index (substr (chars, i+2, n-i-2), "*/"); /* Search for end of comment. */
      555 	     if kk = 0 then i = n-1;			/* Not scanning content of comment. */
      556 	     else i = i + kk;			/* ... */
      557 	     go to l2e;				/* Leave "bos" as it was when comment began. */
      558 	end;
      559 	go to cbs;				/* Statement don't begin with slash */
      560 case (058):					/* ":", octal 072 */
      561 	if parct > 0 then go to nxchr;		/* Label can't be in parentheses. */
      562 	if bos then go to cbs;			/* Null label ? */
      563 	bos = true;				/* This is label. keyword ok */
      564 	icol = i + 1;				/* Save index. */
      565 	if i < n-1 then if index (SP_TAB, substr (chars, i+1, 1)) = 0 then call inb (i+1);
      566 	go to l2e;
      567 case (059):					/* ";", octal 073 */
      568 	scolsw, bos = true;				/* Semicolon. End of statement. */
      569 	begin_ok = false;
      570 	if condsw then do;				/* Does this end an IF? */
      571 	     old_if_count = if_count;			/* Save proper indent level for ELSE */
      572 	     if pdlx = 1 then if_count = 0;		/* Reset if_count */
      573 	     else if_count = pdl (pdlx-1).nif;		/* Set back to base for this level. */
      574 	     condsw = false;			/* Not now in conditional */
      575 	     else_ok = true;
      576 	end;
      577 	else old_if_count = 0;			/* End of some other statement. */
      578 	ifsw = false;				/* Not in IF now. */
      579 	if parct > 0 then do;			/* Parenthesis count should be zero. */
      580 	     call ioa_ ("indent: ^d extra ""(""s at line ^d of ""^a"".",
      581 		parct, linno, en);			/* Complain. */
      582 	     error_occurred = "1"b;
      583 	     parct = 0;				/* Start over on count. */
      584 	end;
      585 	go to l2e;
      586 case (061):					/* "=", octal 075 */
      587 	if i < n-1 then if substr (chars, i+1, 1) ^= SP then call inb (i+1);
      588 	m = 1;
      589 	if i > 1 then if index (NOT_LES_GRT, substr (chars, i-1, 1)) ^= 0 then m = 2;
      590 	if i > m then if substr (chars, i-m, 1) ^= SP then call inb (i-m+1);
      591 	go to cbs;
      592 
      593 /* This section checks for reserved words by looking at the first letter. */
      594 
      595 case (098):					/* letter "b", octal 142 */
      596 	if ^bos then if ^begin_ok then go to nxchr;	/* Must be at begin of statement or in ON */
      597 	if parct > 0 then go to nxchr;		/* ignore begins in parens */
      598 	if i <= n-5 then if substr (chars, i, 5) = "begin" then
      599 		if search (substr (chars, i, n-i+1), SP_TAB_SEMI_NL) = 6 then do;
      600 		     i = i + 4;			/* Skip over rest of word. */
      601 in_found:		     if ifsw then if_count = if_count - 1; /* Don't do extra indent. */
      602 		     pdl (pdlx).sw = ifsw;		/* Push down current if switch. */
      603 		     pdl (pdlx).swc = condsw;		/* .. and conditional switch. */
      604 		     pdl (pdlx).nif = if_count;	/* .. and if indentation. */
      605 		     pdlx = pdlx + 1;		/* .. */
      606 		     if pdlx = 1024 then do;		/* If nesting depth too great, die. */
      607 			call com_err_ (0, "indent", "FATAL ERROR. Line ^d of ""^a"" nesting depth > 1024",
      608 			     linno, en);
      609 			return;
      610 		     end;
      611 		     condsw = false;		/* Now not in IF */
      612 		     ifsw = false;
      613 		     dent = dent + 1;		/* Increase indentation level. */
      614 		end;
      615 	go to nxchr;
      616 case (100):					/* letter "d", octal 144 */
      617 	if parct > 0 then go to nxchr;		/* reserved word not in parens */
      618 	if ^bos then go to nxchr;			/* Must be at beginning of statement. */
      619 	kk = search (substr (chars, i, n-i+1), SP_TAB_SEMI_NL);
      620 	if kk = 3 then if substr (chars, i, 2) = "do" then do;
      621 		i = i + 1;			/* Found DO statement. */
      622 		go to in_found;
      623 	     end;
      624 	if condsw then go to nxchr;			/* Declaration cannot be inside an IF */
      625 	if i = 1 then do;				/* declare stm must start in col 1 ... */
      626 	     if kk = 4 then if substr (chars, i, 3) = "dcl" then do;
      627 		     dclfnd = true;			/* Found DCL statement. */
      628 		     i = i + 2;
      629 		     dclind = 4;
      630 		     go to nxchr;
      631 		end;
      632 	     if kk = 8 then if substr (chars, i, 7) = "declare" then do;
      633 		     dclfnd = true;			/* Found DECLARE statement. */
      634 		     i = i + 6;
      635 		     dclind = 8;
      636 		     go to nxchr;
      637 		end;
      638 	end;
      639 	go to nxchr;
      640 case (101):					/* letter "e", octal 145 */
      641 	if parct > 0 then go to nxchr;		/* keyword not appear in parens. */
      642 	if ^bos then go to nxchr;			/* Must be in beginning-of-statment state. */
      643 	kk = search (substr (chars, i, n-i+1), SP_TAB_SEMI_NL);
      644 	if else_ok then if kk = 5 then if substr (chars, i, 4) = "else" then do;
      645 		     if_count = old_if_count - 1;	/* Restore old IF indentation. */
      646 		     ifdent = old_if_count - 1;	/* Outdent the ELSE to the corresponding IF */
      647 		     else_ok = false;		/* ELSE may not follow ELSE. */
      648 		     if if_count > 0 then condsw = true; /* But may follow after semi. */
      649 		     bos = true;			/* Statement may follow ELSE. */
      650 		     i = i + 3;
      651 		     go to l2e;
      652 		end;
      653 	if condsw then go to nxchr;			/* Cannot say "then end" */
      654 	if kk = 4 then if substr (chars, i, 3) = "end" then do;
      655 		end_count = end_count + 1;		/* Found END statement. */
      656 		if pdlx > 1 then do;		/* Unstack IF state. */
      657 		     pdlx = pdlx - 1;		/* .. */
      658 		     ifsw = pdl (pdlx).sw;		/* .. */
      659 		     condsw = pdl (pdlx).swc;		/* ... */
      660 		     if_count = pdl (pdlx).nif;	/* .. */
      661 		     if ifsw then if_count = if_count + 1;
      662 		end;
      663 		if (in - end_count + dent) < 0 then do; /* Too many END's? */
      664 		     call ioa_ ("indent: line ^d of ""^a"" has an extra ""end"".", linno, en);
      665 		     dent, in, end_count = 0;		/* Start over on indents */
      666 		     error_occurred = "1"b;
      667 		end;
      668 		i = i + 2;
      669 	     end;
      670 	go to nxchr;
      671 case (105):					/* letter "i", octal 151 */
      672 	if parct > 0 then go to nxchr;
      673 	if ^bos then go to nxchr;
      674 	if i <= n-2 then if substr (chars, i, 2) = "if" then
      675 		if search (substr (chars, i, n-i+1), SP_TAB_SEMI_LP_NL) = 3 then do;
      676 		     condsw = true;			/* Set IF encountered flag. */
      677 		     ifsw = true;
      678 		     i = i + 1;
      679 		end;
      680 	go to nxchr;
      681 case (116):					/* letter "t", octal 164 */
      682 	if parct > 0 then go to nxchr;		/* Look for THEN keyword. */
      683 	if bos then go to nxchr;			/* THEN cannot begin a statement. */
      684 	if ^ifsw then go to nxchr;			/* and some IF must have come up. */
      685 	if i ^= 1 then if substr (chars, i-1, 1) ^= SP then go to nxchr;
      686 	if i <= n-4 then if substr (chars, i, 4) = "then" then
      687 		if search (substr (chars, i, n-i+1), SP_TAB_SEMI_NL) = 5 then do;
      688 		     bos = true;			/* Found THEN. Statement may follow. */
      689 		     i = i + 3;
      690 		     if_count = if_count + 1;
      691 		     go to l2e;
      692 		end;
      693 	go to nxchr;
      694 case (111):					/* letter "o", octal 157 */
      695 	if ^bos then go to nxchr;			/* Check for ON statement. */
      696 	if parct > 0 then go to nxchr;
      697 	if i <= n-2 then if substr (chars, i, 2) = "on" then
      698 		if search (substr (chars, i, n-i+1), SP_TAB_SEMI_NL) = 3 then do;
      699 		     begin_ok = true;		/* ON statement may contain BEGIN */
      700 		     i = i + 1;
      701 		end;
      702 	go to nxchr;
      703 case (112):					/* letter "p", octal 160 */
      704 	if parct > 0 then go to nxchr;
      705 	if ^bos then go to nxchr;
      706 	if condsw then go to nxchr;			/* Cannot say "then proc" */
      707 	k = 3;
      708 	kk = search (substr (chars, i, n-i+1), SP_TAB_SEMI_LP_NL);
      709 	if kk = 5 then if substr (chars, i, 4) = "proc" then go to procfnd;
      710 	k = 8;
      711 	if kk = 10 then if substr (chars, i, 9) = "procedure" then do;
      712 procfnd:		i = i + k;			/* Skip scan of keyword. */
      713 		go to in_found;			/* Increase indentation level */
      714 	     end;
      715 	go to nxchr;
      716 
      717 /* Illegal characters. Squawk and continue. */
      718 
      719 case (000):					/* NUL, octal 000 */
      720 case (001):					/* undefined, octal 001 */
      721 case (002):					/* undefined, octal 002 */
      722 case (003):					/* undefined, octal 003 */
      723 case (004):					/* undefined, octal 004 */
      724 case (005):					/* undefined, octal 005 */
      725 case (006):					/* undefined, octal 006 */
      726 case (007):					/* BEL, octal 007 */
      727 case (008):					/* BS, octal 010 */
      728 case (013):					/* CR, octal 015 */
      729 case (014):					/* RRS, octal 016 */
      730 case (015):					/* BRS, octal 017 */
      731 case (016):					/* undefined, octal 020 */
      732 case (017):					/* undefined, octal 021 */
      733 case (018):					/* undefined, octal 022 */
      734 case (019):					/* undefined, octal 023 */
      735 case (020):					/* undefined, octal 024 */
      736 case (021):					/* undefined, octal 025 */
      737 case (022):					/* undefined, octal 026 */
      738 case (023):					/* undefined, octal 027 */
      739 case (024):					/* undefined, octal 030 */
      740 case (025):					/* undefined, octal 031 */
      741 case (026):					/* undefined, octal 032 */
      742 case (027):					/* undefined, octal 033 */
      743 case (028):					/* undefined, octal 034 */
      744 case (029):					/* undefined, octal 035 */
      745 case (030):					/* undefined, octal 036 */
      746 case (031):					/* EGM, octal 037 */
      747 ilchr:	call ioa_ ("indent: warning: illegal character (octal ^3.3b) in line ^d of ""^a""",
      748 	     unspec (substr (chars, i, 1)), linno, en);
      749 	error_occurred = "1"b;
      750 	go to l2e;
      751 
      752 case (033):					/* "!", octal 041 */
      753 case (035):					/* sharp, octal 043 */
      754 case (039):					/* "'", octal 047 */
      755 case (063):					/* "?", octal 077 */
      756 case (064):					/* at-sign, octal 100 */
      757 case (091):					/* "[", octal 133 */
      758 case (092):					/* escape (backslash), octal 134 */
      759 case (093):					/* "]", octal 135 */
      760 case (096):					/* "`", octal 140 */
      761 case (123):					/* "{", octal 173 */
      762 case (125):					/* "}", octal 175 */
      763 case (126):					/* tilde, octal 176 */
      764 	if ^bfsw then do;				/* Unless brief mode, gripe */
      765 	     call ioa_ ("indent: warning: non-pl1 char ""^a"" outside string in line ^d of ""^a""",
      766 		substr (chars, i, 1), linno, en);
      767 	     error_occurred = "1"b;
      768 	end;
      769 	go to l2e;
      770 
      771 /* Chars which are legal but cannot begin a statement. */
      772 
      773 case (036):					/* "$", octal 044 */
      774 case (038):					/* "&", octal 046 */
      775 case (042):					/* "*", octal 052 */
      776 case (043):					/* "+", octal 053 */
      777 case (046):					/* ".", octal 056 */
      778 case (048):					/* digit "0", octal 060 */
      779 case (049):					/* digit "1", octal 061 */
      780 case (050):					/* digit "2", octal 062 */
      781 case (051):					/* digit "3", octal 063 */
      782 case (052):					/* digit "4", octal 064 */
      783 case (053):					/* digit "5", octal 065 */
      784 case (054):					/* digit "6", octal 066 */
      785 case (055):					/* digit "7", octal 067 */
      786 case (056):					/* digit "8", octal 070 */
      787 case (057):					/* digit "9", octal 071 */
      788 case (060):					/* "<", octal 074 */
      789 case (062):					/* ">", octal 076 */
      790 case (094):					/* circumflex, octal 136 */
      791 case (095):					/* underscore, octal 137 */
      792 case (124):					/* "|", octal 174 */
      793 cbs:	if bos then if ^bfsw then do;
      794 		call ioa_ ("indent: possible syntax error in line ^d of ^a detected at char ""^a""",
      795 		     linno, en, substr (chars, i, 1));
      796 		error_occurred = "1"b;
      797 	     end;
      798 
      799 /* Chars which are legal beginnings of statement. */
      800 
      801 case (037):					/* "%", octal 045 */
      802 case (065):					/* letter "A", octal 101 */
      803 case (066):					/* letter "B", octal 102 */
      804 case (067):					/* letter "C", octal 103 */
      805 case (068):					/* letter "D", octal 104 */
      806 case (069):					/* letter "E", octal 105 */
      807 case (070):					/* letter "F", octal 106 */
      808 case (071):					/* letter "G", octal 107 */
      809 case (072):					/* letter "H", octal 110 */
      810 case (073):					/* letter "I", octal 111 */
      811 case (074):					/* letter "J", octal 112 */
      812 case (075):					/* letter "K", octal 113 */
      813 case (076):					/* letter "L", octal 114 */
      814 case (077):					/* letter "M", octal 115 */
      815 case (078):					/* letter "N", octal 116 */
      816 case (079):					/* letter "O", octal 117 */
      817 case (080):					/* letter "P", octal 120 */
      818 case (081):					/* letter "Q", octal 121 */
      819 case (082):					/* letter "R", octal 122 */
      820 case (083):					/* letter "S", octal 123 */
      821 case (084):					/* letter "T", octal 124 */
      822 case (085):					/* letter "U", octal 125 */
      823 case (086):					/* letter "V", octal 126 */
      824 case (087):					/* letter "W", octal 127 */
      825 case (088):					/* letter "X", octal 130 */
      826 case (089):					/* letter "Y", octal 131 */
      827 case (090):					/* letter "Z", octal 132 */
      828 case (097):					/* letter "a", octal 141 */
      829 case (099):					/* letter "c", octal 143 */
      830 case (102):					/* letter "f", octal 146 */
      831 case (103):					/* letter "g", octal 147 */
      832 case (104):					/* letter "h", octal 150 */
      833 case (106):					/* letter "j", octal 152 */
      834 case (107):					/* letter "k", octal 153 */
      835 case (108):					/* letter "l", octal 154 */
      836 case (109):					/* letter "m", octal 155 */
      837 case (110):					/* letter "n", octal 156 */
      838 case (113):					/* letter "q", octal 161 */
      839 case (114):					/* letter "r", octal 162 */
      840 case (115):					/* letter "s", octal 163 */
      841 case (117):					/* letter "u", octal 165 */
      842 case (118):					/* letter "v", octal 166 */
      843 case (119):					/* letter "w", octal 167 */
      844 case (120):					/* letter "x", octal 170 */
      845 case (121):					/* letter "y", octal 171 */
      846 case (122):					/* letter "z", octal 172 */
      847 nxchr:	bos = false;				/* No longer at beginning of statement. */
      848 	else_ok = false;				/* ELSE no longer legal. */
      849 	go to l2e;
      850 
      851 /* Chars which do not preclude beginning of statement. */
      852 
      853 case (012):					/* NP, octal 014 */
      854 	newpage = "1"b;				/* remember line contained NP */
      855 case (010):					/* NL, octal 012 */
      856 case (011):					/* VT, octal 013 */
      857 l2e:	i = i + 1;				/* Increase index in working array. */
      858 	if i < n then go to l2s;			/* If any chars left, go thru again. */
      859 
      860 /* come here when all characters in line examined */
      861 
      862 	i = 1;					/* "i" will be the index in the "chars" buffer. */
      863 	if newpage then do;				/* special test if newpage encountered */
      864 	     if verify (substr (chars, 1, n), NP_NL_SP) = 0 then do; /* if line is all spaces, newpages, and newlines */
      865 		n = 2;				/* make new short line */
      866 		chars = substr (NP_NL_SP, 1, 2);	/* of newpage and newline */
      867 		blsw = true;			/* this is a blank line */
      868 		go to cpy;
      869 	     end;
      870 	end;
      871 	if icb = 1 then do;				/* Does line start with comment? */
      872 	     if blsw then do;			/* Yes. Previous line empty? */
      873 		sixty = false;			/* Yes, start in column 1. */
      874 		go to cpy;			/* Just copy line. */
      875 	     end;
      876 push:	     sixty = true;				/* Comment goes in column 60. */
      877 	     ntab = NTAB;
      878 	     i = 1;
      879 	     go to nimcom;
      880 	end;
      881 	if icb = 0 then if (comment | ice > 0) then do;	/* Continuation of comment? */
      882 		if sixty then go to push;		/* Do we indent it? */
      883 cpy:		substr (bcso, nout, n) = substr (chars, 1, n); /* Copy whole line. */
      884 		nout = nout + n;
      885 		go to finish_line;
      886 	     end;
      887 
      888 /* This section computes the left margin for each line. */
      889 
      890 	blsw = false;				/* Not empty line. */
      891 	if pstring then do;
      892 	     indent = 0;				/* don't indent inside quoted string */
      893 	     icol = 0;
      894 	end;
      895 	else if dclfnd then do;			/* Does line begin with DCL? */
      896 	     dclfnd = false;			/* Yes. */
      897 	     dclsw = true;				/* We are in a declaration now. */
      898 	     if index ("0123456789", substr (chars, dclind+1, 1)) ^= 0 then strut = true; else strut = false;
      899 	     icol = dclind;				/* Copy first dclind chars without indent. */
      900 	     if strut then indent = dclind+1;		/* Indent dclind+1 in structure */
      901 	     else if substr (chars, dclind+1, 1) = "(" then indent = dclind+1;
      902 						/* ... or in factored dcl, */
      903 	     else indent = dclind+2;			/* ... otherwise dclind+2. */
      904 	end;
      905 	else if dclsw then do;			/* Are we in old declaration? */
      906 	     icol = 0;				/* Yes. */
      907 	     kk = index ("0123456789", substr (chars, 1, 1)) - 1;
      908 	     if strut & kk >= 0 then do;		/* If structure, use level number. */
      909 		k = kk;				/* Convert to number. */
      910 		kk = index ("0123456789", substr (chars, 2, 1)) - 1;
      911 		if kk >= 0 then k = k*10 + kk;
      912 		indent = dclind + k + k - 3;		/* calculate proper indentation */
      913 	     end;					/* typically, this yields
      914*						   .	dcl 1 s,
      915*						   .	    2 l1,
      916*						   .	    2 l2,
      917*						   .	      3 l3; etc.	 */
      918 
      919 	     else if substr (chars, 1, 1) = "("
      920 	     then do;
      921 		if strut
      922 		then do;				/* we have factored level declarations */
      923 		     k = index ("0123456789", substr (chars, 2, 1)) - 1;
      924 		     if k > 0			/* better be */
      925 		     then do;
      926 			kk = index ("0123456789", substr (chars, 3, 1)) - 1; /* look for level > 9 */
      927 			if kk > 0 then k = 10 * k + kk;
      928 			indent = dclind + k + k - 4;	/* subtract 1 more to allow for paren */
      929 		     end;
      930 
      931 /* should report the following, but can't tell the difference between missing level number and just initialize...
      932*   else call ioa_ ("indent: No level number follows ""("" in structure. Line ^d in ""^a"". Continuing.", linno, en); */
      933 		end;
      934 		else indent = dclind + 1;		/* no structure */
      935 	     end;
      936 
      937 	     else indent = dclind+2;			/* No. */
      938 	end;
      939 	else do;					/* Normal statement. */
      940 	     k = min (end_count, dent);		/* May be both do and end on same line. */
      941 	     end_count = end_count - k;		/* If so, do not "outdent" */
      942 	     dent = dent - k;			/* ... */
      943 	     indent = (in + ifdent - end_count - 1) * IN + LMARGIN; /* Compute indentation. */
      944 	     if indent < 0 then indent = 0;		/* No negative indent. */
      945 	end;
      946 
      947 /* This section copies the line into the output seg, inserting blanks and tabs. */
      948 
      949 	if icol >= n then go to cpy;			/* If line is just a label, do it the easy way. */
      950 	colpos = 0;				/* Remember where started. */
      951 	if icol ^= 0 then do;
      952 	     substr (bcso, nout, icol) = substr (chars, 1, icol); /* Copy label section if any. */
      953 	     nout = nout + icol;			/* Increase offset. */
      954 	     colpos = colpos + icol;			/* and column. */
      955 	end;
      956 	i = icol + 1;
      957 	if i ^= icb then				/* Handle case of just label and comment. */
      958 	     if indent > icol then do;		/* Must insert blanks. */
      959 		if substr (chars, icol, 1) = SP then do; /* a blank was included in icol for labels */
      960 		     icol = icol - 1;		/* Back up by one char, to prevent space-tab. */
      961 		     colpos = colpos - 1;
      962 		     nout = nout - 1;
      963 		end;
      964 		k = indent - icol - 1;		/* Calculate number of blanks required. */
      965 		colpos = colpos + k;		/* Calculate new column position in output. */
      966 		if colpos >= 10 then do;		/* Replace blanks by tabs if possible. */
      967 		     kk = divide (colpos, 10, 17, 0) - divide (icol, 10, 17, 0);
      968 		     if kk > 0 then do;
      969 			substr (bcso, nout, kk) = substr (TABS, 1, kk);
      970 			nout = nout + kk;
      971 			k = mod (colpos, 10);	/* Tab column might not be multiple of 10 */
      972 		     end;
      973 		end;
      974 		if k ^= 0 then do;
      975 		     substr (bcso, nout, k) = "";	/* Run in blanks. */
      976 		     nout = nout + k;
      977 		end;
      978 	     end;
      979 	if ice ^= 0 then if ice = n-2 then go to havcom;	/* If comment is last thing on line, */
      980 	if ice ^= 0 then if ice = n-3 then if substr (chars, n-1, 1) = ";" then go to havcom;
      981 						/* or if comment is last on line except end of statement, */
      982 	if ice = 0 then if icb > 0 then do;		/* or if comment starts on this line and doesn't end.. */
      983 havcom:		sixty = true;			/* Yes, move comment to column 60. */
      984 		k = icb-i;			/* Copy statement part. */
      985 		if k ^= 0 then do;
      986 		     substr (bcso, nout, k) = substr (chars, i, k);
      987 		     nout = nout + k;
      988 		     colpos = colpos + k;		/* Keep track of column. */
      989 		     i = i + k;
      990 		end;
      991 		if colpos < TABCOL then do;		/* If statement does not reach to col. 60, */
      992 		     if substr (bcso, nout-1, 1) = SP then do; /* Avoid space-tab sequence. */
      993 			nout = nout - 1;
      994 			colpos = colpos - 1;
      995 		     end;
      996 		     if substr (chars, i, 1) = SP then i = i + 1; /* ... */
      997 		     ntab = divide (TABCOL-colpos-1, 10, 17, 0) + 1; /* Compute number of tabs to get there. */
      998 nimcom:		     if ntab ^= 0 then do;
      999 			substr (bcso, nout, ntab) = substr (TABS, 1, ntab);
     1000 			nout = nout + ntab;
     1001 		     end;
     1002 		     colpos = TABCOL;
     1003 		end;
     1004 		k = CMC - colpos - 1;		/* In case tab column not 10 * x + 1 */
     1005 		if k > 0 then do;
     1006 		     substr (bcso, nout, k) = "";	/* Run in blanks */
     1007 		     nout = nout + k;
     1008 		end;
     1009 	     end;
     1010 	k = n - i + 1;
     1011 	if k ^= 0 then do;
     1012 	     substr (bcso, nout, k) = substr (chars, i, k); /* Copy remainder of line. */
     1013 	     nout = nout + k;
     1014 	end;
     1015 
     1016 	in = in - end_count + dent;			/* Adjust indentation base for next line. */
     1017 	ifdent = if_count;				/* Set IF's to indent. */
     1018 	if ^bos then if ^ifsw then ifdent = ifdent + 1;	/* .. if statement is continued, indent 5 more. */
     1019 	dclsw = dclsw & ^ scolsw;			/* In declaration if were in and no semicolon. */
     1020 
     1021 /* Finished with the line. Go get another. */
     1022 
     1023 finish_line:
     1024 	linno = linno + 1;				/* Count line. */
     1025 	if nout ^> 2 then go to loop;			/* too short to check */
     1026 	i = verify (reverse (substr (bcso, 1, nout-2)), SP_TAB); /* check for trailing white space in line copied */
     1027 	if i = 1 then go to loop;			/* there was none */
     1028 	if i = 0 then i = nout - 2;			/* there was a lot */
     1029 	else i = i - 1;				/* there was some */
     1030 	if string then do;				/* if in a string, bad news because its invisible */
     1031 	     if ^bfsw then call ioa_
     1032 		("indent: Line ^d of ""^a"" contains trailing white space that is part of a string.",
     1033 		linno - 1, en);
     1034 	     go to loop;				/* Don't change */
     1035 	end;
     1036 	nout = nout - i;				/* back up end over white space */
     1037 	substr (bcso, nout-1, 1) = NL;		/* put in a new newline */
     1038 	unspec (substr (bcso, nout, i)) = "0"b;		/* clean out the extra stuff that was moved in */
     1039 	go to loop;
     1040 
     1041 /* Control comes here when the input segment is exhausted. */
     1042 
     1043 eof:	if in > 0
     1044 	then if ^(rd_source_sw & in = 1)		/* rd source should be missing one "end" */
     1045 	     then do;
     1046 		call ioa_ ("indent: ""^a"" has ^d too few ""end""s.", en, in);
     1047 		error_occurred = "1"b;
     1048 	     end;
     1049 	     else;
     1050 	else if rd_source_sw
     1051 	then do;
     1052 	     call ioa_ ("indent: The reduction_compiler source ""^a"" has one too many ""end""s.", en);
     1053 	     error_occurred = "1"b;
     1054 	end;
     1055 	if string then do;
     1056 	     call ioa_ ("indent: ""^a"" ends in a string.", en);
     1057 	     error_occurred = "1"b;
     1058 	end;
     1059 	if comment then do;
     1060 	     call ioa_ ("indent: ""^a"" ends in a comment.", en);
     1061 	     error_occurred = "1"b;
     1062 	end;
     1063 	if parct > 0 then do;
     1064 	     call ioa_ ("indent: ""^a"" has ^d extra ""(""s.", en, parct);
     1065 	     error_occurred = "1"b;
     1066 	end;
     1067 
     1068 	call hcs_$terminate_noname (p, ec);		/* Terminate input segment. */
     1069 
     1070 	lth = 9 * (nout-1);				/* Compute bit count. */
     1071 	call hcs_$set_bc_seg (p1, lth, ec);		/* Set bit count on temp, in case of error. */
     1072 
     1073 	if error_occurred then
     1074 	     if ^output_path_given then do;
     1075 		call com_err_ (0, "indent", "Input segment not replaced. Indented copy is in [pd]>^a", temp_en);
     1076 		return;
     1077 	     end;
     1078 
     1079 	call hcs_$make_seg (dn, en, "", 1011b, p, ec);	/* Get ptr to final output. Make if necessary */
     1080 	if p = null then go to error1;
     1081 	call hcs_$truncate_seg (p, 0, ec);		/* Truncate target. */
     1082 	if ec ^= 0 then do;
     1083 error1:	     call com_err_ (ec, "indent", "Cannot copy ^a from [pd]>^a", en, temp_en);
     1084 	     return;
     1085 	end;
     1086 	p -> moveseg = p1 -> moveseg;			/* Zap. */
     1087 	call hcs_$set_bc_seg (p, lth, ec);		/* Set bit count. */
     1088 	call hcs_$terminate_noname (p, ec);		/* Terminate output. */
     1089 	call hcs_$delentry_seg (p1, ec);		/* Delete scratch segment. */
     1090 	return;					/* Happy return. */
     1091 
     1092 error:	call com_err_ (ec, "indent", n1);		/* Here to gripe to user */
     1093 	return;					/* And give up */
     1094 
     1095 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * */
     1096 
     1097 /* Insert a blank at "ix" */
     1098 
     1099 inb:	proc (ix);
     1100 dcl  ix fixed bin (24);				/* Index in work array where blank goes. */
     1101 	     substr (temchars, 1, n-ix+1) = substr (chars, ix, n-ix+1);
     1102 	     substr (chars, ix+1, n-ix+1) = substr (temchars, 1, n-ix+1);
     1103 	     substr (chars, ix, 1) = SP;		/* Insert blank. */
     1104 	     n = n + 1;				/* Up the line length. */
     1105 	     if ix <= i then i = i + 1;		/* did we change the character looked at? */
     1106 	end inb;
     1107 
     1108 /* This procedure removes "nn" blanks starting at "ix" */
     1109 
     1110 outb:	proc (ix, nn);
     1111 dcl  ix fixed bin (24);
     1112 dcl  nn fixed bin (24);
     1113 
     1114 	     substr (temchars, 1, n-ix-nn+1) = substr (chars, ix+nn, n-ix-nn+1);
     1115 	     substr (chars, ix, n-ix-nn+1) = substr (temchars, 1, n-ix-nn+1);
     1116 	     n = n - nn;
     1117 	     if ix = i then i = i - 1;		/* Back up one if now looking at new char. */
     1118 	     else if ix < i then i = i - nn;
     1119 	end outb;
     1120 
     1121      end indent;
	SOURCE FILES USED IN THIS COMPILATION.

LINE      NUMBER  DATE MODIFIED     NAME			PATHNAME
             0    12/16/85  1652.7  indent.pl1                        >spec>install>1001>indent.pl1
	NAMES DECLARED IN THIS COMPILATION.

IDENTIFIER	     OFFSET    LOC STORAGE CLASS   DATA TYPE		ATTRIBUTES AND REFERENCES
								(* indicates a set context)

CMC                             000723 automatic       fixed bin(17,0)          initial dcl 79 set ref 79* 247* 248 1004
IN                              000722 automatic       fixed bin(17,0)          initial dcl 79 set ref 79* 236* 943
LMARGIN                         000721 automatic       fixed bin(17,0)          initial dcl 79 set ref 79* 225* 943
NL                                     constant        char(1)                  initial unaligned dcl 153 ref 382 385 399 468 538
                                                                                  543 1037
NOT_LES_GRT                     000204 constant        char(3)                  initial unaligned dcl 147 ref 589
NP_NL_SP                        000206 constant        char(3)                  initial unaligned dcl 142 ref 864 866
NTAB                            000725 automatic       fixed bin(17,0)          initial dcl 79 set ref 79* 249* 877
SP                              007175 constant        char(1)                  initial unaligned dcl 144 ref 495 499 516 525 527
                                                                                  531 532 542 586 590 685 959 992 996 1103
SP_LP_NOT                       000205 constant        char(3)                  initial unaligned dcl 146 ref 513
SP_TAB                          007174 constant        char(2)                  initial unaligned dcl 145 ref 453 465 500 514 543
                                                                                  565 1026
SP_TAB_COM_SEMI                 000203 constant        char(4)                  initial unaligned dcl 148 ref 456
SP_TAB_SEMI_LP_NL               000200 constant        char(5)                  initial unaligned dcl 151 ref 674 708
SP_TAB_SEMI_NL                  000202 constant        char(4)                  initial unaligned dcl 149 ref 598 619 643 686 697
TABCOL                          000724 automatic       fixed bin(17,0)          initial dcl 79 set ref 79* 248* 249 991 997 1002
TABS                            007162 constant        char(40)                 initial unaligned dcl 155 ref 969 999
addr                                                   builtin function         dcl 189 ref 342 342 342 342 342 342 374 374 374 374
                                                                                  374 374
al                              000332 automatic       fixed bin(17,0)          dcl 79 set ref 203* 207 207 213 256 257 258 259 260
                                                                                  261 262 263 264 265 274 275 278 279
an                              000333 automatic       fixed bin(17,0)          dcl 79 set ref 202* 203*
ap                              000330 automatic       pointer                  dcl 79 set ref 203* 207 213 256 257 258 259 260 261
                                                                                  262 263 264 265 274 278
arg_error                       001114 constant        label                    dcl 207 ref 221 293
arg_loop                        001062 constant        label                    dcl 202
bchr                                   based           char                     unaligned dcl 79 set ref 207* 213 256 257 258 259
                                                                                  260 261 262 263 264 265 274 278
bcmc                            001251 constant        label                    dcl 242 ref 245 246
bcs                                    based           char                     dcl 157 ref 382 398
bcso                                   based           char(1048576)            dcl 158 set ref 385* 883* 952* 969* 975* 986* 992
                                                                                  999* 1006* 1012* 1026 1037* 1038*
begin_ok                        000702 automatic       bit(1)                   dcl 79 set ref 314* 569* 595 699*
bfsw                            000714 automatic       bit(1)                   initial dcl 79 set ref 79* 257* 258* 432 752 773
                                                                                  1031
bint                            001232 constant        label                    dcl 231 ref 234 235
blm                             001207 constant        label                    dcl 219 ref 223 224
blsw                            000707 automatic       bit(1)                   dcl 79 set ref 315* 389* 406* 867* 872 890*
bos                             000706 automatic       bit(1)                   dcl 79 set ref 315* 562 563* 567* 595 618 642 649*
                                                                                  673 683 688* 694 705 773 801* 1018
case                            000000 constant        label                    array(0:126) dcl 495 set ref 489
cbs                             004407 constant        label                    dcl 773 ref 510 524 528 534 559 562 591
char                            000665 automatic       char(1)                  unaligned dcl 79 set ref 422* 424 486
chars                           000355 automatic       char(400)                unaligned dcl 79 set ref 398* 399* 404 417 422 447
                                                                                  453 456 465 467* 468* 474 475* 476* 481 495* 499
                                                                                  500 507 513 514 516 525 527 529 531 532 535 538
                                                                                  542 543 547 554 565 586 589 590 598 598 619 620
                                                                                  626 632 643 644 654 674 674 685 686 686 697 697
                                                                                  708 709 711 719 719 765 765 794 794 864 866* 883
                                                                                  898 901 907 910 919 923 926 952 959 980 986 996
                                                                                  1012 1101 1102* 1103* 1114 1115*
colpos                          000727 automatic       fixed bin(17,0)          dcl 79 set ref 950* 954* 954 961* 961 965* 965 966
                                                                                  967 971 988* 988 991 994* 994 997 1002* 1004
com_err_                        000014 constant        entry                    external dcl 160 ref 197 207 607 1075 1083 1092
comment                         000710 automatic       bit(1)                   dcl 79 set ref 314* 446 448* 537* 881 1059
condsw                          000700 automatic       bit(1)                   dcl 79 set ref 314* 570 574* 603 611* 624 648* 653
                                                                                  659* 676* 706
copy_this_comment_unchanged     000110 automatic       bit(1)                   unaligned dcl 76 set ref 311* 449 449* 472 538* 541
                                                                                  547*
cpy                             004540 constant        label                    dcl 883 ref 407 418 470 868 874 949
cu_$arg_count                   000020 constant        entry                    external dcl 160 ref 195
cu_$arg_ptr                     000016 constant        entry                    external dcl 160 ref 203
cv_dec_check_                   000010 constant        entry                    external dcl 160 ref 214
cv_dec_error                    001214 constant        label                    dcl 220 ref 232 243
dclfnd                          000676 automatic       bit(1)                   dcl 79 set ref 411* 627* 633* 895 896*
dclind                          000720 automatic       fixed bin(17,0)          dcl 79 set ref 629* 635* 898 899 900 901 901 903 912
                                                                                  928 934 937
dclsw                           000677 automatic       bit(1)                   dcl 79 set ref 314* 897* 905 1019* 1019
dent                            000717 automatic       fixed bin(17,0)          dcl 79 set ref 410* 613* 613 663 665* 940 942* 942
                                                                                  1016
divide                                                 builtin function         dcl 189 ref 248 249 367 967 967 997
dn                              000235 automatic       char(168)                dcl 79 set ref 342 342 344* 352* 374 374 1079*
ec                              000341 automatic       fixed bin(35,0)          initial dcl 79 set ref 79* 203* 205 207* 214* 218
                                                                                  220* 230 241 267* 283* 292* 342* 343 344* 347 352*
                                                                                  354 372* 374* 375 1068* 1071* 1079* 1081* 1082
                                                                                  1083* 1087* 1088* 1089* 1092*
else_ok                         000703 automatic       bit(1)                   dcl 79 set ref 314* 575* 644 647* 848*
en                              000307 automatic       char(32)                 dcl 79 set ref 213* 214* 342 342 344* 348 351* 352*
                                                                                  369 374 374 395* 437* 520* 580* 607* 664* 719*
                                                                                  765* 794* 1031* 1046* 1052* 1056* 1060* 1064*
                                                                                  1079* 1083*
end_count                       000672 automatic       fixed bin(17,0)          dcl 79 set ref 410* 655* 655 663 665* 940 941* 941
                                                                                  943 1016
eof                             005361 constant        label                    dcl 1043 ref 381
err_msg                         002744 automatic       varying char(100)        dcl 182 set ref 206* 207* 219* 231* 242* 291* 297*
error                           006015 constant        label                    dcl 1092 ref 343 346 347 354 358 373 375
error1                          005713 constant        label                    dcl 1083 ref 1080
error_occurred                  002743 automatic       bit(1)                   initial dcl 176 set ref 176* 396* 441* 521* 582*
                                                                                  666* 749* 767* 796* 1047* 1053* 1057* 1061* 1065*
                                                                                  1073
error_table_$bad_arg            000042 external static fixed bin(35,0)          dcl 184 ref 283
error_table_$badopt             000044 external static fixed bin(35,0)          dcl 185 ref 267
error_table_$noarg              000046 external static fixed bin(35,0)          dcl 186 ref 292
error_table_$noentry            000050 external static fixed bin(35,0)          dcl 187 ref 347 354
expand_path_                    000022 constant        entry                    external dcl 160 ref 342 374
expecting                       000335 automatic       fixed bin(17,0)          initial dcl 79 set ref 79* 211 216 217* 228 229*
                                                                                  240* 259* 260* 261* 262* 263* 264* 265* 296
false                                  constant        bit(1)                   initial dcl 79 ref 311 314 411 425 448 449 569 574
                                                                                  578 611 612 647 801 848 873 890 896 898
finish_line                     005252 constant        label                    dcl 1023 ref 885
fixed                                                  builtin function         dcl 189 ref 486
get_pdir_                       000036 constant        entry                    external dcl 160 ref 372
good_suffix                     001600 constant        label                    dcl 339 ref 327
havcom                          005111 constant        label                    dcl 983 ref 979 980
hcs_$delentry_seg               000024 constant        entry                    external dcl 160 ref 1089
hcs_$initiate_count             000034 constant        entry                    external dcl 160 ref 344 352
hcs_$make_seg                   000032 constant        entry                    external dcl 160 ref 372 1079
hcs_$set_bc_seg                 000040 constant        entry                    external dcl 160 ref 1071 1087
hcs_$terminate_noname           000030 constant        entry                    external dcl 160 ref 1068 1088
hcs_$truncate_seg               000026 constant        entry                    external dcl 160 ref 1081
i                               000735 automatic       fixed bin(24,0)          dcl 79 set ref 214* 223 224 225 234 235 236 245 246
                                                                                  247 320* 321 321 322 322 348* 351 370* 371 382*
                                                                                  383 383* 384 392 394* 401 419* 421* 422 431 447
                                                                                  453 453 453* 456 456 456 460 461* 461 464 477* 481
                                                                                  481 482* 483* 483 495 497 499 500 500 501* 506 507
                                                                                  507 508* 508 509* 513 513 513* 514 514 514 516 516
                                                                                  516 525 525 525 527 527 527 529 531 531 531* 532
                                                                                  532 532 535 538 538 542 542 542* 543 543 543 547
                                                                                  551 553 554 554 555* 556* 556 564 565 565 565 586
                                                                                  586 586 589 589 590 590 590 598 598 598 598 600*
                                                                                  600 619 619 620 621* 621 625 626 628* 628 632 634*
                                                                                  634 643 643 644 650* 650 654 668* 668 674 674 674
                                                                                  674 678* 678 685 685 686 686 686 686 689* 689 697
                                                                                  697 697 697 700* 700 708 708 709 711 712* 712 719
                                                                                  719 765 765 794 794 855* 855 858 862* 878* 956*
                                                                                  957 984 986 989* 989 996 996* 996 1010 1012 1026*
                                                                                  1027 1028 1028* 1029* 1029 1036 1038 1105 1105*
                                                                                  1105 1117 1117* 1117 1118 1118* 1118
icb                             000352 automatic       fixed bin(17,0)          dcl 79 set ref 410* 553* 871 881 957 982 984
ice                             000353 automatic       fixed bin(17,0)          dcl 79 set ref 410* 460* 881 979 979 980 980 982
icol                            000354 automatic       fixed bin(17,0)          dcl 79 set ref 410* 564* 893* 899* 906* 949 951 952
                                                                                  952 953 954 956 957 959 960* 960 964 967
if_count                        000673 automatic       fixed bin(17,0)          dcl 79 set ref 313* 571 572* 573* 601* 601 604 645*
                                                                                  648 660* 661* 661 690* 690 1017
ifdent                          000732 automatic       fixed bin(17,0)          dcl 79 set ref 313* 646* 943 1017* 1018* 1018
ifsw                            000701 automatic       bit(1)                   dcl 79 set ref 314* 578* 601 602 612* 658* 661 677*
                                                                                  684 1018
ilchr                           004304 constant        label                    dcl 719 ref 487 488
in                              000716 automatic       fixed bin(17,0)          dcl 79 set ref 313* 663 665* 943 1016* 1016 1043
                                                                                  1043 1046*
in_found                        003520 constant        label                    dcl 601 ref 622 713
in_suffix                       001565 constant        label                    dcl 333 ref 321
inb                             006041 constant        entry                    internal dcl 1099 ref 453 456 513 527 531 532 542
                                                                                  543 551 565 586 590
ind                             001001 constant        entry                    external dcl 41
indent                          000337 automatic       fixed bin(17,0)          dcl 79 in procedure "ind" set ref 892* 900* 901*
                                                                                  903* 912* 928* 934* 937* 943* 944 944* 957 964
indent                          001011 constant        entry                    external dcl 41
index                                                  builtin function         dcl 189 ref 320 382 417 453 456 481 507 513 514 543
                                                                                  554 565 589 898 907 910 923 926
ioa_                            000012 constant        entry                    external dcl 160 ref 395 437 520 580 664 719 765 794
                                                                                  1031 1046 1052 1056 1060 1064
ix                                     parameter       fixed bin(24,0)          dcl 1100 in procedure "inb" ref 1099 1101 1101 1101
                                                                                  1102 1102 1102 1103 1105
ix                                     parameter       fixed bin(24,0)          dcl 1111 in procedure "outb" ref 1110 1114 1114 1114
                                                                                  1115 1115 1115 1117 1118
j                               000736 automatic       fixed bin(24,0)          dcl 79 set ref 323* 324 326*
k                               000737 automatic       fixed bin(24,0)          dcl 79 set ref 392* 393 394* 398 399 402 465* 466
                                                                                  474 474 474 476 476 478 486* 487 488 489 500* 501
                                                                                  501* 707* 710* 712 909* 911* 911 912 912 923* 924
                                                                                  927* 927 928 928 940* 941 942 964* 965 971* 974
                                                                                  975 976 984* 985 986 986 987 988 989 1004* 1005
                                                                                  1006 1007 1010* 1011 1012 1012 1013
kk                              000740 automatic       fixed bin(24,0)          dcl 79 set ref 417* 418 419 481* 482 483 507* 508
                                                                                  508 554* 555 556 619* 620 626 632 643* 644 654
                                                                                  708* 709 711 907* 908 909 910* 911 911 926* 927
                                                                                  927 967* 968 969 969 970
l2e                             004457 constant        label                    dcl 855 ref 444 462 484 503 557 566 585 651 691 750
                                                                                  769 849
l2s                             002372 constant        label                    dcl 422 ref 858
lemp                            002334 constant        label                    dcl 406 ref 403
length                                                 builtin function         dcl 189 ref 538 538 538 538 543 543
line_offset                     000344 automatic       fixed bin(24,0)          dcl 79 set ref 400* 431 506
linno                           000336 automatic       fixed bin(17,0)          dcl 79 set ref 317* 387* 387 395* 437* 520* 580*
                                                                                  607* 664* 719* 765* 794* 1023* 1023 1031
loop                            002200 constant        label                    dcl 380 ref 390 1025 1027 1034 1039
lth                             000667 automatic       fixed bin(24,0)          dcl 79 set ref 344* 352* 367* 367 381 382 383 398
                                                                                  1070* 1071* 1087*
lth1                            000670 automatic       fixed bin(17,0)          dcl 79 set ref 201* 273 275* 290 303 320 322 335
                                                                                  336* 336 342* 356
lth2                            000671 automatic       fixed bin(17,0)          dcl 79 set ref 201* 277 279* 301 303* 361 362 364
                                                                                  365* 365 374*
m                               000741 automatic       fixed bin(24,0)          dcl 79 set ref 588* 589* 590 590 590
min                                                    builtin function         dcl 189 ref 940
mod                                                    builtin function         dcl 189 ref 971
moveseg                                based           char                     dcl 180 set ref 1086* 1086
n                               000666 automatic       fixed bin(17,0)          dcl 79 set ref 402* 403 417 456 465 469* 474 474 476
                                                                                  476 478* 478 481 482 500 507 509 514 527 532 538
                                                                                  543 554 555 565 586 598 598 619 643 674 674 686
                                                                                  686 697 697 708 858 864 865* 883 883 884 949 979
                                                                                  980 980 1010 1101 1101 1102 1102 1104* 1104 1114
                                                                                  1114 1115 1115 1116* 1116
n1                              000111 automatic       char(168)                dcl 79 set ref 274* 302 320 322 335* 342 342 356*
                                                                                  1092*
n2                              000163 automatic       char(168)                dcl 79 set ref 278* 302* 362 364* 374 374
nargs                           000334 automatic       fixed bin(17,0)          dcl 79 set ref 195* 196 202
newpage                         000711 automatic       bit(1)                   dcl 79 set ref 411* 853* 863
nif                             000742 automatic       fixed bin(33,0)          array level 2 packed unaligned dcl 137 set ref 573
                                                                                  604* 660
nimcom                          005166 constant        label                    dcl 998 ref 879
nn                                     parameter       fixed bin(24,0)          dcl 1112 ref 1110 1114 1114 1114 1115 1115 1116 1118
noarg_err                       001447 constant        label                    dcl 292 ref 298
nout                            000726 automatic       fixed bin(24,0)          dcl 79 set ref 318* 385 386* 386 883 884* 884 952
                                                                                  953* 953 962* 962 969 970* 970 975 976* 976 986
                                                                                  987* 987 992 993* 993 999 1000* 1000 1006 1007*
                                                                                  1007 1012 1013* 1013 1025 1026 1028 1036* 1036
                                                                                  1037 1038 1070 1086 1086
ntab                            000340 automatic       fixed bin(17,0)          dcl 79 set ref 877* 997* 998 999 999 1000
null                                                   builtin function         dcl 189 ref 345 353 373 1080
nxchr                           004452 constant        label                    dcl 801 ref 515 560 595 597 615 616 618 624 630 636
                                                                                  639 640 642 653 670 671 673 680 681 683 684 685
                                                                                  693 694 696 702 703 705 706 715
offset                          000342 automatic       fixed bin(24,0)          dcl 79 set ref 318* 381 382 383 388* 388 398 400
                                                                                  401* 401
old_if_count                    000674 automatic       fixed bin(17,0)          dcl 79 set ref 313* 571* 577* 645 646
out_suffix                      002040 constant        label                    dcl 364 ref 361
outb                            006066 constant        entry                    internal dcl 1110 ref 501 514 516 525
output_path_given               002742 automatic       bit(1)                   initial dcl 176 set ref 176* 280* 1073
p                               000346 automatic       pointer                  dcl 79 set ref 344* 345 352* 353 382 398 1068* 1079*
                                                                                  1080 1081* 1086 1087* 1088*
p1                              000350 automatic       pointer                  dcl 79 set ref 372* 373 385 883 952 969 975 986 992
                                                                                  999 1006 1012 1026 1037 1038 1071* 1086 1089*
parct                           000730 automatic       fixed bin(17,0)          initial dcl 79 set ref 79* 511* 511 518* 518 519
                                                                                  522* 560 579 580* 583* 597 616 640 671 681 696 703
                                                                                  1063 1064*
pdl                             000742 automatic       structure                array level 1 dcl 137
pdlx                            000731 automatic       fixed bin(17,0)          dcl 79 set ref 316* 572 573 602 603 604 605* 605 606
                                                                                  656 657* 657 658 659 660
print_bad_arg                   001110 constant        label                    dcl 206 ref 268 284
procfnd                         004300 constant        label                    dcl 712 ref 709
pstring                         000713 automatic       bit(1)                   dcl 79 set ref 314* 380* 404 416 891
push                            004521 constant        label                    dcl 876 ref 882
rd_source_sw                    000107 automatic       bit(1)                   unaligned dcl 76 set ref 311* 339* 543 1043 1050
reverse                                                builtin function         dcl 189 ref 320 348 370 1026
scolsw                          000675 automatic       bit(1)                   dcl 79 set ref 411* 567* 1019
search                                                 builtin function         dcl 189 ref 598 619 643 674 686 697 708
sixty                           000705 automatic       bit(1)                   dcl 79 set ref 314* 873* 876* 882 983*
squidge                         002655 constant        label                    dcl 500 ref 497
string                          000712 automatic       bit(1)                   dcl 79 set ref 314* 380 423 425* 504* 1030 1055
string_error                    000715 automatic       bit(1)                   initial dcl 79 set ref 79* 432 440*
string_len                      000345 automatic       fixed bin(17,0)          dcl 79 set ref 431* 432 437*
string_offset                   000343 automatic       fixed bin(24,0)          dcl 79 set ref 431 506*
strut                           000704 automatic       bit(1)                   dcl 79 set ref 314* 898* 898* 900 908 921
substr                                                 builtin function         dcl 189 set ref 256 320 322 335* 351* 351 356* 356
                                                                                  362 362 364* 364 371* 382 385* 398 399* 404 417
                                                                                  422 447 453 456 465 468* 474* 474 475* 476* 476
                                                                                  481 495* 499 500 507 513 514 516 525 527 529 531
                                                                                  532 535 538 542 543 547 554 565 586 589 590 598
                                                                                  598 619 620 626 632 643 644 654 674 674 685 686
                                                                                  686 697 697 708 709 711 719 719 765 765 794 794
                                                                                  864 866 883* 883 898 901 907 910 919 923 926 952*
                                                                                  952 959 969* 969 975* 980 986* 986 992 996 999*
                                                                                  999 1006* 1012* 1012 1026 1037* 1038 1101* 1101
                                                                                  1102* 1102 1103* 1114* 1114 1115* 1115
suffix                          000733 automatic       char(4)                  unaligned dcl 79 set ref 322* 324 333* 335 339 349*
                                                                                  351 356 362 364
suffix_assumed                  000734 automatic       bit(1)                   initial unaligned dcl 79 set ref 79* 337* 346
suffix_len                      000106 automatic       fixed bin(17,0)          dcl 72 set ref 326* 334* 335 336 348 350* 351 351
                                                                                  356 356 356 362 362 362 364 364 365 370
suffix_lengths                  000103 automatic       fixed bin(17,0)          initial array dcl 72 set ref 72* 72* 72* 326
suffixes                        000100 automatic       char(4)                  initial array unaligned dcl 72 set ref 72* 72* 72*
                                                                                  324
sw                        0(35) 000742 automatic       bit(1)                   array level 2 packed unaligned dcl 137 set ref 602*
                                                                                  658
swc                       0(34) 000742 automatic       bit(1)                   array level 2 packed unaligned dcl 137 set ref 603*
                                                                                  659
temchars                        000521 automatic       char(400)                unaligned dcl 79 set ref 474* 476 1101* 1102 1114*
                                                                                  1115
temp_en                         000317 automatic       char(32)                 dcl 79 set ref 369* 370 371* 372* 1075* 1083*
true                                   constant        bit(1)                   initial dcl 79 ref 257 258 315 389 406 504 537 538
                                                                                  547 563 567 575 627 633 648 649 676 677 688 699
                                                                                  867 876 897 898 983
unspec                                                 builtin function         dcl 189 set ref 486 719 719 1038*
verify                                                 builtin function         dcl 189 ref 348 370 465 500 864 1026

STORAGE REQUIREMENTS FOR THIS PROGRAM.

	Object	Text	Link	Symbol	Defs	Static
Start          0       0      7416        7470    7211        7426
Length      7706    7211        52         202     205           0

BLOCK NAME	         STACK SIZE     TYPE		WHY NONQUICK/WHO SHARES STACK FRAME
ind                                1682 external procedure  is an external procedure.  
inb                                     internal procedure  shares stack frame of external procedure ind.  
outb                                    internal procedure  shares stack frame of external procedure ind.  

STORAGE FOR AUTOMATIC VARIABLES.

STACK FRAME                 LOC IDENTIFIER                  BLOCK NAME
ind                      000100 suffixes                    ind
                         000103 suffix_lengths              ind
                         000106 suffix_len                  ind
                         000107 rd_source_sw                ind
                         000110 copy_this_comment_unchanged ind
                         000111 n1                          ind
                         000163 n2                          ind
                         000235 dn                          ind
                         000307 en                          ind
                         000317 temp_en                     ind
                         000330 ap                          ind
                         000332 al                          ind
                         000333 an                          ind
                         000334 nargs                       ind
                         000335 expecting                   ind
                         000336 linno                       ind
                         000337 indent                      ind
                         000340 ntab                        ind
                         000341 ec                          ind
                         000342 offset                      ind
                         000343 string_offset               ind
                         000344 line_offset                 ind
                         000345 string_len                  ind
                         000346 p                           ind
                         000350 p1                          ind
                         000352 icb                         ind
                         000353 ice                         ind
                         000354 icol                        ind
                         000355 chars                       ind
                         000521 temchars                    ind
                         000665 char                        ind
                         000666 n                           ind
                         000667 lth                         ind
                         000670 lth1                        ind
                         000671 lth2                        ind
                         000672 end_count                   ind
                         000673 if_count                    ind
                         000674 old_if_count                ind
                         000675 scolsw                      ind
                         000676 dclfnd                      ind
                         000677 dclsw                       ind
                         000700 condsw                      ind
                         000701 ifsw                        ind
                         000702 begin_ok                    ind
                         000703 else_ok                     ind
                         000704 strut                       ind
                         000705 sixty                       ind
                         000706 bos                         ind
                         000707 blsw                        ind
                         000710 comment                     ind
                         000711 newpage                     ind
                         000712 string                      ind
                         000713 pstring                     ind
                         000714 bfsw                        ind
                         000715 string_error                ind
                         000716 in                          ind
                         000717 dent                        ind
                         000720 dclind                      ind
                         000721 LMARGIN                     ind
                         000722 IN                          ind
                         000723 CMC                         ind
                         000724 TABCOL                      ind
                         000725 NTAB                        ind
                         000726 nout                        ind
                         000727 colpos                      ind
                         000730 parct                       ind
                         000731 pdlx                        ind
                         000732 ifdent                      ind
                         000733 suffix                      ind
                         000734 suffix_assumed              ind
                         000735 i                           ind
                         000736 j                           ind
                         000737 k                           ind
                         000740 kk                          ind
                         000741 m                           ind
                         000742 pdl                         ind
                         002742 output_path_given           ind
                         002743 error_occurred              ind
                         002744 err_msg                     ind

THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM.
call_ext_out_desc   call_ext_out        return              mod_fx1             ext_entry

THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM.
com_err_                      cu_$arg_count                 cu_$arg_ptr                   cv_dec_check_
expand_path_                  get_pdir_                     hcs_$delentry_seg             hcs_$initiate_count
hcs_$make_seg                 hcs_$set_bc_seg               hcs_$terminate_noname         hcs_$truncate_seg
ioa_

THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM.
error_table_$bad_arg          error_table_$badopt           error_table_$noarg            error_table_$noentry




   LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC   
     72 000723        79 000754       176 000774        41 001000       195 001017       196 001026       197 001030
    198 001057       201 001060       202 001062       203 001071       205 001106       206 001110       207 001114
    208 001146       211 001147       213 001151       214 001156       216 001201       217 001204       218 001205
    219 001207       220 001214       221 001215       223 001216       224 001221       225 001223       226 001224
    228 001225       229 001227       230 001230       231 001232       232 001237       234 001240       235 001242
    236 001244       237 001245       240 001246       241 001247       242 001251       243 001256       245 001257
    246 001262       247 001264       248 001265       249 001271       252 001273       256 001274       257 001301
    258 001311       259 001320       260 001327       261 001336       262 001345       263 001354       264 001363
    265 001372       267 001401       268 001404       270 001405       273 001406       274 001410       275 001414
    276 001416       277 001417       278 001421       279 001425       280 001427       281 001431       283 001432
    284 001435       288 001436       290 001440       291 001442       292 001447       293 001452       296 001453
    297 001455       298 001462       301 001463       302 001465       303 001470       311 001472       313 001475
    314 001501       315 001513       316 001516       317 001520       318 001521       320 001524       321 001536
    322 001541       323 001547       324 001555       326 001560       327 001562       329 001563       333 001565
    334 001567       335 001571       336 001575       337 001576       339 001600       342 001607       343 001634
    344 001636       345 001700       346 001704       347 001706       348 001712       349 001730       350 001732
    351 001734       352 001740       353 002001       354 002005       356 002011       358 002022       361 002023
    362 002026       364 002040       365 002045       367 002047       369 002053       370 002056       371 002074
    372 002077       373 002145       374 002151       375 002176       380 002200       381 002202       382 002205
    383 002224       384 002232       385 002234       386 002241       387 002242       388 002243       389 002244
    390 002246       392 002247       393 002251       394 002253       395 002256       396 002302       398 002304
    399 002312       400 002315       401 002317       402 002321       403 002324       404 002326       406 002334
    407 002336       410 002337       411 002344       416 002350       417 002352       418 002365       419 002366
    420 002367       421 002370       422 002372       423 002377       424 002401       425 002404       431 002405
    432 002412       437 002420       440 002447       441 002451       444 002452       446 002453       447 002455
    448 002462       449 002463       453 002467       456 002504       460 002527       461 002531       462 002532
    464 002533       465 002535       466 002550       467 002552       468 002555       469 002557       470 002561
    472 002562       474 002564       475 002572       476 002574       477 002577       478 002601       481 002605
    482 002621       483 002626       484 002631       486 002632       487 002635       488 002637       489 002641
    495 002642       497 002646       499 002651       500 002655       501 002671       503 002674       504 002675
    506 002677       507 002702       508 002716       509 002723       510 002726       511 002727       513 002730
    514 002746       515 002773       516 002774       518 003011       519 003013       520 003015       521 003041
    522 003043       524 003044       525 003045       527 003062       528 003100       529 003101       531 003106
    532 003117       534 003135       535 003136       537 003143       538 003145       541 003160       542 003162
    543 003173       547 003221       551 003231       553 003235       554 003237       555 003254       556 003261
    557 003262       559 003263       560 003264       562 003266       563 003270       564 003272       565 003275
    566 003320       567 003321       569 003324       570 003325       571 003327       572 003331       573 003336
    574 003341       575 003342       576 003344       577 003345       578 003346       579 003347       580 003351
    582 003400       583 003402       585 003403       586 003404       588 003422       589 003424       590 003442
    591 003460       595 003461       597 003465       598 003467       600 003516       601 003520       602 003524
    603 003531       604 003536       605 003543       606 003544       607 003547       609 003606       611 003607
    612 003610       613 003611       615 003612       616 003613       618 003615       619 003617       620 003635
    621 003643       622 003644       624 003645       625 003647       626 003652       627 003662       628 003664
    629 003666       630 003670       632 003671       633 003700       634 003702       635 003704       636 003706
    639 003707       640 003710       642 003712       643 003714       644 003732       645 003743       646 003746
    647 003751       648 003752       649 003756       650 003760       651 003762       653 003763       654 003765
    655 003775       656 003776       657 004001       658 004003       659 004007       660 004013       661 004016
    663 004021       664 004025       665 004051       666 004054       668 004056       670 004060       671 004061
    673 004063       674 004065       676 004114       677 004116       678 004117       680 004120       681 004121
    683 004123       684 004125       685 004127       686 004136       688 004165       689 004167       690 004171
    691 004172       693 004173       694 004174       696 004176       697 004200       699 004227       700 004231
    702 004232       703 004233       705 004235       706 004237       707 004241       708 004243       709 004261
    710 004267       711 004271       712 004300       713 004302       715 004303       719 004304       749 004342
    750 004344       752 004345       765 004347       767 004404       769 004406       773 004407       794 004413
    796 004450       801 004452       848 004453       849 004454       853 004455       855 004457       858 004460
    862 004463       863 004465       864 004467       865 004502       866 004504       867 004507       868 004511
    871 004512       872 004515       873 004517       874 004520       876 004521       877 004523       878 004525
    879 004527       881 004530       882 004536       883 004540       884 004546       885 004550       890 004551
    891 004552       892 004554       893 004555       894 004556       895 004557       896 004561       897 004562
    898 004564       898 004603       899 004604       900 004606       901 004613       903 004621       904 004623
    905 004624       906 004626       907 004627       908 004637       909 004643       910 004644       911 004654
    912 004661       913 004666       919 004667       921 004673       923 004675       924 004705       926 004706
    927 004716       928 004723       933 004730       934 004731       935 004734       937 004735       938 004740
    940 004741       941 004746       942 004750       943 004752       944 004761       949 004763       950 004766
    951 004767       952 004771       953 004776       954 004777       956 005000       957 005002       959 005007
    960 005014       961 005016       962 005020       964 005022       965 005026       966 005027       967 005032
    968 005041       969 005042       970 005047       971 005050       974 005054       975 005056       976 005063
    979 005064       980 005072       982 005105       983 005111       984 005113       985 005116       986 005117
    987 005131       988 005133       989 005134       991 005135       992 005140       993 005146       994 005150
    996 005152       997 005160       998 005166       999 005170      1000 005175      1002 005176      1004 005200
   1005 005204      1006 005205      1007 005212      1010 005213      1011 005217      1012 005220      1013 005232
   1016 005234      1017 005240      1018 005242      1019 005247      1023 005252      1025 005253      1026 005256
   1027 005273      1028 005275      1029 005303      1030 005305      1031 005307      1034 005340      1036 005341
   1037 005343      1038 005347      1039 005360      1043 005361      1046 005367      1047 005413      1049 005415
   1050 005416      1052 005420      1053 005440      1055 005442      1056 005444      1057 005464      1059 005466
   1060 005470      1061 005510      1063 005512      1064 005514      1065 005540      1068 005542      1070 005553
   1071 005557      1073 005572      1075 005576      1076 005631      1079 005632      1080 005671      1081 005675
   1082 005711      1083 005713      1084 005750      1086 005751      1087 005757      1088 005772      1089 006003
   1090 006014      1092 006015      1093 006040      1099 006041      1101 006043      1102 006052      1103 006055
   1104 006060      1105 006061      1106 006065      1110 006066      1114 006070      1115 006102      1116 006106
   1117 006110      1118 006116      1119 006121


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


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