{[A=20,I=2,L=4,E=3,W=1-100] PASCFORM directive } PROGRAM indent; (* Indent Pascal programs, and also optionaly change keywords and variables to common case ( upper-case or lower-case ). Was originaly a RC8000 Pascal program. Changed to RTP86 Pascal by RC *) (*---------------------------------------------------------------------------- Date. Init. Vers. Explanation. 1989-01-19 LEI 1.1 Changed to Turbo Pascal 5.0 by Leif Nielsen JTAS 1989-03-22 LEI 1.2 New languages inserted. -----------------------------------------------------------------------------*) {$R+,S+ } USES Dos, DosUtil, Help, Param; CONST version: STRING = ('1.2'); MaxParam = 2; MaxOption = 8; ParamList : ARRAY[1..MaxParam] OF ParamRec = ((Kind:KnownFile; Defined:FALSE; KeyWord:'I'; NumVal:0; TextVal:'.RTP'), (Kind:FileType; Defined:FALSE; KeyWord:'O'; NumVal:0; TextVal:'')); OptionList : ARRAY[1..MaxOption] OF ParamRec = ((Kind:OnOff; Defined:FALSE ;KeyWord:'NUMBERS'; NumVal:0; TextVal:'OFF'), (*line numbers*) (Kind:OnOff; Defined:FALSE ;KeyWord:'MARK'; NumVal:0; TextVal:'OFF'), (*mark*) (Kind:OnOff; Defined:FALSE ;KeyWord:'LIST'; NumVal:0; TextVal:'OFF'), (*list*) (Kind:TextType; Defined:FALSE ;KeyWord:'INDENT'; NumVal:0; TextVal:'ON' ), (*indent*) (Kind:TextType; Defined:FALSE ;KeyWord:'KEYWORDS'; NumVal:0; TextVal:'OWN'), (*keywords*) (Kind:TextType; Defined:FALSE ;KeyWord:'VARIABLE'; NumVal:0; TextVal:'OWN'), (*variables*) (Kind:TextType; Defined:FALSE ;KeyWord:'PASCAL'; NumVal:0; TextVal:'TURBO'), (*Pascal ver.*) (Kind:OnOff; Defined:FALSE ;KeyWord:'XRAY'; NumVal:0; TextVal:'OFF') ); (*test*) CONST blank = ' '; lsize = 240; (* LONGEST LINE*) ssize = 90; (* DEEPEST STACK LOAD*) tsize = 77; (* NO OF INTERESTING KEYWORDS *) toplength = 14; (* longest identifier *) alfalength = 14; File_buff_size = 2048; key_ptrsize = 27 (* A..Z + 1 *); space = 32; ordoftab = 9; LF = 10; FF = 12; CR = 13; TYPE alfa = STRING[alfalength]; options = (ind_, noind_, ownind_, lcid_, ucid_, ownid_, lckeyw_, uckeyw_, ownkeyw_ ); language_type = ( Not_implemented, Turbo_pascal, Pascal_86, Common_RTP, RTP_8000, RTP_286 ); stackelement = RECORD prior, indent: integer END; tablelement = RECORD txt_str: alfa; p1, p2, spacing: integer END; VAR outpfile, inpfile: STRING; inp, outp: text; I_buff, O_buff: ARRAY[1..File_buff_size] OF byte; eol: boolean; (** false until END-OF-LINE is met **) alfanum: SET OF char; (*HOLDS SET OF ALPHANUMERIC SYMBOLS *) dummy_line: STRING; line: STRING[lsize]; (* LINE LEFT JUSTIFIED*) line_after_ff: STRING[lsize]; (* Store rest of line read *) line_too_long: integer; (* count number of too long lines *) c_pos: integer; (* POINTER TO CURRENT CHARACTER*) lastpos: integer; (* LAST POSITION ON CURRENT LINE*) linepos: integer; (* POINTER TO LAST USED PRINTPOS*) lineno: integer; (* LINE NUMBER OF CURRENT LINE *) current, ch: char; (* CH IS FIRST CHAR ON NEXT LINE*) fresh: boolean; (* LINE READ, NOT YET PRINTED*) margin: integer; (* HANDLES INDENTION*) oldpos: integer; (* USED TO HOLD POSITIONS IN RECORDS*) max_keyw_index, keyw_index: integer; state, old_state: (spublic, declare, statement); skiperror, formfeed, myind, noind, fewends: boolean; linesmode, markmode: boolean; idmode, varmode, reskeymode: byte; language: language_type; test_requested, (* governed by parameter option *) skiptekst: boolean; (*USED IN SHIFTCASE*) skipchar: char; (*USED IN SHIFTCASE *) markstack: ARRAY[-10..lsize] OF integer; markpointer, nextmark: integer; stack: ARRAY[0..ssize] OF stackelement; top: integer; (* STACK POINTER *) stacktop: stackelement; (* HOLDS STACK[TOP]*) PascalTable: ARRAY[1..TSize] OF tablelement; key_ptr: ARRAY[ 65..91 { 'A'..'Z'+1 }] OF integer; NoRecord: integer; (* gives the number of records. inc. by 1 on keyword 'Record'. Dec by one on end record *) InWith: boolean; (* true if passing With ... do *) PROCEDURE printline; FORWARD; PROCEDURE semicolon; FORWARD; PROCEDURE skip(skipend: char); FORWARD; FUNCTION eof_inp: boolean; BEGIN (* Cheat, because of problem with FF. See Readline procedure for more information *) IF NOT formfeed THEN eof_inp := eof(inp) ELSE eof_inp := false; END (* Special EOF(INP) made for Turbo Pascal edition *); PROCEDURE error(e_txt1: STRING); BEGIN writeln(Output); writeln(Output, '*** INDENT ERROR ***', e_txt1); halt; (** i.e.: EXIT program **) END (*error*); PROCEDURE initialize_1; VAR i, j: integer; prev_keylgth, k_ix, index: integer; PROCEDURE init_P_table(a: alfa; a1, a2, a3: integer); BEGIN WITH pascaltable[index] DO BEGIN txt_str := a; p1 := a1; p2 := a2; spacing := a3; END; max_keyw_index := index; index := index+1; END; BEGIN eol := false; alfanum := ['0'..'9', 'A'..'Z', '_']; linepos := 0; lineno := 1; line_too_long := 0; fewends := false; skiptekst := false; skiperror := false; markpointer := 0; Margin := 3; stack[0].prior := 10; (* bottom never unstack *) stack[0].indent := 0; stack[1].indent := 2; stack[1].prior := 2; stacktop := stack[1]; top := 1; state := declare; old_state := statement; NoRecord := 0; InWith := false; formfeed := false; (** Searching in this table is done by means of "binary search" on the keywords. For this reason the keywords has to be put into the table in alphabetical order!!! **) index := 1; init_P_table('ABSOLUTE ', -1, 0, 0); init_P_table('AND ', -1, 0, 0); init_P_table('ARRAY ', -1, 0, 0); init_P_table('AS ', -1, 0, 0); init_P_table('BEGIN ', 4, 4, 2); init_P_table('BEGINBODY ', 4, 4, 2); init_P_table('CASE ', 0, 4, 2); init_P_table('CHANNEL ', -1, 0, 0); init_P_table('CONST ', 3, 2, 2); init_P_table('CONTINUELOOP ', -1, 0, 0); init_P_table('DIV ', -1, 0, 0); init_P_table('DO ', -1, 0, 0); init_P_table('DOWNTO ', -1, 0, 0); init_P_table('ELSE ', 6, 5, 2); init_P_table('END ', 5, 0, 0); init_P_table('ENDLOOP ', 5, 0, 0); init_P_table('EXIT ', -1, 0, 0); init_P_table('EXITLOOP ', -1, 0, 0); init_P_table('EXPORT ', -1, 0, 0); init_P_table('EXTERNAL ', 4, 0, 0); init_P_table('FILE ', -1, 0, 0); init_P_table('FOR ', 0, 5, 2); init_P_table('FORWARD ', 4, 0, 0); init_P_table('FUNCTION ', 0, 2, 2); init_P_table('GETSWITCH ', -1, 0, 0); init_P_table('GOTO ', -1, 0, 0); init_P_table('IF ', 0, 5, 2); init_P_table('IMPLEMENTATION', 3, 2, 2); init_P_table('IN ', -1, 0, 0); init_P_table('INCLUDE ', -1, 0, 0); init_P_table('INLINE ', -1, 0, 0); init_P_table('INSPECT ', -1, 0, 0); init_P_table('INTERFACE ', -1, 0, 0); init_P_table('INTERRUPT ', -1, 0, 0); init_P_table('LABEL ', 3, 2, 2); init_P_table('LOCK ', 0, 5, 2); init_P_table('LOCKBUF ', 0, 5, 2); init_P_table('LOCKDATA ', 0, 5, 2); init_P_table('LOCKMES ', 0, 5, 2); init_P_table('LOOP ', 0, 4, 2); init_P_table('MOD ', -1, 0, 0); init_P_table('MODULE ', 3, 2, 2); init_P_table('NIL ', -1, 0, 0); init_P_table('NOT ', -1, 0, 0); init_P_table('OF ', -1, 0, 0); init_P_table('OPENROUTINE ', 4, 0, 0); init_P_table('OR ', -1, 0, 0); init_P_table('OTHERWISE ', 0, 5, 2); init_P_table('PACKED ', -1, 0, 0); init_P_table('POOL ', -1, 0, 0); init_P_table('PREFIX ', -1, 0, 0); init_P_table('PRIVATE ', 3, 2, 2); init_P_table('PROCEDURE ', 0, 2, 2); init_P_table('PROCESS ', 3, 2, 2); init_P_table('PROGRAM ', 3, 2, 2); init_P_table('PUBLIC ', 3, 2, 2); init_P_table('RECORD ', 0, 2, 3); init_P_table('REGION ', 0, 5, 2); init_P_table('REPEAT ', 0, 4, 2); init_P_table('SET ', -1, 0, 0); init_P_table('SHARED ', 3, 2, 2); init_P_table('SHIFT ', -1, 0, 0); init_P_table('SHL ', -1, 0, 0); init_P_table('SHR ', -1, 0, 0); init_P_table('STRING ', -1, 0, 0); init_P_table('THEN ', -1, 0, 0); init_P_table('TO ', -1, 0, 0); init_P_table('TYPE ', 3, 2, 2); init_P_table('TYPESIZE ', -1, 0, 0); init_P_table('UNIT ', 3, 2, 2); init_P_table('UNTIL ', 5, 0, 0); init_P_table('USES ', 3, 2, 2); init_P_table('VAR ', 3, 2, 2); init_P_table('VARSIZE ', -1, 0, 0); init_P_table('WHILE ', 0, 5, 2); init_P_table('WITH ', 0, 5, 2); init_P_table('XOR ', -1, 0, 0); END; (** initialize_1 **) PROCEDURE initialize_2; VAR i, last_i, j: integer; index: integer; BEGIN { Compress key table, to remove unused entries } index := 0; FOR i := 1 TO max_keyw_index DO BEGIN IF PascalTable[i].txt_str[1] <> ' ' THEN BEGIN index := index + 1; PascalTable[index] := PascalTable[i]; IF test_requested THEN writeln(' Key-word ', index:4, ' ', PascalTable[index].txt_str ); END; END; max_keyw_index := index; PascalTable[index+1].txt_str := 'zzz' { terminator for seach }; { initialize KEY_PTR array, used to speed search } last_i := ord('A') -1; FOR index := 1 TO max_keyw_index DO BEGIN IF ord( pascalTable[index].txt_str[1] ) > last_i THEN BEGIN i := ord( pascalTable[index].txt_str[1] ) ; FOR j := last_i + 1 TO i DO key_ptr[j] := index; last_i := i; END; END; FOR j := last_i+1 TO ord('Z')+1 DO key_ptr[j] := max_keyw_index+1; IF test_requested THEN FOR i := ord('A') TO ord('Z')+1 DO BEGIN write(Output, 'k_ix', i: 3, ' ', chr(i), ' '); write(Output, 'contents: ', key_ptr[i]: 3); writeln(Output); END; END {initialize_2}; PROCEDURE remove_key_word( key : alfa); VAR hi, lo, try: integer; BEGIN lo := 1; hi := max_keyw_index; REPEAT try := (lo+hi)DIV 2; WITH PascalTable[try] DO BEGIN IF key >= txt_str THEN lo := try+1; IF key <= txt_str THEN hi := try-1; END; UNTIL lo > hi; WITH PascalTable[try] DO BEGIN IF txt_str <> key THEN error('Internal table error '); txt_str := ' '; END; END {remove_key_word}; PROCEDURE Turbo_pascal_indent; VAR step: integer; BEGIN language := Turbo_pascal; (* remove non Turbo Pascal 4.0 or 5.0 key words from table *) remove_key_word('AS '); remove_key_word('BEGINBODY '); remove_key_word('CHANNEL '); remove_key_word('CONTINUELOOP '); remove_key_word('ENDLOOP '); remove_key_word('EXIT '); remove_key_word('EXITLOOP '); remove_key_word('EXPORT '); remove_key_word('GETSWITCH '); remove_key_word('INCLUDE '); remove_key_word('INSPECT '); remove_key_word('LOCK '); remove_key_word('LOCKBUF '); remove_key_word('LOCKDATA '); remove_key_word('LOCKMES '); remove_key_word('LOOP '); remove_key_word('MODULE '); remove_key_word('OPENROUTINE '); remove_key_word('OTHERWISE '); remove_key_word('POOL '); remove_key_word('PREFIX '); remove_key_word('PRIVATE '); remove_key_word('PROCESS '); remove_key_word('PUBLIC '); remove_key_word('REGION '); remove_key_word('SHARED '); remove_key_word('SHIFT '); remove_key_word('TYPESIZE '); remove_key_word('VARSIZE '); END; (* Turbo_pascal_indent *) PROCEDURE Pascal_86_indent; VAR step: integer; BEGIN language := Pascal_86; (* remove non PASCAL86 key words from table *) remove_key_word('ABSOLUTE '); remove_key_word('AS '); remove_key_word('BEGINBODY '); remove_key_word('CHANNEL '); remove_key_word('CONTINUELOOP '); remove_key_word('ENDLOOP '); remove_key_word('EXIT '); remove_key_word('EXITLOOP '); remove_key_word('EXPORT '); remove_key_word('GETSWITCH '); remove_key_word('IMPLEMENTATION'); remove_key_word('INCLUDE '); remove_key_word('INLINE '); remove_key_word('INSPECT '); remove_key_word('INTERFACE '); remove_key_word('INTERRUPT '); remove_key_word('LOCK '); remove_key_word('LOCKBUF '); remove_key_word('LOCKDATA '); remove_key_word('LOCKMES '); remove_key_word('LOOP '); remove_key_word('MODULE '); remove_key_word('OPENROUTINE '); remove_key_word('POOL '); remove_key_word('PREFIX '); remove_key_word('PROCESS '); remove_key_word('REGION '); remove_key_word('SHARED '); remove_key_word('SHIFT '); remove_key_word('SHL '); remove_key_word('SHR '); remove_key_word('STRING '); remove_key_word('TYPESIZE '); remove_key_word('UNIT '); remove_key_word('USES '); remove_key_word('VARSIZE '); remove_key_word('XOR '); END; (* Pascal_86_indent *) PROCEDURE Common_RTP_indent; VAR step: integer; BEGIN language := Common_RTP; (* remove non Common_RTP key words from table *) remove_key_word('ABSOLUTE '); remove_key_word('BEGINBODY '); remove_key_word('CHANNEL '); remove_key_word('EXPORT '); remove_key_word('FILE '); remove_key_word('IMPLEMENTATION'); remove_key_word('INCLUDE '); remove_key_word('INLINE '); remove_key_word('INTERFACE '); remove_key_word('INTERRUPT '); remove_key_word('LABEL '); remove_key_word('LOCK '); remove_key_word('LOCKMES '); remove_key_word('MODULE '); remove_key_word('NIL '); remove_key_word('OPENROUTINE '); remove_key_word('POOL '); remove_key_word('PREFIX '); remove_key_word('PRIVATE '); remove_key_word('PROCESS '); remove_key_word('PUBLIC '); remove_key_word('SHL '); remove_key_word('SHR '); remove_key_word('STRING '); remove_key_word('UNIT '); remove_key_word('USES '); END; (* Common_RTP_indent *) PROCEDURE RTP_8000_indent; VAR step: integer; BEGIN language := RTP_8000; (* remove non RTP-8000 key words from table *) remove_key_word('ABSOLUTE '); remove_key_word('FILE '); remove_key_word('GETSWITCH '); remove_key_word('IMPLEMENTATION'); remove_key_word('INLINE '); remove_key_word('INSPECT '); remove_key_word('INTERFACE '); remove_key_word('INTERRUPT '); remove_key_word('LOCKBUF '); remove_key_word('LOCKDATA '); remove_key_word('MODULE '); remove_key_word('NIL '); remove_key_word('OPENROUTINE '); remove_key_word('PRIVATE '); remove_key_word('PROGRAM '); remove_key_word('PUBLIC '); remove_key_word('REGION '); remove_key_word('SHARED '); remove_key_word('SHIFT '); remove_key_word('SHL '); remove_key_word('SHR '); remove_key_word('STRING '); remove_key_word('TYPESIZE '); remove_key_word('UNIT '); remove_key_word('USES '); remove_key_word('VARSIZE '); remove_key_word('XOR '); END; (* RTP_8000_indent *) PROCEDURE RTP_86_indent; VAR step: integer; BEGIN language := RTP_286; (* remove non RTP-86 key words from table *) remove_key_word('ABSOLUTE '); remove_key_word('BEGINBODY '); remove_key_word('CHANNEL '); remove_key_word('EXPORT '); remove_key_word('FILE '); remove_key_word('GETSWITCH '); remove_key_word('IMPLEMENTATION'); remove_key_word('INCLUDE '); remove_key_word('INLINE '); remove_key_word('INTERFACE '); remove_key_word('INTERRUPT '); remove_key_word('LABEL '); remove_key_word('MODULE '); remove_key_word('NIL '); remove_key_word('OPENROUTINE '); remove_key_word('POOL '); remove_key_word('PREFIX '); remove_key_word('PRIVATE '); remove_key_word('PROCESS '); remove_key_word('PUBLIC '); remove_key_word('SHL '); remove_key_word('SHR '); remove_key_word('STRING '); remove_key_word('TYPESIZE '); remove_key_word('UNIT '); remove_key_word('USES '); remove_key_word('VARSIZE '); END; (* RTP_86_indent *) PROCEDURE read_callparameters; VAR i, k: integer; key_text: STRING; dir_st: DirStr; name_st: NameStr; ext_st: ExtStr; BEGIN IF ( ParamCount = 0 ) OR ( ParamCount >= 1) AND ( ParamStr(1 ) = '?') THEN BEGIN { The user must give at least the input file as parameter } Showhelp; Halt; END; assign(Output, ''); rewrite(Output); Writeln(' INDENT (v.', version, ')' ); GetParams( Paramlist, MaxParam, OptionList, MaxOption); linesmode := OptionList[1].TextVal = 'ON'; markmode := OptionList[2].TextVal = 'ON'; IF OptionList[3].TextVal = 'ON' THEN BEGIN linesmode := true; markmode := true; END; CASE MatchOptionStr( OptionList[4].TextVal, 4, 'ON OFF OWN ') OF -1: Error(' Option not unique '); 0: Error(' Option not valid '); 1: BEGIN myind := false; noind := false; END; 2: BEGIN myind := false; noind := true; END; 3: BEGIN myind := true; noind := true; END; END (*case *); CASE MatchOptionStr( OptionList[5].TextVal, 4, 'LC UC OWN ') OF -1: Error(' Option not unique '); 0: Error(' Option not valid '); 1: reskeymode := ord(lckeyw_); 2: reskeymode := ord(uckeyw_); 3: reskeymode := ord(ownkeyw_); END (*case *); CASE MatchOptionStr( OptionList[6].TextVal, 4, 'LC UC OWN ') OF -1: Error(' Option not unique '); 0: Error(' Option not valid '); 1: idmode := ord(lcid_); 2: idmode := ord(ucid_); 3: idmode := ord(ownid_); END (*case *); CASE MatchOptionStr( OptionList[7].TextVal, 9, 'TURBO PASCAL86 C-RTP RTP8000 RTP286 ') OF -1: Error(' Option not unique '); 0: Error(' Option not valid '); 1: Turbo_pascal_indent; 2: Pascal_86_indent; 3: Common_RTP_indent; 4: RTP_8000_indent; 5: RTP_86_indent; END (*case *); test_requested := OptionList[8].TextVal = 'ON'; inpfile := ParamList[1].TextVal; IF ParamList[2].Defined THEN outpfile := ParamList[2].TextVal ELSE BEGIN FSplit(inpfile, dir_st, name_st, ext_st); IF UpperStr(ext_st) = 'IND' THEN Error(' FileName Clash'); outpfile := dir_st + name_st + '.IND'; END; IF FileExist(outpfile) THEN BEGIN (* query to user*) write(Output, outpfile:1); write(Output, ', already exists, OVERWRITE (Y/N)?'); assign(Input, ''); reset(Input); read(Input, ch); IF NOT ((ch = 'y') OR (ch = 'Y')) THEN halt; (*i.e.: exit program*) END; assign(inp, inpfile); SetTextBuf(inp, I_buff); reset(inp); assign(outp, outpfile); SetTextBuf(outp, O_buff); rewrite(outp); END (* READ_CALLPARAMS *); PROCEDURE writeeol; BEGIN linepos := 0; IF formfeed THEN BEGIN write(outp, chr(FF)); END ELSE writeln(outp); END; PROCEDURE pushmark(c_pos: integer); BEGIN IF markpointer0 THEN markpointer := markpointer-1; IF test_requested THEN Writeln(outp, 'M-',markpointer:3, ' '); END; FUNCTION resword( name: alfa; VAR index: integer): boolean; VAR hi, lo, i: integer; BEGIN i := ord(name[1]); lo := key_ptr[i]; hi := key_ptr[i+1]; IF hi = lo THEN resword := false ELSE BEGIN REPEAT index := (lo+hi) DIV 2; WITH PascalTable[index] DO BEGIN IF name >= txt_str THEN lo := index+1; IF name <= txt_str THEN hi := index-1; END; UNTIL lo > hi; resword := PascalTable[index].txt_str = name; END; END {resword}; PROCEDURE changeletters(lowercase: boolean;c_pos: integer); VAR i, add: integer; ch, a, z: char; BEGIN IF lowercase THEN BEGIN add := 32; a := 'A'; z := 'Z'; END ELSE BEGIN add := -32; a := 'a'; z := 'z'; END; i := c_pos; REPEAT ch := line[i]; IF (ch >= a) AND (ch <= z) THEN line[i] := chr(ord(ch)+add); i := i-1; UNTIL NOT((ch IN alfanum) OR ((ch >= 'a') AND (ch <= 'z'))) OR (i = 0); END; PROCEDURE shiftcase; (*CHANGE IDENTIFIERS TO LC OR UC AND KEYWORDS TO LC OR UC *) VAR k, c_pos: integer; key: alfa; current: char; BEGIN c_pos := 1; current := line[c_pos]; WHILE c_pos <= lastpos DO BEGIN IF skiptekst THEN BEGIN IF current = skipchar THEN BEGIN IF ((skipchar = '*') AND (line[c_pos+1] = ')')) OR (skipchar <> '*') THEN skiptekst := false; END; END ELSE BEGIN IF (current >= 'a') AND (current <= 'z') THEN current := chr(ord(current)-32); CASE current OF 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z': BEGIN k := 1; key := ' '; REPEAT (*PICK UP IDENTIFIER *) IF k <= alfalength THEN BEGIN key[k] := current; k := k+1; END; c_pos := c_pos+1; current := line[c_pos]; IF (current >= 'a') AND (current <= 'z') THEN current := chr(ord(current)-32); UNTIL NOT (current IN alfanum); c_pos := c_pos-1; IF resword( key, keyw_index) THEN BEGIN IF reskeymode <> ord(ownkeyw_) THEN changeletters(reskeymode = ord(lckeyw_) , c_pos) END ELSE IF idmode <> ord(ownid_) THEN changeletters(idmode = ord(lcid_), c_pos); END; '0', '1', '2', '3', '4', '5', '6', '7', '8', '9': BEGIN REPEAT c_pos := c_pos+1 UNTIL NOT (line[c_pos] IN ['0'..'9']); IF line[c_pos] = '(' THEN c_pos := c_pos-1; (*MIGHT BE START OF COMMENT *) END; '(': IF line[c_pos+1] = '*' THEN BEGIN skiptekst := true; skipchar := '*'; c_pos := c_pos+1; END; '<': IF (language <> Turbo_pascal ) AND ( line[c_pos+1] = '*') THEN BEGIN skiptekst := true; skipchar := '*'; c_pos := c_pos+1; END; '''', '"': BEGIN skiptekst := true; skipchar := current; END; '-': IF (language <> Turbo_pascal ) AND ( line[ c_pos + 1 ] = '-') THEN (* RTP86-comment *) BEGIN c_pos := lastpos; (*i.e.: skipp rest of line *) END; '{': (* TurboPascal comment string *) IF language = turbo_pascal THEN BEGIN skiptekst := true; skipchar := '}'; END; ELSE ; END; END; c_pos := c_pos+1; current := line[c_pos]; END; END; PROCEDURE pushindent(prioritet, indention: integer); (*STACK ONE LEVEL OF INDENTION *) BEGIN WITH stacktop DO BEGIN IF top < ssize THEN top := top+1; prior := prioritet; indent := indention-oldpos; oldpos := c_pos; margin := margin+indent; stack[top] := stacktop; END; END; PROCEDURE popindent; (*REMOVE ONE LEVEL OF INDENTION FROM STACK*) BEGIN IF top > 0 THEN top := top-1; margin := margin-stacktop.indent; IF oldpos > 0 THEN oldpos := oldpos-stacktop.indent; stacktop := stack[top]; END; PROCEDURE pasidentifier; (* CHECKS IF IDENTIFIER IS A KEYWORD WITH EFFECT ON INDENTION. IF SO, INDENTION IS ADJUSTED*) (* AS ONLY ONE KEYWORD MAY AFFECT INDENTION - CURRENT LINE MUST BE PRINTED OUT AS SOON AS THE FIRST KEYWORD WITH EFFECT ON INDENTION IS FOUND. *) VAR a: ARRAY[0..alfalength] OF char; key: alfa; k, hi, lo, try: integer; BEGIN IF key_ptr[ord(current)] <> key_ptr[ord(current)+1] THEN k := 0 ELSE k := toplength + 1; REPEAT IF k < toplength THEN a[ k ] := current; k := k + 1; c_pos := c_pos+1; current := line[c_pos]; IF (current >= 'a') AND (current <= 'z') THEN current := chr(ord(current)-32); UNTIL NOT(current IN alfanum) ; IF (k <= toplength) AND (k > 1) THEN BEGIN (* MIGHT BE INTERESTING KEYWORD*) FOR hi := k TO alfalength DO a[ hi ] := blank; key := copy(a, 1, alfalength); IF resword( key, keyw_index ) THEN WITH PascalTable[keyw_index] DO BEGIN IF test_requested THEN Writeln(outp, 'ResW ', p1:4, p2:4 , ' ', Key); IF Key = 'DO ' THEN InWith := false; IF p1 <> -1 THEN WITH stacktop DO BEGIN (* KEYWORD AFFECTING MARGIN IS FOUND *) old_state := state; IF (txt_str = 'END ') OR (txt_str = 'UNTIL ') OR (txt_str = 'OTHERWISE ') OR (txt_str = 'ENDLOOP ') THEN semicolon ELSE IF (txt_str = 'PUBLIC ') OR (txt_str = 'UNIT ') THEN state := spublic ELSE IF (txt_str = 'PROGRAM ') OR (txt_str = 'PROCESS ') OR (txt_str = 'PRIVATE ') OR (txt_str = 'IMPLEMENTATION') THEN state := declare ELSE IF (txt_str = 'TYPE ') OR (txt_str = 'CONST ') OR (txt_str = 'VAR ') OR (txt_str = 'SHARED ') THEN BEGIN IF state <> spublic THEN state := declare; END ELSE IF txt_str = 'BEGIN ' THEN state := statement; IF test_requested AND ( state <> old_state ) THEN Writeln(outp, ' New State = ', ord(state), ' old = ', ord(old_state) ); (* SEE IF UNSTACKING*) IF prior < p1 THEN BEGIN IF (txt_str = 'END ') AND (Norecord > 0) THEN BEGIN (*SPECIAL HANDLING OF RECORD *) margin := margin-3; IF fresh THEN printline; margin := margin+3; IF oldpos > 0 THEN oldpos := oldpos-indent; Norecord := NoRecord - 1; END; margin := margin-indent; top := top-1; stacktop := stack[top]; END ELSE IF ((State = sPublic) AND ((txt_str = 'PROCEDURE ') OR (txt_str = 'FUNCTION '))) THEN BEGIN (* unstack *) margin := margin - indent; top := top - 1; stacktop := stack[top]; END; IF fresh THEN printline; (** SEE COMMENT IN BEGINNING OF PROCEDURE!! **) (* SEE IF STACKING*) (** IF p2 = 0 THEN ACTUAL KEYWORD DOES NOT CAUSE FURTHER INDENTION IN THE FOLLOWING LINES **) IF p2>0 THEN IF (txt_str = 'CASE ') AND (state <> statement) THEN BEGIN margin := margin+spacing; indent := indent+spacing; stack[top] := stacktop; END ELSE BEGIN IF top < ssize THEN top := top+1; prior := p2; IF txt_str = 'RECORD ' THEN BEGIN indent := spacing+c_pos-7-oldpos; oldpos := spacing+c_pos-7; NoRecord := NoRecord + 1; END ELSE indent := spacing; margin := margin+indent; stack[top] := stacktop END; IF ( txt_str = 'FUNCTION ') OR (txt_str = 'PROGRAM ') OR (txt_str = 'PROCEDURE ') OR (txt_str = 'PROCESS ') THEN skip(';') ELSE IF( txt_str = 'WITH ') THEN BEGIN InWith := true; OldPos := Spacing; END ELSE IF ( txt_str = 'END ' ) AND ( current = '.' ) THEN BEGIN IF fresh THEN Printline; WHILE NOT eof(inp) DO (** Copy from input to output-file **) BEGIN readln(inp, dummy_line); writeln(outp, dummy_line); END; END; IF markmode THEN BEGIN IF (key = 'BEGIN ') OR (key = 'REPEAT ') OR ( key = 'LOOP ') OR ((key = 'CASE ') AND (state = statement)) OR (key = 'RECORD ') THEN pushmark(margin+1 - spacing) ELSE IF (key = 'END ') OR (key = 'UNTIL ') OR (key = 'ENDLOOP ') THEN popmark; END; END; (* taking care of interesting keywords *) END; (* if resword ... *) END (* K IN [2..alfalength] *) END (* IDENTIFIER*); PROCEDURE semicolon; (* UNSTACK UNTIL STACKTOP DOES NOT CONTAIN IF OR ELSE*) BEGIN WITH stacktop DO WHILE prior = 5 DO BEGIN margin := margin-indent; top := top-1; stacktop := stack[top]; IF test_requested THEN writeln(outp, '; ->', top:4, stacktop.indent:4, stacktop.prior:4 ); END END (* SEMICOLON*); PROCEDURE printline; VAR c_pos: integer; BEGIN fresh := false (* Flag that LINE is PRINTED*); IF test_requested THEN BEGIN Write(outp, margin:4, top:4, stack[top].indent:4, stack[top].prior:4); Write(outp, ' '); END; IF linesmode THEN BEGIN (* PRINT LINE NUMBER *) write(outp, lineno: 5, ': '); lineno := lineno+1; END; IF NOT noind THEN write(outp, blank); (*** ***) IF (noind <> true) THEN IF NOT (lastpos = 0) OR markmode THEN (*AN EMPTY LINE IS NOT SPACED*) BEGIN nextmark := 1; FOR c_pos := 1 TO margin DO (** "margin" number of blanks are printed out. - Perhabs including a "mark". **) BEGIN IF markmode THEN BEGIN IF c_pos = markstack[nextmark] THEN BEGIN write(outp, '!'); nextmark := nextmark+1; END ELSE write(outp, blank); END ELSE write(outp, blank); END; (* markmode *) END; (* for *) IF lastpos <> 0 THEN write(outp, copy(line, 1, lastpos) ); writeeol; END; (*PRINTLINE*) PROCEDURE readline; VAR c_pos: integer; BEGIN lastpos := 0; oldpos := 0; fresh := true (* New LINE is READ, NOT printed Yet*); ch := blank; IF formfeed THEN BEGIN (* Move the rest of line kept in line_after_ff *) line := copy(line_after_ff, 1, length(line_after_ff) ); formfeed := false; END ELSE BEGIN readln(inp, line); IF length(line) = lsize THEN BEGIN line_too_long := line_too_long + 1; line := copy(line, 1, lsize-1); (* neaded for terminating space *) END; END; c_pos := Pos(chr(FF), line) (* Test whether FF in line *); IF c_pos > 0 THEN BEGIN (* Save the line part before FF in line. Save the line part after the last ff ( if more than one ) in line_after_ff, and remember the fact that something is keept by setting formfeed = true *) formfeed := true; lastpos := c_pos - 1; WHILE ( line[c_pos] = chr(FF) ) AND ( c_pos <= length(line) ) DO c_pos := c_pos + 1; line_after_ff := copy(line, c_pos, 255); line := copy(line, 1, lastpos); END; (* if FF *) c_pos := 1; IF myind = false THEN (* Preceeding blanks and tabs in line are skipped - if wanted. *) WHILE ((line[c_pos] = blank) OR (line[c_pos] = chr(ordoftab))) AND (c_pos <= length(line) ) AND (line[c_pos] <> chr(FF)) DO c_pos := c_pos + 1; lastpos := length(line); WHILE ( line[lastpos] = blank ) AND ( lastpos >= 1 ) DO lastpos := lastpos - 1; (* Now "lastpos" points at the last character <> blank in the line *) line := copy( line, c_pos, lastpos) + ' ' (*ensure blank in line*); lastpos := length(line) - 1; IF (idmode <> ord(ownid_)) OR (reskeymode <> ord(ownkeyw_)) THEN shiftcase; END (* READLINE*); PROCEDURE skip; LABEL 11; (* exit in case of eof *) BEGIN IF fresh THEN printline; REPEAT IF c_pos >= lastpos THEN IF eof_inp THEN BEGIN skiperror := true; GOTO 11; END ELSE BEGIN readline; printline; c_pos := 0; END; c_pos := c_pos+1; current := line[c_pos]; IF ((skipend = ';') OR (skipend = ')')) AND (current = '(') AND (line[c_pos+1] <> '*') THEN REPEAT (*SKIP PARAMETERLIST *) skip(')'); c_pos := c_pos + 1; current := line[c_pos]; UNTIL line[c_pos-2] <> '*'; UNTIL current = skipend; IF skipend = ':' THEN BEGIN c_pos := c_pos + 1; current := line[c_pos]; END; 11: END; (***** ---------- *****) (* MAIN PROGRAM*) BEGIN initialize_1; read_callparameters; initialize_2; IF markmode THEN BEGIN FOR c_pos := -1 TO lsize DO markstack[c_pos] := 0; END; WHILE NOT eof_inp DO BEGIN readline; c_pos := 1; current := line[c_pos]; WHILE c_pos <= lastpos DO BEGIN IF (current >= 'a') AND (current <= 'z') THEN current := chr(ord(current)-32); IF (current IN ['A'..'Z']) THEN pasidentifier ELSE BEGIN CASE current OF ';': semicolon; '(': BEGIN IF line[c_pos+1] = '*' THEN BEGIN IF c_pos = 1 (* i.e. in front of the line *) THEN pushindent(4, 2) (* indent 2 more positions *) ELSE pushindent(4, c_pos - 1); (* no further indention caused by comment *) REPEAT skip('*') UNTIL line[c_pos+1] = ')'; c_pos := c_pos+1; popindent; END ELSE IF state <> statement THEN pushindent(4, c_pos); (* INDENTION OF SCALAR TYPES AND VARIANT FIELDS IN RECORDS *) END; '<': BEGIN IF (language <> turbo_pascal ) AND ( line[c_pos+1] = '*') THEN BEGIN IF c_pos = 1 (* i.e. in front of the line *) THEN pushindent(4, 2) (* indent 2 more positions *) ELSE pushindent(4, c_pos - 1); (* no further indention caused by comment *) REPEAT skip('*') UNTIL line[c_pos+1] = '>'; c_pos := c_pos+1; popindent; END ELSE IF state <> statement THEN skip('>') (* value initialization of array *) END; ')': BEGIN IF state <> statement THEN BEGIN(*UNSTACK INDENTION OF SCALAR TYPES AND VARIANT PARTS IN RECORDS*) popindent; END; END; ':': IF InWith = false THEN IF line[c_pos+1] <> ' = ' THEN IF state = statement THEN BEGIN (*INDENTION OF CASELABELS *) semicolon; (*POP PREVIOUS STACKED CASELABELS AND IFSTATEMENTS *) pushindent(5, oldpos + 2); END; '-': IF (language <> turbo_pascal ) AND ( line[ c_pos + 1 ] = '-') THEN (* RTP86 comment - skip to eol *) IF c_pos = 1 (* i.e. in front of the line *) THEN BEGIN pushindent(4, 2); (* indent 2 more positions *) printline; popindent; c_pos := lastpos; END ELSE c_pos := lastpos; (** i.e.: skip rest of line **) (*** end RTP86 comment ***) '''': skip(''''); (* text string *) '"': skip('"'); (* text string *) '{': (* Turbo Pascal Text string *) IF language = turbo_pascal THEN BEGIN IF c_pos = 1 (* i.e. in front of the line *) THEN pushindent(4, 2) (* indent 2 more positions *) ELSE pushindent(4, c_pos - 1); (* no further indention caused by comment *) skip('}'); popindent; END; '$': BEGIN oldpos := margin; margin := 1; IF fresh THEN printline; margin := oldpos; c_pos := lastpos; END; ELSE BEGIN (* ALL OTHER ARE BLIND*) END; END; c_pos := c_pos+1; current := line[c_pos]; END; IF fresh THEN printline END (* SCAN OF LINE*); IF fresh THEN printline; END (* SCAN OF INPUT FILE *); IF fewends THEN writeln(Output, ' ** WARNING, END(S) MISSING.'); IF skiperror THEN writeln(Output, ' ** premature end of file '); IF line_too_long > 0 THEN writeln(Output, line_too_long:1, ' lines truncated after ', lsize:1,' characters.'); Close(inp); Close(outp); END.