PROGRAM  prxfmt;
{$C	.IDENT	/X1.5/
}
{ 
 
  WRITTEN BY D.B.CURTIS
  SOFTWARE SUPPORT GROUP (R.S.)
  01-MAR-80
  FERMILAB
 
 
   VERSION X1.5
  EDIT NUMBER = 0013
  FILE = PRXFMT.PAS
  EDITED BY: D.B.CURTIS  9 APR 80  23:28
 
 
  MODIFICATIONS:
 
}
{+
  FILE DESCRIPTION
 
 	This program formats PRAXIS source code.
 	It provides the ability to do the following:
 		1) causing reserved PRAXIS words to be capitalized,
 			lower casing other words.
 			except in literals or comments
 		2) indenting and checking block constructs
 		3) two versions of formatting:
 			1) normal - does a minimal line formatting
 			2) special- does more
 	
 	the program produces a listing output and a source output.
 	blocking errors are displayed on the terminal, and in the
 	listing file.
 	
 	Tabs are inserted whereever possible but not in comment statements
 	(watch out for literals)
 	
 	lines are currently not split up or merged.
 	
-}
 
 
CONST
  pagelength = 50;
  ff = 14B;
  tab = 11B;
  space = 40B;
  declarei = 11;
  codei = 10;
  endcodei = 19;
  functioni = 47;
  procedurei = 71;
  fori = 43;
  fromi = 46;
  selecti = 83;
  endselecti = 29;
  whilei = 97;
  composition = 50;		{ leftmost position of in-block comment}
  numfmtsym = 16;		{ number of symbols that need special format}
  lineleng = 200;		{ lines are 200 characters long }
  linearrayleng = 201;		{ the character array for lines is 201 char long}
  numberkey = 100;		{ praxis has 100 key words}

TYPE
  brktyp = (nopren,matched,odd); { shows if a line has brackits () }
  linktype = ^struclevtype;	{ pointer to structure stack element }
  struclevtype = RECORD
		   link: linktype;  { pointer to next or nil }
		   level: integer;  { indent level }
		   line: integer;   { line number of keyword }
		   endid: integer;  { termination id for this  block }
		   id:     integer; { this block's id }
		 END;

  filestrtype = ARRAY [1..9] OF char; {file name type}
  ilevelrange = 0..25;		{ indent level range }
  indentrange = 0..50;		{ number of columns max to indent }
  line = ARRAY [1..linearrayleng] OF char; { lines definition }
  word = ARRAY [1..15] OF char; { words for keys }
  lineindex = 1..lineleng;	{ type for accessing lines }
  lineindent = ( none, inn, out, tempout ); { indent selection options }
{  filetype = FILE OF char; } { for omsi pascel 1.1 only }
  filetype = text;    { for omsi pascel 1.2 and above }

VAR
  temppre: indentrange;	{ one time adjustment to indenting }
  numberlines: integer;	{ number of lines read }
  inputfile: filetype;
  outputfile: filetype;
  listfile: filetype;
  emptyline:line;		{ line of all spaces }
  inputline:line;		{ one of the lines to format on}
  outputline:line;		{ line to be output }
  tempinput:line;		{ temporary line storage }

  formatting, casing, indenting, specialfmt: boolean; { option selection}
  tformatting, tcasing, tindenting: boolean; {temp storage for option selection}
  indentselect: ARRAY [1..numberkey] OF lineindent; { storage for indent control }
  keyword: ARRAY [1..numberkey] OF word; { keyword storage } 
  termcode: ARRAY [1..numberkey] OF integer; { termination ids for block structures }

  outlength  : lineindex;	{ length of line we are working with }
  tempword: word;		{ temporary word for whatever }
  emptyword: word;		{ word of all spaces }

  fmtsym : ARRAY [1..numfmtsym] OF char; { specal characters for formatting }
  filestring,initalfilestring: filestrtype;  { file names }

  pindentlevel: ilevelrange;	{ postponed indent level adjust }
  indentlevel: ilevelrange;	{ current indent level }
  structstk: linktype;		{ header for the structure stack }
  nnew: linktype;		{ temperary for refercing structure stack elements }
  lastcompos: integer;		{ position of last inblock comment }
  pageline: integer;		{ number of lines on a page }
  brakit: brktyp;		{ brackit indicator for a line }
  pagenumber: integer;		{ number of the current page in listing }
  version: word;		{ version of the program }

  FUNCTION alph (i:char):boolean; FORWARD;

  PROCEDURE head;
  BEGIN
    writeln (listfile,'PRXFMT VERSION ',version,'PAGE # ',pagenumber:4);
    writeln (listfile);
    pageline := pageline + 2;
    pagenumber := pagenumber + 1;
  end;

 
{+
   **-init-initalization module
 
  This module initalizes the static variables, format symbol table (FMTSYM)
  the indent control table (INDENTSELECT), the keywords table (KEYWORD)
  the block termination table (TERMCODE).
  It also places an entry on the structure stack(STRUCTSTK).
  
  Finilly, it asks for the desired files and the control features
 
  INPUTS:
 	none
 
  OUTPUTS:
 	none
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	the following are initalized:
 		pageline
 		numberlines
 		indentation variables
 		control variables
 		termcode array
 		fmtsym array
 		keyword array
 		emptyline,initalfilestring,emptyword
 	file opens
 		inputfile
 		outputfile
 		listfile
 	
 
-}
 
  PROCEDURE init ;
  VAR
    filesize: integer;		{ number of blocks in a file }
    i: integer;


     PROCEDURE caps (VAR a: filestrtype);
      var
	i: integer;
      begin
	for i := 1 to 9 do
	  begin
		if alph(a[i]) then a[i] := chr ( ord(a[i]) and 337B);
	  end;
      end;

   BEGIN

     pagenumber := 1;
     version := 'X1.5           ';
     pageline := 0;		{ initalize things }
     pindentlevel := 0;
     numberlines := 0;
     new (nnew);		{ place termination stack element on stack}
     nnew^.link := NIL;
     nnew^.line := 0;
     nnew^.level := 0;
     nnew^.endid := 0;
     nnew^.id := 0;
     structstk := nnew;
     indentlevel := 0;		{ initalize the indent level }

     tcasing := false;		{ initalize processing options }
     tindenting := false;
     tformatting := false;
     specialfmt := false;
     casing := false;
     indenting := false;
     formatting := false;
     temppre := 0;		{ and temporary indent adjust }
     FOR i := 1 TO numberkey DO termcode[i] := 0; { set default termcode }
     FOR i := 1 TO 9 DO initalfilestring[i] := ' '; { spaces in file name }
     FOR i := 1 TO linearrayleng DO emptyline[i] := ' '; { init empty line }
     emptyword := '               ';	{ and empty word }

	{ init fmtsym table}

     fmtsym [1] := ':';              fmtsym [2] := ',';
     fmtsym [3] := '(';              fmtsym [4] := ')';
     fmtsym [5] := '[';              fmtsym [6] := ']';
     fmtsym [7] := '{';              fmtsym [8] := '}';
     fmtsym [9] := '+';              fmtsym [10] := '-';
     fmtsym [11] := '*';	     fmtsym [12] := '/';
     fmtsym [13] := '<';	     fmtsym [14] := '>';
     fmtsym [15] := '=';	     fmtsym [16] := ';';

	{ init keywords and indent control along with termination ids }

     indentselect [1] := none ;     keyword [1] := 'allocate       ';
     indentselect [2] := none ;     keyword [2] := 'and            ';
     indentselect [3] := none ;     keyword [3] := 'array          ';
     indentselect [4] := none ;     keyword [4] := 'assert         ';
     indentselect [5] := none ;     keyword [5] := 'bit            ';
     indentselect [6] := inn  ;     keyword [6] := 'block          '; termcode [6]:= 17;
     indentselect [7] := none ;     keyword [7] := 'break          ';
     indentselect [8] := tempout ;  keyword [8] := 'case           ';
     indentselect [9] := inn  ;     keyword [9] := 'checking       '; termcode [9]:= 18;
     indentselect [10] := inn  ;     keyword [10] := 'code           '; termcode [10]:= 19;
     indentselect [11] := inn  ;     keyword [11] := 'declare        '; termcode [11]:= 20;
     indentselect [12] := none ;     keyword [12] := 'defalult       ';
     indentselect [13] := none ;     keyword [13] := 'different      ';
     indentselect [14] := none ;     keyword [14] := 'do             ';
     indentselect [15] := none ;     keyword [15] := 'dynamic        ';
     indentselect [16] := none ;     keyword [16] := 'else           ';
     indentselect [17] := out  ;     keyword [17] := 'endblock       ';
     indentselect [18] := out  ;     keyword [18] := 'endchecking    ';
     indentselect [19] := out  ;     keyword [19] := 'endcode        ';
     indentselect [20] := out  ;     keyword [20] := 'enddeclare     ';
     indentselect [21] := out  ;     keyword [21] := 'endfailing     ';
     indentselect [22] := out  ;     keyword [22] := 'endfinish      ';
     indentselect [23] := out  ;     keyword [23] := 'endfor         ';
     indentselect [24] := out  ;     keyword [24] := 'endfunction    ';
     indentselect [25] := out  ;     keyword [25] := 'endif          ';
     indentselect [26] := out  ;     keyword [26] := 'endmodule      ';
     indentselect [27] := out  ;     keyword [27] := 'endprocedure   ';
     indentselect [28] := out  ;     keyword [28] := 'endregion      ';
     indentselect [29] := out  ;     keyword [29] := 'endselect      ';
     indentselect [30] := out  ;     keyword [30] := 'endstart       ';
     indentselect [31] := out  ;     keyword [31] := 'endstructure   ';
     indentselect [32] := out  ;     keyword [32] := 'endupon        ';
     indentselect [33] := out  ;     keyword [33] := 'endwhile       ';
     indentselect [34] := none ;     keyword [34] := 'eqv            ';
     indentselect [35] := none ;     keyword [35] := 'export         ';
     indentselect [36] := none ;     keyword [36] := 'explicit       ';
     indentselect [37] := none ;     keyword [37] := 'fail           ';
     indentselect [38] := tempout ;  keyword [38] := 'failhere       ';
     indentselect [39] := inn  ;     keyword [39] := 'failing        '; termcode [39]:= 21;
     indentselect [40] := none ;     keyword [40] := 'fill           ';
     indentselect [41] := inn  ;     keyword [41] := 'finish         '; termcode [41]:= 22;
     indentselect [42] := none ;     keyword [42] := 'finishing      ';
     indentselect [43] := inn  ;     keyword [43] := 'for            '; termcode [43]:= 23;
     indentselect [44] := none ;     keyword [44] := 'force          ';
     indentselect [45] := none ;     keyword [45] := 'forward        ';
     indentselect [46] := out  ;     keyword [46] := 'from           ';
     indentselect [47] := inn  ;     keyword [47] := 'function       '; termcode [47]:= 24;
     indentselect [48] := inn  ;     keyword [48] := 'if             '; termcode [48]:= 25;
     indentselect [49] := inn  ;     keyword [49] := 'import         '; termcode [49]:= 46;

     indentselect [50] := none ;     keyword [50] := 'in             ';
     indentselect [51] := none ;     keyword [51] := 'initially      ';
     indentselect [52] := none ;     keyword [52] := 'inline         ';
     indentselect [53] := none ;     keyword [53] := 'input          ';
     indentselect [54] := none ;     keyword [54] := 'interrupt      ';
     indentselect [55] := none ;     keyword [55] := 'is             ';
     indentselect [56] := none ;     keyword [56] := 'leave          ';
     indentselect [57] := none ;     keyword [57] := 'location       ';
     indentselect [58] := none ;     keyword [58] := 'loop           ';
     indentselect [59] := none ;     keyword [59] := 'lshift         ';
     indentselect [60] := none ;     keyword [60] := 'main           ';
     indentselect [61] := none ;     keyword [61] := 'mod            ';
     indentselect [62] := inn  ;     keyword [62] := 'module         '; termcode [62]:= 26;
     indentselect [63] := none ;     keyword [63] := 'not            ';
     indentselect [64] := none ;     keyword [64] := 'of             ';
     indentselect [65] := none ;     keyword [65] := 'or             ';
     indentselect [66] := tempout ;  keyword [66] := 'orif           ';
     indentselect [67] := tempout ;  keyword [67] := 'otherwise      ';
     indentselect [68] := none ;     keyword [68] := 'packed         ';
     indentselect [69] := none ;     keyword [69] := 'pointer        ';
     indentselect [70] := none ;     keyword [70] := 'private        ';
     indentselect [71] := inn  ;     keyword [71] := 'procedure      '; termcode [71]:= 27;
     indentselect [72] := none ;     keyword [72] := 'public         ';
     indentselect [73] := none ;     keyword [73] := 'readonly       ';
     indentselect [74] := none ;     keyword [74] := 'ref            ';
     indentselect [75] := inn  ;     keyword [75] := 'region         '; termcode [75]:= 28;
     indentselect [76] := none ;     keyword [76] := 'register       ';
     indentselect [77] := inn  ;     keyword [77] := 'repeat         '; termcode [77]:= 91;
     indentselect [78] := none ;     keyword [78] := 'retry          ';
     indentselect [79] := none ;     keyword [79] := 'return         ';
     indentselect [80] := none ;     keyword [80] := 'returns        ';
     indentselect [81] := none ;     keyword [81] := 'rshift         ';
     indentselect [82] := none ;     keyword [82] := 'segment        ';
     indentselect [83] := inn  ;     keyword [83] := 'select         '; termcode [83]:= 29;
     indentselect [84] := inn  ;     keyword [84] := 'start          '; termcode [84]:= 30;
     indentselect [85] := none ;     keyword [85] := 'static         ';
     indentselect [86] := inn  ;     keyword [86] := 'structure      '; termcode [86]:= 31;
     indentselect [87] := none ;     keyword [87] := 'table          ';
     indentselect [88] := none ;     keyword [88] := 'then           ';
     indentselect [89] := tempout ;  keyword [89] := 'through        ';
     indentselect [90] := none ;     keyword [90] := 'to             ';
     indentselect [91] := out  ;     keyword [91] := 'until          ';
     indentselect [92] := inn  ;     keyword [92] := 'upon           '; termcode [92]:= 32;
     indentselect [93] := none ;     keyword [93] := 'value          ';
     indentselect [94] := none ;     keyword [94] := 'via            ';
     indentselect [95] := none ;     keyword [95] := 'volatile       ';
     indentselect [96] := none ;     keyword [96] := 'when           ';
     indentselect [97] := inn  ;     keyword [97] := 'while          '; termcode[97] := 33;
     indentselect [98] := none ;     keyword [98] := 'xor            ';
     indentselect [99] := none ;     keyword [99] := 'swap           ';
     indentselect [100] := none ;     keyword [100] := 'unpacked       ';

	{ get file specifications and open files }

     writeln ('INPUT FILE NAME');
     readln (filestring); caps (filestring);
     reset (inputfile, filestring,'PRX',filesize);
     { if filesize = -1 then error somehow }
     filesize := - abs (filesize);
     writeln ('OUTPUT FILE NAME');
     readln (filestring); caps (filestring);
     rewrite (outputfile,filestring,'PRX',filesize);
     writeln ('LISTING FILE NAME');
     readln (filestring); caps (filestring);
     rewrite (listfile,filestring,'LST',filesize);

	{ select processing options }

     writeln ('TYPE OPTIONS C=CASING, I=INDENT, F=FORMAT, S=SPECIAL FORMAT  AS CIF OR CI');
     readln (filestring); caps (filestring);
     FOR i := 1 TO 9 DO
      BEGIN
	IF filestring [i] = 'C'
	 THEN casing := true
	 ELSE
	 IF filestring [i] = 'I'
	  THEN indenting := true
	  ELSE
	  IF filestring [i] = 'S'
	   THEN specialfmt := true
	   ELSE
	   IF filestring [i] = 'F'
	    THEN formatting := true;
	tcasing := casing; tindenting := indenting; tformatting := tformatting;
      END;
    head;
   END;


{+
   **-SEPT-CHARACTER UTILITY FUNCTION
   **-ALPHNUM-CHARACTER UTILITY FUNCTION
   **-ALPH-CHARACTER UTILITY FUNCTION
 
  THESE FUNCTIONS DETERMINE CHARACTERISTICS OF CHARACTERS
  THEY ARE:
  	ALPH => TRUE IF ALPHABETIC FALSE OTHERWISE
  	SEPT => TRUE IF SPACE OR TAB FALSE OTHERWISE
  	ALPHNUM => TRUE IF ALPHANUMERIC FALSE OTHERWISE
  
 
  INPUTS:
 	I : CHAR => CHARACTER TO BE CHECKED
 
  OUTPUTS:
 	RETURNS A TRUE OR FALSE
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	NONE
 
-}
 
  FUNCTION alph; { (i:char):boolean;}
   BEGIN
     IF ((( i >= 'A' ) AND ( i <= 'Z')) OR (( i >= 'a') AND ( i <= 'z')))
      THEN alph := true
      ELSE alph := false;
   END;

  FUNCTION sept (i:char):boolean;
   BEGIN
     IF (( i = ' ') OR ( i = chr(tab)))
      THEN sept := true
      ELSE sept := false;
   END;

  FUNCTION alphnum (i:char):boolean;
   BEGIN
     IF ((( i >= 'A') AND (i <= 'Z')) OR (( i >= 'a') AND ( i <= 'z')) OR
	 (( i >= '0') AND ( i <= '9')))
      THEN alphnum := true
      ELSE alphnum := false;
   END;


{+
   **-GETSTARTWORD-FIND THE START OF A WORD
 
  THIS MODULE LOCATES THE STARTING POSITION OF A WORD IN THE INPUTLINE
  BUFFER. IT RECOGNIZES COMMENTS AND WILL FLAG THEM.
  IT RECOGNIZES LITERALS AND SKIPS THEM.
 
  INPUTS:
 	Y: INTEGER => POSITION OF POINTER IN INPUTLINE BUFFER
 
  OUTPUTS:
 	Y: INTEGER => POSITION OF START OF WORD IN INPUTBUFFER
 	COMMENT: BOOLEAN => DETECTED COMMENT IF TRUE, OTHERWISE FALSE
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	MOVES Y TO FIRST NONSEPARATOR CHARACTER WHERE A LITERAL IS CONIDSERED
 	A SEPARATOR
 
-}
 
  PROCEDURE getstartword (VAR y:integer; VAR comment: boolean );
  VAR
    literal: boolean;		{ true if processing literal }
   BEGIN
     literal := false;		{ initally not processing literal }
     comment := false;		{ or comment }

	{ look for alphanumeric character }

     WHILE NOT alphnum ( inputline [y]) DO
      BEGIN
	IF y > outlength	{ if end of line exit }
	 THEN EXIT
	 ELSE
	 IF ((inputline[y] = '/') AND (inputline[y+1] = '/')) { if comment, flag and exit }
	  THEN
	   BEGIN
	     comment:=true; EXIT
	   END;
	IF (inputline [y] = '"' )	{ if '"' then start literal }
	 THEN
	  BEGIN
	    y := y + 1;
	    literal := true;
	    WHILE literal DO		{ continue processing literal }
	     BEGIN
	       IF inputline [y] = '"'	{ until literal is ended }
		THEN literal:= false;
	       y := y + 1;
	     END;
	  END

	 ELSE
	 y := y + 1;
      END;
   END;


{+
   **-GETENDWORD-FIND END OF WORD
 
  THIS PROCEDURE LOCATES THE END OF A WORD IN THE INPUTLINE BUFFER.
  THE UNDERSCORE IS CONSIDERED TO BE PART OF THE WORD.
  OTHERWISE, THE PROCEDURE ADVANCES THE POINTER TO THE FIRST NON ALPHANUMERIC
  CHARACTER.
 
  INPUTS:
 	Y:INTEGER => POINTER TO CURRENT LOCATION IN LINE
 
  OUTPUTS:
 	Y:INTEGER => UPDATED LOCATION IN LINE
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	MOVES Y
 
-}
 
  PROCEDURE getendword (VAR y: integer );
   BEGIN

	{ looking for non word character }

     WHILE  alphnum (inputline [y]) OR ( inputline[y] = '_' ) DO
      BEGIN
	IF y > outlength	{ if past line exit }
	 THEN EXIT
	 ELSE  y := y + 1;
      END;
   END;


{+
   **-READIT-READ IN LINE FROM INPUTFILE
 
  THIS PROCEDURE READS A LINE OF TEXT INTO TEMPINPUT.
  THEN IF INDENTING, WILL LEFT JUSTIFY EACH LINE UNLESS THE LINE STARTS 
  WITH A STRING OF SEPARATORS FOLLOWED BY "//"
  
  THIS SITUATION WILL LEAVE THE LINE AS " //" WHICH IS USED TO FLAG THE
  INDENTER THAT THE COMMENT IS TO BE INDENTED.
  
  THE SLIGHTLY MODIFIED LINE IN TEMPINPUT IS THEN COPIED TO INPUTLINE.
  AND THE LINE NUMBER INCREMENTED.
  
 
  INPUTS:

  OUTPUTS:
 	J: INTEGER => SIZE OF THE LINE IN THE INPUTLINE BUFFER.
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	READS A LINE FROM THE FILE
 	INCREMENTS NUMBERLINES
 
-}
  PROCEDURE readit (VAR j: integer ) ;
  VAR
    linestarted, seensep: boolean;	{ line started  and seen seperator }
    h,k,i: integer;			{ scratch pointer }
   BEGIN
     inputline := emptyline;		{ clear inputline }
     tempinput := emptyline;		{ and temperary line }
     i := 0;				{ initalize pointers }

	{ read in a line }

      REPEAT
	BEGIN
	  i := i+1;
	  read (inputfile,tempinput [i]);
	END;
      UNTIL eoln (inputfile) OR eof (inputfile) OR (i > lineleng);
     readln(inputfile);
     k := 0;			{ initalize new line pointer }

	{ if indenting, you need to squeeze the line }

     IF indenting
      THEN
       BEGIN
	 seensep := false;	{ havent seen a seperator yet }
	 linestarted := false;	{ line isn't yet started either }

	{ scanning through the line }

	 FOR h := 1 TO i DO
	  BEGIN
	    IF linestarted	{ if line is started, }
	     THEN
	      BEGIN
		k := k + 1;	{ advance pointer and save character }
		inputline [k] := tempinput [h];
	      END
	     ELSE		{ if line is not started, }
	      BEGIN

	{ and if a seperator was seen before the comment, }

		IF ((seensep) AND (tempinput [h] = '/') AND (tempinput [h+1] = '/'))
		 THEN
		  BEGIN
		    k := k + 1;		{ make in-block comment line a ' //' instead of '//' }
		    inputline[k] := ' ';
		  END;

	{ if not a seperator the line is started }

		IF NOT sept (tempinput [h])
		 THEN
		  BEGIN
		    linestarted := true;
		    k := k + 1;
		    inputline [k] := tempinput [h];
		  END
		 ELSE seensep := true;	{ if leading seperator we have seen it }
	      END;
	  END;
	 j := k;		{ store line size }
       END

	{ if not indenting , just copy entire line }

      ELSE
       BEGIN
	 inputline := tempinput;
	 j := i;
       END;

     IF NOT eof (inputfile)	{ and bump the line number }
      THEN numberlines := numberlines + 1;
   END;


{+
   **-KEYSCAN-SCAN KEYWORDS FOR A MATCH
 
  THIS PROCEDURE SCANS THE INPUTLINE BUFFER LOOKING FOR KEYWORDS
  IF CASING IS ON, THE KEYWORDS ARE CAPITALIZED
  IF INDENTING IS ON, THE INDENTING VARIABLES ARE UPDATED, AND THE
  STRUCTURE STACK IS POPPED OR PUSHED DEPENDING IF A ENDBLOCK OR STARTBLOCK
  OCCURS.
  
  THERE ARE SOME SPECIAL CASES COMMENTED IN THE CODE.
  
  IF INDENTING, AND A BLOCK ERROR OCCURS, THIS PROCEDURE DISPLAYS
  AN ERROR MESSAGE AT THE TERMINAL AND IN THE LIST FILE.
  
 
  INPUTS:
 	NONE
 
  OUTPUTS:
 	NONE
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	TEMPWORD IS USED FOR TEMPORARY STORAGE OF WORDS
 	INDENTLEVEL AND PINDENTLEVEL ARE MODIFIED
 	CODECASE AND THE CONTROL SWITCHES (CASING,FORMATTING,INDENTING)
 		MAY BE CHANGED ALONG WITH THE TEMPORARY STORAGE FOR THEM
 	THE STRUCTURE STACK MAY BE ALTERED
 	CERTAIN CHARACTERS IN THE INPUTLINE ARE CAPITALIZED
 
-}
  PROCEDURE keyscan ;
  LABEL
    1;
  VAR

	{ pointers in the line to bracket the words and pointer for filling }
	{ a key word }

    tempwpoint,linespoint,lineepoint : integer;
    sameline: boolean;		{ flag to show block started and stoped same line }
    i: integer;

	{ comment, processing IS, processing FORWARD, CODE block is processing }

    comment,procesis,codecase,processforw: boolean;

   BEGIN
     codecase := false;	{ initalization }
     processforw := false;
     procesis := false;
     linespoint := 1;
     lineepoint := 1;

	{ continue till you run out of line }

      REPEAT
	BEGIN
	  getstartword (linespoint,comment);  { find start of word }
	  IF (linespoint >= outlength) OR comment { exit conditions }
	   THEN EXIT;
	  lineepoint := linespoint;	{ lineepoint is at start of word }
	  getendword (linespoint);	{ linespoint is at end of word }
	  IF linespoint - lineepoint > 15  { words of interest are <= 15 }
	   THEN
	    BEGIN
	      lineepoint := linespoint;	{ advance start to end }
	      GOTO 1;			{ and continue with next word }
	    END;
	  tempword := emptyword;	{ reset word }

	{ copy word to tempword }

	  FOR i := lineepoint TO linespoint-1 DO
	   BEGIN
	     tempword [ i-lineepoint+1 ] := inputline [i];
	   END;

	{ search through the keys to find a match }

	  FOR i := 1 TO numberkey DO
	   BEGIN
	     IF tempword = keyword [i]
	      THEN
	       BEGIN
		 IF i = 55		{ check if processing IS }
		  THEN procesis := true;
		 IF i = 45		{ check if processing FORWARD }
		  THEN processforw := true;

	{ if indenting do a lot of stuff }

		 IF indenting
		  THEN
		   BEGIN

	{ check for IS PROCEDURE  and FORWARD PROCEDURE and FORWARD FUNCTION }

		     IF NOT (( procesis AND ( i = procedurei ))
			     OR ( processforw AND ( i = functioni))
			     OR ( processforw AND ( i = procedurei)))
		      THEN
		       BEGIN

	{ do indenting from indent selection }

			 CASE indentselect [i] OF

			   none:;

			   tempout:	{ out this line then back in }
			    BEGIN
			      temppre := temppre - 2;
			    END;

			   inn:	{ indent in }
			    BEGIN

	{ check that FOR exp WHILE exp DO }

			      IF NOT ((( i = whilei ) AND (structstk^.id = fori ))
					OR (( i = declarei) AND ( brakit = matched)))
			       THEN
				BEGIN
				  IF i = codei	{ check for CODE block }
				   THEN
				    BEGIN
				      codecase := true;
				      casing := false;
				      formatting := false;
				      indenting := true;
				    END;
				  new (nnew);	{ get new stack element }
				  nnew^.link := structstk;
				  structstk := nnew;
				  nnew^.level := indentlevel;
				  nnew^.endid := termcode [i];
				  nnew^.id := i;
				  nnew^.line := numberlines;

	{ set the indent level to incress after printout }

				  pindentlevel := pindentlevel + 1;
				END;
			    END;

			   out:	{ indent out }
			    BEGIN
			      sameline := false;	{ check if same line as block start }
			      IF  i = endcodei		{ specal check for CODE }
			       THEN
				BEGIN
				  codecase := true;	{ restore options }
				  casing := tcasing;
				  formatting := tformatting;
				  indenting := tindenting;
				END;

	{ check if endblock matches block }

			      IF NOT (( i = fromi) AND ( structstk^.endid = endselecti )) 
			      THEN BEGIN
			      IF i = structstk^.endid
			       THEN
				BEGIN
				  nnew := structstk;
				  IF numberlines = nnew^.line { if same line }
				   THEN sameline := true;
				  IF nnew^.link <> NIL  { check for error }
				   THEN
				    BEGIN	{ deleate stack element }
				      structstk := nnew^.link;
				      dispose (nnew);
				    END;
				END

	{ if endblock does not match with block then error }

			       ELSE
				BEGIN
				  pageline := pageline + 1;
				  writeln ('error line  ',numberlines:6, structstk^.line:6);
				  writeln (listfile,'>>>>>>>> ERROR @ LINE # '
					   ,numberlines:4
					   ,' DOES NOT MATCH ',keyword[structstk^.id]
					   ,' @ LINE # ', structstk^.line:4 );
				END;
			      IF sameline
			       THEN pindentlevel := pindentlevel -1
			       ELSE indentlevel := indentlevel - 1;
			    END;
			  END;
			  END;
		       END;
		   END;

	{ if converting key words to upper case }

		 IF casing OR codecase
		  THEN
		   BEGIN
		     codecase := false;	{ to allow ENDCASE to be caps }
		     WHILE lineepoint < linespoint DO
		      BEGIN
			inputline [lineepoint] := chr ( ord ( inputline [lineepoint]) AND
						       337B);
			lineepoint := lineepoint + 1;
		      END;
		   END;
		 EXIT;
	       END;
	   END;
	END;
1:
      UNTIL
       linespoint > outlength		{ the entire line }
   END;


{+
   **-INDENT-CONTROLS INDENTING OF LINES
 
  THIS PROCEDURE COPIES THE INPUTLINE TO THE TEMPINPUT BUFFER
  AND THEN TO THE OUTPUTLINE BUFFER.
  IN THE PROCESS, IT DOES. . .
  	1) DECIDES TO INDENT COMMENTS OR NOT
  		' //' => YES, '//'=> NO
  	2) IF INDENTING COMMENTS DECIDES WHERE TO PLACE THEM
  	3) REPLACES ALL SEQUENCES OF SPACES WITH TABS IF POSSABLE
  	4) REMOVES TRAILING SEPERATORS
  
 
  INPUTS:
 	J:INTEGER => LENGTH OF LINE IN INPUTLINE
 
  OUTPUTS:
 	J:INTEGER => LENGTH OF LINE IN OUTPUTLINE
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	INPUTLINE IS COPIED TO OUTPUTLINE VIA TEMPINPUT
 	THE LINE IS INDENTED AND READY TO BE WRITTEN
 	
 
-}
  PROCEDURE indent (VAR j:integer) ;
  VAR
    i,k,m,tabstop,prefix: integer;
    com: boolean;	{ comment found }

   BEGIN
     tempinput := emptyline;	{ initalize work space }

	{ does comment start at start of line? }

     IF ((inputline[1] = '/') AND (inputline[2] = '/'))
      THEN
       BEGIN		{ copy entire line }
	 FOR i := 1 TO j+1 DO tempinput [i] := inputline [i];
       END

	{ otherwise, you must indent }

      ELSE
       BEGIN
	 prefix := indentlevel * 2;	{ find number of spaces to indent }
	 k := 1;
	 FOR i := 1 TO prefix + temppre DO
	  BEGIN			{ generate leading spaces }
	    tempinput [i] := ' ';
	    k := i;
	  END;
	 com := false;			{ usually not a comment }
	 FOR i := 1 TO j DO		{ scan the line }
	  BEGIN
	    IF ((NOT com) AND (inputline[i] = '/') AND (inputline[i+1] = '/'))
	     THEN
	      BEGIN			{ oops found a comment again }
		com := true;
		IF k > lastcompos	{ did start of comment exceed last comment? }
		 THEN lastcompos := k;
		IF (lastcompos - k) > 2	{ let it migrate to the left }
		 THEN lastcompos := lastcompos - 2;
		IF lastcompos < composition	{ but not past limit }
		 THEN lastcompos := composition;
		WHILE (k < lastcompos) DO	{ fill in with spaces }
		 BEGIN
		   k:=k+1; tempinput[k] := ' ';
		 END;
	      END;
	    k := k + 1;
	    tempinput [k] := inputline[i];
	  END;
	 j := k;
       END;
{     indentlevel := indentlevel + pindentlevel;	 done in writeit/ update indent level }
{     pindentlevel := 0;			 and remove post indnet }
     temppre := 0;				{ and temperary adjust }

	{ remove trailing seperators from line }

     WHILE (sept(tempinput[j]) AND ( j > 1) )DO j := j -1;

	{ convert multiple spaces to tabs }

     outputline := emptyline;		{ init lines }
     tabstop := 8;			{ set tab stop position }
     k := 0;
     i := 0;
     com := false;

	{ scanning through the line once again }

     WHILE k <= j DO
      BEGIN
	IF k<= tabstop		{ check for tab position }
	 THEN
	  BEGIN
	    k:= k+1;		{ if not store char }
	    i:= i+1;
	    IF ((tempinput[k] ='/') AND (tempinput[k+1]='/'))
	     THEN		{ if comment just leave alone}
	      BEGIN
		com := true;
		outputline[i]:=tempinput[k];
		EXIT;
	      END;
	    outputline[i] := tempinput[k];  { save character }
	  END

	{ tab position found }

	 ELSE
	  BEGIN	{ need multiple space befor tab is inserted }
	    IF ( (outputline[i] = ' ' ) and ( outputline[i-1] = ' '))
		 THEN
		  BEGIN
		    WHILE i > 0 DO
		     BEGIN		{ backwords till non space }
		       IF outputline[i]=' '
			THEN i:= i-1
			ELSE EXIT;
		     END;
		    i:=i+1;
		    outputline[i]:=chr(11B); { and add tab }
		  END;
	    tabstop := tabstop + 8;	{ update tab stop position }
	  END;
      END;

	{ if comment  just copy rest of line }

     IF com
      THEN
       BEGIN
	 WHILE k <= j DO
	  BEGIN
	    k := k+1;
	    i := i+1;
	    outputline[i] := tempinput[k];
	  END;
        END;
   END;


{+
   **-WRITEIT-WRITES THE LINE TO THE OUTPUT FILES
 
  THIS PROCEDURE WRITES THE LINE TO THE OUTPUTFILE AND THE LISTING FILE
  PAGELINE IS INCREMENTED
 
  INPUTS:
 	LINELENGTH: INTEGER => NUMBER OF CHARACTERS IN THE LINE
 
  OUTPUTS:
 	NONE
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	A LINE IS WRITTEN TO THE OUTPUTFILES
 	THE LINE NUMBER AND LEVEL IS PREFIXED TO THE LISTING LINE FIRST
 	PAGELINE IS INCREMENTED
	INDENTLEVEL IS UPDATED BY PINDENTLEVEL
	PINDENTLEVEL IS ZEROED
 
-}
  PROCEDURE writeit (VAR linelength: integer ) ;
  VAR
    i:integer;
   BEGIN
     FOR i := 1 TO linelength DO write(outputfile, outputline [i]);
     writeln (outputfile);
     write (listfile,numberlines:4,indentlevel:8,CHR (11B));
     FOR i := 1 TO linelength DO write(listfile,outputline[i]);
     writeln(listfile);
     pageline := pageline + 1;
    indentlevel := indentlevel + pindentlevel;
    pindentlevel := 0;
    IF eoln ( inputfile )  AND NOT eof ( inputfile )
      THEN 
        BEGIN
         writeln (outputfile);
         writeln (listfile);
         pageline := pageline + 1;
        END;
    if pageline >= pagelength
       then
	begin
	pageline := 0;
        writeln (listfile,chr(ff));
	head;
	end;
   END;


{+
   **-FORMAT-FORMATS THE LINE
 
  THIS PROCEDURE FORMATS THE INPUTLINE.
  IT DOES NOT PLAY WITH LITERALS OR COMMENTS
  IF CASING IS ON, IT MAKES ALL CHARACTERS EXCEPT LITERALS OR COMMENTS
  LOWER CASE.
  IF FORMATTING
  IT REMOVES MULTIPLE SEPERATORS
  CONVERTS TABS TO SPACE
  FORCES SOME FORMATTING CONVENTIONS: EACH IS INDICATED BY
  F => NORMAL FORMATING; S=> SPECIAL FORMATTING
  
  [:]   => ALPHA: TEXT FS
  [:=]  => ANY := ANY FS
  [,]   => A,A F AND A, A S
  [()   => ANY(ANY F AND ANY ( ANY S
  [)]   => ANY)ANY F AND ANY ) ANY S
  [[]   => ANY[ANY F AND ANY [ANY  S
  []]   => ANY]ANY F AND ANY] ANY  S
  [left bracket]   => ANY left bracket ANY SF
  [right bracket]   => ANY right bracket ANY SF
  [+]   => ANY+ANY F AND ANY + ANY S
  [-]   => ANY-ANY F AND ANY - ANY S
  [*]   => ANY*ANY F AND ANY * ANY S
  [*=]  => ANY*= ANY F AND ANY *= ANY S
  [/]   => ANY/ANY F AND ANY / ANY S
  [<]   => ANY<ANY F AND ANY < ANY S
  REST ARE FOR BOTH
  [<]   => ANY < ANY
  [<<]  => ANY << ANY
  [<=]  => ANY <= ANY
  [<>]  => ANY <> ANY
  [>]   => ANY > ANY
  [>=]  => ANY >= ANY
  [=]   => ANY = ANY
  
  IN THE F CASE, SPACES ARE NOT REMOVED TO PROVIDE ADAGENCY
  EXCEPT FOR :. IN THE S CASE, SPACES ARE ADDED TO PROVIDE FORMAT
  
 
  INPUTS:
 	LL: INTEGER => LINELENGTH
 
  OUTPUTS:
 	LL: INTEGER => MODIFIED LINE LINEGTH
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	INPUTLINE ENDS UP WITH NEW LINE
 	TEMPLINE IS USED AGAIN
        BRAKIT IS SET
		NOPREN IF NO PRENS IN LINE
		MATCHED IF MATCHING PRENS
		ODD IF NOT MATCHING PRENS
 
-}
  PROCEDURE format ( VAR ll:integer) ;
  VAR
    i,k,j,m:integer;
    lastchrpos: integer;	{ position of last non seperator }
    com,literal,sep,kludge:boolean;
    ch: char;
    prncnt: integer;		{ number of unmatched prens in line }

    PROCEDURE storechr ( VAR i:integer; ch: char);
{ this procedure advances the pointer, stores a character and updates }
{ the position of the last non seperator character }
     BEGIN
       i := i + 1;
       inputline[i] := ch;
       IF NOT sept(ch)
	THEN lastchrpos := i;
     END;


   BEGIN
     literal := false;			{ initalization again }
     com := false;

	{ go through the line again ( this is a lot of scans )}

     prncnt := 0;
     brakit := nopren;
     FOR i := 1 TO ll DO
      BEGIN
	IF (inputline[i] = '"')	{ check for literal }
	 THEN  literal := not literal;

	{ if comment }

	IF ((inputline[i] = '/') AND (inputline [i+1] = '/'))
	 THEN com := true;
	IF NOT com
	 THEN
	  BEGIN

	{ lower case every thing if not comment or literal and you want casing }

	    IF casing AND NOT literal AND  alph (inputline[i])
	     THEN inputline[i] := chr ( ord (  inputline[i] ) OR 40B );
	  END;
      END;

	{ here is the start of the formmating part }

     IF formatting
      THEN
       BEGIN
	 lastchrpos := 1;		{ initalization }
	 com := false;
	 tempinput := inputline;	{ copy line }
	 inputline := emptyline;	{ init line }
	 sep := false;
	 literal := false;
	 j := 0;

	{ go thourgh the line }

	 FOR i := 1 TO ll DO
	  BEGIN
	    IF ((tempinput [i] = '/') AND (tempinput [i+1] = '/'))
	     THEN com := true;		{ comment check again }
	    IF com
	     THEN storechr (j,tempinput[i])
	     ELSE
	      BEGIN			{ check if processing literal }
		ch := tempinput [i];
		IF ch = '"'
		 THEN literal := not literal;
		IF  literal
		 THEN storechr (j,ch)
		 ELSE			{ if literal no special processing }
		 BEGIN
		 IF ch = chr (11B)	{ remove tabs insert spaces }
		  THEN ch := ' ';
		 IF alphnum ( ch )	{ if alphanumaric }
		  THEN
		   BEGIN
		     sep := false;
		     storechr (j,ch);
		   END
		  ELSE
		  IF sept (ch)	{ if seperator }
		   THEN
		     BEGIN
		      IF NOT sep
		       THEN		{ but not a string of seperators }
			BEGIN
			  sep := true;
			  storechr (j,' ');
			END
		     END
		   ELSE
		    BEGIN
		      kludge := false;		{ it says what it is }

	{ check for special symbols }

		      FOR k := 1 TO numfmtsym DO
		       BEGIN
			 m := k;
			 IF (ch = fmtsym [k])
			  THEN
			   BEGIN
			     kludge := true;
			     EXIT;
			   END;
		       END;
		      IF kludge	{ found a symbol match }
		       THEN
			BEGIN
			  CASE m OF
			    1: { : }
			     BEGIN
			       IF ( tempinput[i+1] = '=')  { := ? }
				THEN
				 BEGIN
				   IF NOT sept (inputline[j])
				    THEN storechr (j,' ');
				   storechr (j,ch)
				 END
				ELSE
				 BEGIN
				   IF sept(inputline[j])  { ' :' }
				    THEN j := j-1;
				   storechr (j,ch); storechr (j,' '); sep := true;
				 END;
			     END;
			    2:  { , }
			     BEGIN
			       IF specialfmt
				THEN
				 BEGIN
				   IF sept(inputline[j])
				    THEN j := j-1;
				   storechr (j,ch); storechr (j,' '); sep := true;
				 END
				ELSE storechr(j,ch);
			     END;
			    3: { ( }
			     BEGIN
			       pindentlevel := pindentlevel + 1;
			       brakit := odd;
			       prncnt := prncnt + 1;
			       IF specialfmt
				THEN
				 BEGIN
				   IF ((inputline[j-1] = '(') AND
				       (inputline[j] = ' '))
				    THEN j := j-1;
				   IF NOT ((inputline[j] = ' ') OR (inputline[j] = '('))
				    THEN   storechr (j,' ');
				   storechr (j,ch); storechr (j,' '); sep := true
				 END
				ELSE storechr (j,ch);

			     END;
			    4:  {  )  }
			     BEGIN
			       pindentlevel := pindentlevel - 1;
			       prncnt := prncnt - 1;
			       IF specialfmt
				THEN
				 BEGIN
				   IF ((inputline[j-1] = ')') AND
				       (inputline[j] = ' '))
				    THEN j := j-1;
				   IF NOT ((inputline[j] = ' ') OR (inputline[j] = ')'))
				    THEN   storechr (j,' ');
				   storechr (j,ch); storechr (j,' '); sep := true
				 END
				ELSE storechr (j,ch);

			     END;
			    5: { [  }
			     BEGIN
			       pindentlevel := pindentlevel + 1;
			       IF specialfmt
				THEN
				 BEGIN
				   IF NOT (inputline[j] = ' ')
				    THEN storechr (j,' ');
				   storechr (j,ch);
				 END
				ELSE storechr (j,ch);

			     END;
			    6: { ] }
			     BEGIN
			       pindentlevel := pindentlevel -1;
			       IF specialfmt
				THEN
				 BEGIN
				   IF (inputline[j] = ' ')
				    THEN j := j-1;
				   storechr (j,ch); storechr (j,' '); sep := true
				 END
				ELSE storechr (j,ch);

			     END;
			    7: /* { */
			     BEGIN
			       IF ((inputline[j-1] = '{') AND
				   (inputline[j] = ' '))
				THEN j := j-1;
			       IF NOT ((inputline[j] = ' ') OR (inputline[j] = '{'))
				THEN   storechr (j,' ');
			       storechr (j,ch); storechr (j,' '); sep := true
			     END;
			    8:
			     BEGIN
			       IF ((inputline[j-1] = '}') AND
				   (inputline[j] = ' '))
				THEN
				j := j-1;
			       IF NOT ((inputline[j] = ' ') OR (inputline[j] = '}'))
				THEN
				storechr (j,' ');
			       storechr (j,ch); storechr (j,' '); sep := true
			     END;
			    9:  { + }
			     BEGIN
			       IF specialfmt
				THEN
				 BEGIN
				   IF NOT (inputline[j] = ' ')
				    THEN storechr (j,' ');
				   storechr (j,ch); storechr (j,' '); sep := true
				 END
				ELSE storechr (j,ch);

			     END;
			    10:  { - }
			     BEGIN
			       IF specialfmt
				THEN
				 BEGIN
				   IF NOT (inputline[j] = ' ')
				    THEN storechr (j,' ');
				   storechr (j,ch); storechr (j,' '); sep := true
				 END
				ELSE storechr (j,ch);

			     END;
			    11: { * }
			     BEGIN
			       IF specialfmt
				THEN
				 BEGIN
				   IF NOT (inputline[j] = ' ')
				    THEN storechr (j,' ');
				   IF (tempinput [i+1] = '=')
				    THEN storechr(j,ch)
				    ELSE
				     BEGIN
				       storechr (j,ch); storechr (j,' '); sep := true
				     END;
				 END
				ELSE storechr (j,ch);

			     END;
			    12: { / }
			     BEGIN
			       IF specialfmt
				THEN
				 BEGIN
				   IF NOT (inputline[j] = ' ')
				    THEN storechr (j,' ');
				   storechr (j,ch); storechr (j,' '); sep := true
				 END
				ELSE storechr (j,ch);

			     END;
			    13: {  < }
			     BEGIN
			       IF ((inputline[j] = ' ') OR (inputline[j] = '<'))
				THEN storechr (j,ch)
				ELSE
				 BEGIN
				   storechr (j,' '); storechr (j,ch)
				 END;
			       IF  NOT ((tempinput [i+1] = '>')
					OR (tempinput [i+1] = '='))
				THEN
				 BEGIN
				   storechr (j,' '); sep := true
				 END;
			     END;
			    14:  {  >  }
			     BEGIN
			       IF ((inputline[j] = ' ')
				   OR (inputline[j] = '>')
				   OR (inputline[j] = '<'))
				THEN storechr (j,ch)
				ELSE
				 BEGIN
				   storechr (j,' '); storechr (j,ch);
				 END;
			       IF NOT (tempinput[i+1] = '=')
				THEN
				 BEGIN
				   storechr (j,' '); sep := true
				 END;
			     END;
			    15: { = }
			     BEGIN
			       IF alphnum(inputline[j])
				THEN storechr (j,' ');
			       storechr (j,ch); storechr (j,' '); sep := true
			     END;
			    16:  { ; }
			     BEGIN
			       IF specialfmt
				THEN
				 BEGIN
				   IF sept(inputline[j])
				    THEN j := j-1;
				   storechr (j,ch); storechr (j,' '); sep := true;
				 END
				ELSE storechr(j,ch);
			     END;
			   END;
			END
		       ELSE
		       storechr (j,ch);
		    END;
	      END;
	    END;

	  END;
	 ll := j;		{ update number of characters }
         IF brakit = odd
           THEN
             IF prncnt = 0 THEN brakit := matched;
       END;
   END
    ;


{+
   **-MAIN-MAIN ROUTINE
 
  INIT THEN READ LINES, FORMAT THEM, INDENT THEM, WRITE THEM 
  UNTIL ALL DONE
  CLOSE FILES 
  EXIT
  
 
  INPUTS:
 	NONE
 
  OUTPUTS:
 	NONE
 
  SIDE EFFECTS:
 
     MODIFIED EXTERNALS
 
     OTHER SIDE EFFECTS
 	MANY
 
-}
 BEGIN
   init;
    REPEAT
      BEGIN
	readit(outlength);
	format (outlength) ;
	keyscan ;
	indent (outlength);
	writeit(outlength) ;
      END;
    UNTIL eof (inputfile);
   close (inputfile);
   break (outputfile);
   break (listfile);
   close (listfile);
   close (outputfile);
 END.
