1 /* BEGIN INCLUDE FILE gcos_canonicalizer.incl.pl1   (Wardd Multics)  06/21/81 1435.3 mst Sun */
  2 canonicalizer: proc (
  3                input_string_ptr
  4                , initial_input_characters
  5                , output_card_ptr
  6                , initial_output_columns
  7                );
  8 
  9 /* NOTE: a copy of this internal procedure exists also in gcos_card_utility_.
 10    The initialization is different, but the canonicalization code is the same.
 11    Any changes should be made to both copies, if appropriate.
 12 */
 13 dcl  initial_input_characters fixed bin(21) parm;
 14 dcl  initial_output_columns   fixed bin(24)parm;
 15 dcl  input_string_ptr         ptr parm;
 16 dcl  output_card_ptr          ptr parm;
 17           next_input_character, next_output_column = 1;
 18           remaining_input_characters = initial_input_characters;
 19           remaining_output_columns = initial_output_columns;
 20           more_backspaces, more_tabs = "1"b;                /* we want to look for backspaces and tabs at the start */
 21           if substr (input_string, remaining_input_characters, 1) = ascii_newline /* if last char is a newline */
 22           then remaining_input_characters = remaining_input_characters - 1; /* then get rid of it */
 23 
 24 
 25 /* choose the set of tabs to use for this card */
 26           if substr (input_string, 1, 1) = "$" then
 27                if length (input_string)>1 then
 28                     if (substr (input_string, 2, 1) = TAB) | (substr (input_string, 2, 1) = SP) then do;
 29                          tab_ptr = addr (tab (0));
 30                          goto selected;
 31                     end;
 32           tab_ptr = addr (tab (nondollar_canon_index));     /* tabs for the nondollar cards in this activity */
 33 selected: ;
 34 
 35 /*     MAIN LOOP. FILL UP OUTPUT CARD */
 36 
 37           do while (remaining_output_columns > 0);          /* keep going while there is any room on output card */
 38                if more_backspaces then do;                  /* if there MIGHT be more backspaces */
 39                                                             /* then look for one */
 40 
 41                     next_backspace = index (substr (input_string, next_input_character,
 42                          remaining_input_characters), ascii_backspace);
 43                     if next_backspace = 0 then more_backspaces = "0"b; /* if none found, remember not to look again */
 44                end;
 45 
 46                if more_tabs then                            /* if there MIGHT be more tabs */
 47 find_next_tab:      do;                                     /* then look for one */
 48                     next_tab = index (substr (input_string, next_input_character,
 49                          remaining_input_characters), TAB);
 50                     if next_tab = 0 then more_tabs = "0"b;  /* if none found, remember not to look again */
 51                end;
 52 
 53                if more_backspaces then do;                  /* if we found a backspace */
 54                                                             /* see if it is in a legal position */
 55                                                             /* maybe sometime allow backspaces to be in places other than
 56                                                                immediately following tabs, but for now, it's an error */
 57                     if ^more_tabs | next_backspace ^= next_tab+1 then do;
 58                          code = 0;
 59                          err_msg = "canonicalizer: backspace (s) not following a tab in line from ^a:^/" || input_string;
 60                          goto file_error;
 61                     end;
 62 
 63                end;
 64 
 65                if more_tabs then do;                        /* if we found a tab, we want to move the characters before it */
 66                                                             /* to the output card, and fill with blanks to next tab stop */
 67                     character_count = min (                 /* compute the number of characters */
 68                          next_tab - 1,                      /* before the tab */
 69                          remaining_output_columns);         /* but not more than there's room for on output card */
 70 
 71                     first_blank = next_output_column + character_count;
 72 
 73                     do i = 1 to hbound (tabstop, 1)         /* look for a tabstop */
 74                               while (tabstop (i) <= first_blank); /* that's past the characters */
 75                                                             /* if it's in the column immediately after the characters,
 76                                                                then go to next one, the way a typewriter will */
 77                     end;
 78 
 79                     if i <= hbound (tabstop, 1) then        /* if we found one */
 80                          blank_count = min (                /* compute the number of blanks */
 81                          tabstop (i) - first_blank,         /* needed to get there */
 82                          remaining_output_columns);         /* but not more than there's room for on output card */
 83                     else                                    /* if no more tabstops, replace tab with one blank */
 84                     blank_count = min (1, remaining_output_columns);
 85                end;
 86                else do;
 87                                                             /* if there are no more tabs,
 88                                                                we want to move the rest of the input characters
 89                                                                to the output card, and fill the rest of it with blanks */
 90 
 91                     character_count = min (                 /* compute rest of characters to move */
 92                          remaining_input_characters,        /* all the rest, since no more tabs */
 93                          remaining_output_columns);         /* but not more than there's room for on output card */
 94 
 95                     blank_count = max (0,                   /* compute blanks needed to fill rest of card */
 96                          remaining_output_columns - remaining_input_characters);
 97                end;
 98 
 99                if character_count > 0 then do;              /* move characters to output card, if there are any */
100                     substr (output_card, next_output_column, character_count) =
101                          substr (input_string, next_input_character, character_count);
102                     remaining_input_characters = remaining_input_characters - character_count;
103                     next_input_character = next_input_character + character_count;
104                     remaining_output_columns = remaining_output_columns - character_count;
105                     next_output_column = next_output_column + character_count;
106                end;
107 
108                if blank_count > 0 then do;                  /* fill with blanks, if any */
109                     substr (output_card, next_output_column, blank_count) = "";
110                     remaining_output_columns = remaining_output_columns - blank_count;
111                     next_output_column = next_output_column + blank_count;
112                end;
113 
114                if more_tabs then do;                        /* move past tab in input string */
115                     remaining_input_characters = remaining_input_characters - 1;
116                     next_input_character = next_input_character + 1;
117                end;
118 
119                if more_backspaces then do;
120                                                             /* if we found a backspace, we will:
121                                                                1) see if there's more than one of them, and
122                                                                2) move back that many columns, deleting whatever is there,
123                                                                (probably only blanks ) */
124 
125                     do i = next_input_character to initial_input_characters
126                               while (substr (input_string, i, 1) = ascii_backspace);
127                     end;
128                     character_count = i - next_input_character; /* count backspace characters */
129                     backspace_count = min (character_count, /* count columns to backspace */
130                          next_output_column - 1);           /* but don't backspace past beginning of card */
131 
132 
133 /* skip over input backspace characters */
134                     remaining_input_characters = remaining_input_characters - character_count;
135                     next_input_character = next_input_character + character_count;
136 
137 /* backspace on output card */
138                     remaining_output_columns = remaining_output_columns + backspace_count;
139                     next_output_column = next_output_column - backspace_count;
140 
141                end;
142           end;
143 
144 /*     WE FALL THRU HERE WHEN remaining_output_columns BECOMES ZERO */
145 
146           if remaining_input_characters > 0 then            /* if input left over */
147                if ^gcos_ext_stat_$save_data.truncate then do; /* and -truncate not given, complain */
148 
149                     code = 0;
150                     err_num = initial_input_characters;
151                     err_msg = "line from ^a is too long (^d characters)^/" || input_string;
152                     if ^gcos_ext_stat_$save_data.continue then /* this is a nonfatal error */
153                          goto file_error;
154                     if ^gcos_ext_stat_$save_data.brief then /* complain unless told to be quiet */
155                          call ioa_ (err_msg, current_file.pathname, err_num);
156                end;
157           return;
158 
159 dcl  backspace_count          fixed bin(24);
160 dcl  blank_count              fixed bin(24);
161 dcl  character_count          fixed bin(24);
162 dcl  first_blank              fixed bin(24);
163 dcl  input_string             char (initial_input_characters) based (input_string_ptr);
164 dcl  more_backspaces          bit(1) aligned;
165 dcl  more_tabs                bit(1)aligned;
166 dcl  next_backspace           fixed bin(24)                           /* relative to next_input_character */;
167 dcl  next_input_character     fixed bin(24);
168 dcl  next_output_column       fixed bin(24);
169 dcl  next_tab                 fixed bin(24)                                     /* relative to next_input_character */;
170 dcl  output_card              char (initial_output_columns) based (output_card_ptr);
171 dcl  remaining_input_characters fixed bin(24);
172 dcl  remaining_output_columns fixed bin(24);
173 dcl  SP                       char(1)static int options(constant)init(" ");
174 dcl  TAB                      char(1)static int options(constant)init("         ");
175 dcl  tabstop                  (10) fixed bin(24)based (tab_ptr);
176 dcl  tab_ptr                  ptr;
177      end canonicalizer;
178 
179 /*   END INCLUDE FILE gcos_canonicalizer.incl.pl1 */