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 < 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.