|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 37888 (0x9400)
Types: TextFile
Names: »INDENT.ORG«
└─⟦e2123b2a1⟧ Bits:30010498 DVBS1.SW2103.src.1.8-1 Pascal TOOLS JTAS 1989-04-26 LEIF NIELSEN E.d.
└─⟦this⟧ »INDENT.ORG«
module indent;\r
$include(pscplm.ext)\r
$include(rtp86rmx.ext)\r
\r
\r
program indent;\r
(* version 84.02.13 *)\r
LABEL 10;\r
CONST\r
blank= ' ';\r
lsize= 240; (* LONGEST LINE*)\r
ssize= 90; (* DEEPEST STACK LOAD*)\r
ksize= 57; (* ENTIRE NO OF KEYWORDS*)\r
tsize= 31; (* NO OF INTERESTING KEYWORDS *)\r
keynumsize= 13;\r
toplength= 12; (* longest identifier *)\r
\r
alfalength= 12;\r
\r
space= 32;\r
ordoftab= 9;\r
\r
lf= 10;\r
ff= 12;\r
cr= 13;\r
\r
\r
TYPE\r
alfa= packed array [ 1..alfalength ] of char;\r
\r
options= (ident, CI, CO, to_, over_, ind_, ownind_, noind_, \r
ownkeyw_, lckeyw_, uckeyw_, ownid_, lcid_, ucid_, \r
lines_, mark_, list_, error_);\r
\r
stackelement= RECORD\r
prior, indent: integer\r
END;\r
tablelement= RECORD\r
string: alfa;\r
p1, p2, spacing: integer\r
END;\r
\r
\r
VAR\r
start_prio: byte;\r
exc: word;\r
outpfile, inpfile: path_alfa;\r
opmess, opinp, \r
outp: text;\r
inp: file of byte;\r
\r
\r
eol: boolean; (** false until END-OF-LINE is met **)\r
\r
alfanum: SET OF char; (*HOLDS SET OF ALPHANUMERIC SYMBOLS *)\r
line: ARRAY[0..lsize] OF char; (* LINE LEFT JUSTIFIED*)\r
pos: integer; (* POINTER TO CURRENT CHARACTER*)\r
lastpos: integer; (* LAST POSITION ON CURRENT LINE*)\r
linepos: integer; (* POINTER TO LAST USED PRINTPOS*)\r
lineno: integer; (* LINE NUMBER OF CURRENT LINE *)\r
current, ch: char; (* CH IS FIRST CHAR ON NEXT LINE*)\r
fresh: boolean; (* LINE READ, NOT YET PRINTED*)\r
margin: integer; (* HANDLES INDENTION*)\r
oldpos: integer; (* USED TO HOLD POSITIONS IN RECORDS*)\r
state: (spublic, declare, statement);\r
skiperror, formfeed, myind, \r
before_program, (* false until FILE, MODULE, SHARED, LOCK, LOCKBUF, or AS met, \r
i.e. until it can be decided whether input is a PASCAL86-\r
program or a RTP86-program *)\r
noind, fewends: boolean;\r
linesmode, markmode: boolean;\r
\r
idmode, \r
reskeymode: byte;\r
\r
\r
\r
skiptekst: boolean; (*USED IN SHIFTCASE*)\r
endcomment, (* '>' or ')' depending on the start of the comment *)\r
skipchar: char; (*USED IN SHIFTCASE *)\r
\r
markstack: ARRAY[-10..lsize] OF integer;\r
markpointer, nextmark: integer;\r
\r
\r
\r
stack: ARRAY[0..ssize] OF stackelement;\r
top: integer; (* STACK POINTER *)\r
stacktop: stackelement; (* HOLDS STACK[TOP]*)\r
PascalTable: ARRAY[1..TSize] OF tablelement;\r
(* tabel contains interesting *)\r
PascalKeys: ARRAY[1..ksize] OF alfa;\r
keynum: ARRAY[1..keynumsize] OF integer;\r
\r
option_text: array[options] of alfa;\r
\r
\r
NoRecord: integer; (* gives the number of records.\r
inc. by 1 on keyword 'Record'. Dec by one on\r
end record *)\r
\r
\r
InWith: boolean; (* true if passing With ... do *)\r
\r
procedure error(e_txt1: alfa);\r
begin\r
writeln(opmess);\r
writeln(opmess, '*** INDENT ERROR ***', e_txt1);\r
\r
goto 10; (** i.e.: EXIT program **)\r
end (*error*);\r
\r
\r
(*** NEW READ PROCEDURES FOR READING BYTE-FILES ***)\r
procedure read_(var c: char);\r
begin\r
\r
if inp^<32 then\r
\r
eol:= false;\r
\r
c:= chr(inp^);\r
get(inp);\r
\r
if (c=chr(cr)) and (inp^=lf) then\r
begin\r
Get(inp);\r
eol:= true;\r
c:= blank;\r
end\r
else\r
if (inp^=ff) or eof(inp) then\r
eol:= true;\r
\r
end; (** read_ **)\r
\r
procedure readln_;\r
var\r
dummy: char;\r
begin\r
while not eol do read_(dummy);\r
eol:= false;\r
end;\r
\r
(*** END READ-PROCEDURES ***)\r
\r
\r
PROCEDURE initialize;\r
VAR\r
opt: options;\r
\r
i, j: integer;\r
prev_keylgth, \r
k_ix, \r
index: integer;\r
\r
procedure init_p_table(a: alfa;a1, a2, a3: integer);\r
begin\r
with pascaltable[index] do\r
begin\r
string:= a;\r
p1:= a1;\r
p2:= a2;\r
spacing:= a3;\r
end;\r
index:= index+1;\r
end;\r
\r
procedure init_p_key(a: alfa);\r
var\r
curr_keylgth: integer;\r
ch: char;\r
begin\r
pascalkeys[index]:= a;\r
index:= index+1;\r
\r
(** Now "pascalkeys(index)" is initiated ! **)\r
(* In the following it is found out whther "keynum" \r
is to be updated or not. *)\r
\r
(** Find length of "a" **)\r
curr_keylgth:= 1; ch:= a[1];\r
while (ord(ch)<>space) and (curr_keylgth<alfalength) do\r
begin\r
curr_keylgth:= curr_keylgth + 1;\r
ch:= a [ curr_keylgth ];\r
end;\r
if ord(ch)=space then\r
curr_keylgth:= curr_keylgth - 1;\r
\r
(** Adjust evt. array "keynum" - holding pointers to "pascalkeys"\r
telling where in table keys of a certain length is starting *)\r
\r
if curr_keylgth<= keynumsize then\r
begin\r
if curr_keylgth>k_ix then\r
begin\r
while k_ix<curr_keylgth do\r
begin\r
k_ix:= k_ix + 1;\r
keynum [ k_ix ]:= index - 1;\r
end;\r
\r
\r
end\r
end\r
else error('err keysize ');\r
\r
end;\r
\r
BEGIN\r
\r
reset(opinp, ':CI: ');\r
rewrite(opmess, ':CO: ');\r
Writeln(opmess, ' RC3900 INDENT '); \r
\r
eol:= false;\r
\r
\r
init_argument;\r
option_text[ CI ] := ':CI: ';\r
option_text[ CO ] := ':CO: ';\r
option_text[to_] := 'TO ';\r
option_text[over_] := 'OVER ';\r
option_text[ind_] := 'IND ';\r
option_text[ownind_] := 'OWNIND ';\r
option_text[noind_] := 'NOIND ';\r
option_text[ownkeyw_]:= 'OWNKEYW ';\r
option_text[lckeyw_] := 'LCKEYW ';\r
option_text[uckeyw_] := 'UCKEYW ';\r
option_text[ownid_] := 'OWNID ';\r
option_text[lcid_] := 'LCID ';\r
option_text[ucid_] := 'UCID ';\r
option_text[lines_] := 'LINES ';\r
option_text[mark_] := 'MARK ';\r
option_text[list_] := 'LIST ';\r
\r
for opt:= succ(ident) to pred(error_) do \r
j:= insert_key(option_text[opt]);\r
(** The value of "j" is the same as the value of "opt" **)\r
\r
\r
(** default options **)\r
noind := false;\r
myind := false;\r
linesmode := false;\r
markmode := false;\r
idmode := ord(lcid_);\r
reskeymode:= ord(uckeyw_);\r
\r
\r
\r
alfanum:= ['0'..'9', 'A'..'Z', '_'];\r
linepos:= 0;\r
lineno:= 1;\r
before_program:= true;\r
fewends:= false;\r
skiptekst:= false;\r
skiperror:= false;\r
markpointer:= 0;\r
\r
top:= 1;\r
\r
\r
(** Searching in this table is done by means of "binary search" on\r
the keywords. For this reason the keywords has to be put into the table\r
in alphabetical order!!! **)\r
(*ad the parameters: *)\r
index:= 1;\r
init_p_table('BEGIN ', 4, 4, 2);\r
init_p_table('CASE ', 0, 4, 2);\r
init_p_table('CONST ', 3, 2, 2);\r
init_p_table('ELSE ', 6, 5, 2);\r
init_p_table('END ', 5, 0, 0);\r
init_p_table('ENDLOOP ', 5, 0, 0);\r
init_p_table('EXTERNAL ', 4, 0, 0);\r
init_p_table('FOR ', 0, 5, 2);\r
init_p_table('FORWARD ', 4, 0, 0);\r
init_p_table('FUNCTION ', 0, 2, 2);\r
init_p_table('IF ', 0, 5, 2);\r
init_p_table('LABEL ', 3, 2, 2);\r
init_p_table('LOCK ', 0, 5, 2);\r
init_p_table('LOCKBUF ', 0, 5, 2);\r
init_p_table('LOOP ', 0, 4, 2);\r
init_p_table('MODULE ', 3, 2, 2);\r
init_p_table('OPENROUTINE ', 4, 0, 0);\r
init_p_table('OTHERWISE ', 0, 5, 2);\r
init_p_table('PRIVATE ', 3, 2, 2);\r
init_p_table('PROCEDURE ', 0, 2, 2);\r
init_p_table('PROGRAM ', 3, 2, 2); \r
init_p_table('PUBLIC ', 3, 2, 2);\r
init_p_table('RECORD ', 0, 2, 3);\r
init_p_table('REGION ', 0, 5, 2);\r
init_p_table('REPEAT ', 0, 4, 2);\r
init_p_table('SHARED ', 3, 2, 2);\r
init_p_table('TYPE ', 3, 2, 2);\r
init_p_table('UNTIL ', 5, 0, 0);\r
init_p_table('VAR ', 3, 2, 2);\r
init_p_table('WHILE ', 0, 5, 2);\r
init_p_table('WITH ', 0, 5, 2);\r
\r
\r
(** Searching in the following table is done by 'binary search'\r
on the length of the keywords. Because of that the table \r
"keynum" is present and the keywords has to be put into the table\r
in increasing length **)\r
\r
for k_ix:= 1 to keynumsize do\r
keynum [ k_ix ]:= kSize;\r
k_ix:= 1;\r
index:= 1;\r
keynum [ k_ix ]:= index;\r
(**)\r
init_p_key('IF ');\r
init_p_key('DO ');\r
init_p_key('OF ');\r
init_p_key('TO ');\r
init_p_key('IN ');\r
init_p_key('AS ');\r
init_p_key('OR ');\r
init_p_key('END ');\r
init_p_key('FOR ');\r
init_p_key('VAR ');\r
init_p_key('DIV ');\r
init_p_key('MOD ');\r
init_p_key('SET ');\r
init_p_key('AND ');\r
init_p_key('NOT ');\r
init_p_key('XOR ');\r
init_p_key('NIL ');\r
init_p_key('THEN ');\r
init_p_key('ELSE ');\r
init_p_key('WITH ');\r
init_p_key('GOTO ');\r
init_p_key('CASE ');\r
init_p_key('LOCK ');\r
init_p_key('TYPE ');\r
init_p_key('FILE ');\r
init_p_key('LOOP ');\r
init_p_key('EXIT ');\r
init_p_key('BEGIN ');\r
init_p_key('UNTIL ');\r
init_p_key('WHILE ');\r
init_p_key('ARRAY ');\r
init_p_key('CONST ');\r
init_p_key('LABEL ');\r
init_p_key('SHIFT ');\r
init_p_key('REPEAT ');\r
init_p_key('RECORD ');\r
init_p_key('DOWNTO ');\r
init_p_key('PACKED ');\r
init_p_key('REGION ');\r
init_p_key('SHARED ');\r
init_p_key('MODULE ');\r
init_p_key('PUBLIC ');\r
init_p_key('ENDLOOP ');\r
init_p_key('INSPECT ');\r
init_p_key('FORWARD ');\r
init_p_key('LOCKBUF ');\r
init_p_key('PROGRAM ');\r
init_p_key('PRIVATE ');\r
init_p_key('FUNCTION ');\r
init_p_key('EXITLOOP ');\r
init_p_key('EXTERNAL ');\r
init_p_key('PROCEDURE ');\r
init_p_key('OTHERWISE ');\r
init_p_key('OPENROUTINE ');\r
init_p_key('CONTINUELOOP');\r
init_p_key(' ');\r
\r
(*** TESTOUTPUT ***)\r
(**for i:= 1 to keynumsize do\r
begin\r
write(opmess, 'k_ix', i: 3);\r
write(opmess, 'contents: ', keynum[i]: 3);\r
writeln(opmess);\r
end;**)\r
\r
\r
Margin:= 3;\r
\r
FOR i:= 1 TO lsize DO line[i]:= blank;\r
stack[0].prior:= 10; (* bottom never unstack *)\r
stack[0].indent:= 0;\r
stack[1].indent:= 2;\r
stack[1].prior:= 2;\r
stacktop:= stack[1];\r
line[ 0 ]:= ' '; (* anything<>from *, used in skip *)\r
state:= declare;\r
NoRecord:= 0;\r
InWith:= false;\r
\r
formfeed:= false;\r
END; (** initialize **)\r
\r
\r
PROCEDURE pascal86_indent;\r
VAR\r
step: integer;\r
\r
BEGIN\r
before_program:= false;\r
\r
(* remove non PASCAL86 key words from table *)\r
(* i.e.: AS, XOR, LOCK, EXIT, LOOP, SHIFT, REGION, SHARED, ENDLOOP, LOCKBUF, \r
INSPECT, EXITLOOP, EXTERNAL, OPENROUTINE and CONTINUELOOP *)\r
\r
FOR step:= keynum [ 2 (* length of word AS *) ] TO\r
keynum [ 12 (* length of word CONTINUELOOP *) + 1 ] DO\r
IF (PascalKeys [ step ]='AS ') OR\r
(PascalKeys [ step ]='XOR ') or\r
(PascalKeys [ step ]='LOCK ') or\r
(PascalKeys [ step ]='EXIT ') or\r
(PascalKeys [ step ]='LOOP ') or\r
(PascalKeys [ step ]='SHIFT ') or\r
(PascalKeys [ step ]='REGION ') or\r
(PascalKeys [ step ]='SHARED ') or\r
(PascalKeys [ step ]='ENDLOOP ') or\r
(PascalKeys [ step ]='LOCKBUF ') or\r
(PascalKeys [ step ]='INSPECT ') or\r
(PascalKeys [ step ]='EXITLOOP ') or\r
(PascalKeys [ step ]='EXTERNAL ') or\r
(PascalKeys [ step ]='OPENROUTINE ') or\r
(PascalKeys [ step ]='CONTINUELOOP') THEN PascalKeys [ step ]:= ' ';\r
\r
END; (* PASCAL86 indent *)\r
\r
\r
PROCEDURE RTP86_indent;\r
VAR\r
step: integer;\r
\r
BEGIN\r
before_program:= false;\r
\r
(* remove non RTP-86 key words from table *)\r
(* i.e.: NIL, FILE, LABEL, MODULE, PUBLIC, PRIVATE *)\r
\r
FOR step:= keynum [ 3 (* length of word NIL *) ] TO\r
keynum [ 7 (* length of word PRIVATE *) + 1 ] DO\r
IF (PascalKeys [ step ]='NIL ') OR\r
(PascalKeys [ step ]='FILE ') OR\r
(PascalKeys [ step ]='LABEL ') OR\r
(PascalKeys [ step ]='MODULE ') or\r
(PascalKeys [ step ]='PUBLIC ') OR\r
(PascalKeys [ step ]='PRIVATE ') THEN PascalKeys [ step ]:= ' ';\r
\r
END; (* RTP86 indent *)\r
\r
\r
\r
procedure read_callparameters;\r
const\r
stop_key= 255;\r
e_ok= 0;\r
\r
var\r
d, key: byte;\r
e: word;\r
key_string, \r
inp_path, outp_path: string;\r
write_to: boolean;\r
\r
procedure check_argument(d, key: byte;e: word);\r
begin\r
\r
\r
if (e<>e_ok) or\r
((d<>cr) and (d<>space)) or\r
(key=ord(error_)) then\r
begin\r
error('argument err');\r
end;\r
end (*check_argument*);\r
\r
\r
begin (** body of READ_PARAMS **)\r
\r
d:= get_argument(inp_path, key, e);\r
check_argument(d, key, e);\r
\r
if (inp_path.length<>0 ) AND (key<>ord(co)) and file_exist(inp_path) then\r
begin (* open inp-file *)\r
path_to_alfa(inp_path, inpfile);\r
reset(inp, inpfile);\r
end\r
else\r
begin\r
IF inp_path.length<>0 THEN\r
begin\r
writeln(opmess, inp_path.alfa: inp_path.length);\r
error('ill. inpfile');\r
END\r
ELSE\r
error('no inputfile');\r
end;\r
\r
\r
(** set up default-outputfile **)\r
write_to:= false; (*i.e.: OVER is default *)\r
change_ext(inp_path, outp_path, 'IND ');\r
\r
(******)\r
\r
if d=space (*delimiter telling there are more arguments*) then\r
begin\r
d:= get_argument(key_string, key, e);\r
check_argument(d, key, e);\r
\r
if (key=ord(to_)) or (key=ord(over_)) then\r
begin\r
write_to:= (key=ord(to_));\r
\r
(** get ouputfile-specification **)\r
d:= get_argument(outp_path, key, e);\r
check_argument(d, key, e);\r
\r
if key=ord(CI) then\r
begin\r
writeln(opmess, outp_path.alfa: outp_path.length);\r
error('ill outpfile');\r
end;\r
\r
\r
if write_to and (key<>ord(co)) then\r
if file_exist(outp_path) then\r
begin\r
(* query to user*)\r
write(opmess, outp_path.alfa: outp_path.length);\r
write(opmess, ', already exists, DELETE?');\r
read(opinp, ch);\r
if not ((ch='y') or (ch='Y')) then\r
goto 10; (*i.e.: exit program*)\r
end;\r
\r
\r
if d=space then\r
begin\r
d:= get_argument(key_string, key, e);\r
check_argument(d, key, e);\r
end\r
else\r
(* d=CR *)\r
key:= stop_key;\r
\r
end;\r
\r
end\r
else\r
key:= Stop_key;\r
\r
(* open outputfile *)\r
path_to_alfa(outp_path, outpfile);\r
rewrite(outp, outpfile);\r
\r
\r
\r
while (key<>stop_key) do\r
begin\r
case options(key) of\r
\r
ind_ : begin\r
myind:= false;\r
noind:= false;\r
end;\r
ownind_ : myind:= true;\r
noind_ : noind:= true;\r
\r
ownkeyw_, \r
lckeyw_, \r
uckeyw_ : reskeymode:= key;\r
\r
ownid_ , \r
lcid_, \r
ucid_ : idmode:= key;\r
\r
lines_ : linesmode:= true;\r
mark_ : markmode := true;\r
list_ : begin\r
linesmode:= true;\r
markmode := true;\r
end;\r
\r
otherwise\r
begin\r
writeln(opmess, 'otherwise key: ', key);\r
writeln(opmess, key_string.alfa: key_string.length);\r
error('ill. option: ');\r
end;\r
end; (* case *)\r
\r
if d<>cr then\r
begin\r
d:= get_argument(key_string, key, e);\r
check_argument(d, key, e);\r
end\r
else key:= stop_key;\r
\r
end (*while*)\r
\r
\r
\r
\r
\r
end (* READ_CALLPARAMS *);\r
\r
\r
PROCEDURE writeeol;\r
BEGIN\r
IF formfeed THEN\r
BEGIN\r
page(outp);\r
formfeed:= false;\r
END;\r
writeln(outp);\r
linepos:= 0\r
END;\r
\r
\r
\r
PROCEDURE pushmark(pos: integer);\r
BEGIN IF markpointer<lsize THEN\r
markpointer:= markpointer+1;\r
markstack[markpointer]:= pos;\r
END;\r
\r
\r
\r
PROCEDURE popmark;\r
BEGIN markstack[markpointer]:= 0;\r
IF markpointer>0 THEN\r
markpointer:= markpointer-1;\r
END;\r
\r
\r
\r
PROCEDURE printline; FORWARD;\r
PROCEDURE semicolon; FORWARD;\r
\r
PROCEDURE skip(skipend: char); FORWARD;\r
\r
\r
FUNCTION resword(length: integer;name: alfa): boolean;\r
VAR\r
i: integer;\r
res: boolean;\r
BEGIN\r
res:= false;\r
IF length<= toplength THEN\r
BEGIN\r
i:= keynum[length];\r
length:= keynum[length+1];\r
REPEAT\r
IF PascalKeys[i]=name THEN res:= true;\r
i:= i+1;\r
UNTIL(i>=length) OR res;\r
END;\r
resword:= res;\r
END;\r
\r
\r
PROCEDURE changeletters(lowercase: boolean;pos: integer);\r
VAR\r
i, add: integer;\r
ch, a, z: char;\r
BEGIN\r
IF lowercase THEN\r
BEGIN\r
add:= 32;\r
a:= 'A';\r
z:= 'Z';\r
END\r
ELSE\r
BEGIN\r
add:= -32;\r
a:= 'a';\r
z:= 'z';\r
END;\r
i:= pos;\r
REPEAT\r
ch:= line[i];\r
IF (ch>=a) AND (ch<=z) THEN line[i]:= chr(ord(ch)+add);\r
i:= i-1;\r
UNTIL NOT((ch IN alfanum) OR ((ch>='a') AND (ch<='z'))) OR (i=0);\r
END;\r
\r
\r
PROCEDURE shiftcase;\r
(*CHANGE IDENTIFIERS TO LC OR UC AND KEYWORDS TO LC OR UC *)\r
VAR\r
k, pos: integer;\r
key: alfa;\r
current: char;\r
BEGIN\r
pos:= 1;\r
current:= line[pos];\r
WHILE pos<=lastpos DO\r
BEGIN\r
IF skiptekst THEN\r
BEGIN\r
IF current=skipchar THEN\r
BEGIN\r
IF ((skipchar='*') AND (line[pos+1]=')')) OR (skipchar<>'*') THEN\r
skiptekst:= false;\r
END;\r
END\r
ELSE\r
BEGIN\r
IF (current>='a') AND (current<='z') THEN current:= chr(ord(current)-32);\r
CASE current OF\r
'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', \r
'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', \r
'U', 'V', 'W', 'X', 'Y', 'Z': \r
BEGIN\r
k:= 1;\r
key:= ' ';\r
REPEAT (*PICK UP IDENTIFIER *)\r
IF k<=alfalength THEN\r
BEGIN\r
key[k]:= current;\r
k:= k+1;\r
END;\r
pos:= pos+1;\r
current:= line[pos];\r
IF (current>='a') AND (current<='z') THEN current:= chr(ord(current)-32);\r
UNTIL NOT (current IN alfanum);\r
pos:= pos-1;\r
IF resword(k-1, key) THEN \r
begin\r
if reskeymode<>ord(ownkeyw_) then\r
changeletters(reskeymode=ord(lckeyw_) , pos)\r
end\r
else\r
if idmode<>ord(ownid_) then\r
changeletters(idmode=ord(lcid_), pos);\r
\r
END;\r
'0', '1', '2', '3', '4', \r
'5', '6', '7', '8', '9': \r
BEGIN\r
REPEAT pos:= pos+1 UNTIL NOT (line[pos] IN ['0'..'9']);\r
IF line[pos]='(' THEN pos:= pos-1;(*MIGHT BE START OF COMMENT *)\r
END;\r
'(': \r
IF line[pos+1]='*' THEN\r
BEGIN\r
skiptekst:= true;\r
skipchar:= '*';\r
pos:= pos+1;\r
END;\r
'''', '"': \r
BEGIN\r
skiptekst:= true;\r
skipchar:= current;\r
END;\r
\r
'-': \r
if line[ pos + 1 ]='-' then (* RTP86-comment *)\r
begin\r
if before_program then\r
rtp86_indent;\r
\r
pos:= lastpos; (*i.e.: skipp rest of line *)\r
end;\r
\r
OTHERWISE;\r
END;\r
END;\r
pos:= pos+1;\r
current:= line[pos];\r
END;\r
END;\r
\r
\r
PROCEDURE pushindent(prioritet, indention: integer);\r
(*STACK ONE LEVEL OF INDENTION *)\r
BEGIN\r
WITH stacktop DO\r
BEGIN\r
IF top<ssize THEN top:= top+1;\r
prior:= prioritet;\r
indent:= indention-oldpos;\r
oldpos:= pos;\r
margin:= margin+indent;\r
stack[top]:= stacktop;\r
END;\r
END;\r
\r
\r
PROCEDURE popindent;\r
(*REMOVE ONE LEVEL OF INDENTION FROM STACK*)\r
BEGIN\r
IF top>0 THEN top:= top-1;\r
margin:= margin-stacktop.indent;\r
IF oldpos>0 THEN oldpos:= oldpos-stacktop.indent;\r
stacktop:= stack[top];\r
END;\r
\r
\r
PROCEDURE pasidentifier;\r
(* CHECKS IF IDENTIFIER IS A KEYWORD WITH EFFECT\r
ON INDENTION. IF SO, INDENTION IS ADJUSTED*)\r
(* AS ONLY ONE KEYWORD MAY AFFECT INDENTION -\r
CURRENT LINE CAN BE PRINTED OUT AS SOON AS THE\r
FIRST KEYWORD WITH EFFECT ON INDENTION IS FOUND. *)\r
VAR a: ARRAY[0..alfalength] OF char; key: alfa;\r
k, hi, lo, try: integer;\r
\r
BEGIN\r
IF current IN ['B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'O', 'P', 'R', 'S', 'T', 'U', 'V', 'W']\r
(** The above set has to be updated in correspondence with\r
contents of "PASCALTABLE". The set contains all destinct\r
first-letters of keywords in "PASCALTABLE". **)\r
\r
THEN k:= 0 ELSE k:= toplength + 1;\r
REPEAT\r
IF k<toplength THEN\r
a[ k ]:= current;\r
k:= k + 1;\r
pos:= pos+1; current:= line[pos];\r
IF (current>='a') AND (current<='z') THEN current:= chr(ord(current)-32);\r
UNTIL NOT(current IN alfanum) ;\r
IF (k<= toplength) AND (k>1) THEN\r
BEGIN (* MIGHT BE INTERESTING KEYWORD*)\r
FOR hi:= k TO alfalength-1 DO a[ hi ]:= blank;\r
pack(a, 0, key);\r
lo:= 1; hi:= tsize;\r
IF resword( k, key ) THEN\r
BEGIN\r
IF Key='DO ' THEN InWith:= false;\r
REPEAT try:= (lo+hi)DIV 2;\r
WITH PascalTable[try] DO\r
BEGIN IF key>=string THEN lo:= try+1;\r
IF key<=string THEN hi:= try-1;\r
END;\r
UNTIL lo>hi;\r
\r
WITH PascalTable[try]DO\r
IF string=key THEN\r
WITH stacktop DO\r
BEGIN (* KEYWORD AFFECTING MARGIN IS FOUND *)\r
\r
IF before_program THEN\r
BEGIN\r
IF (string='MODULE ') OR (string='FILE ') THEN\r
pascal86_indent\r
ELSE\r
if((string='SHARED ') or\r
(string='LOCKBUF ') or\r
(string='LOCK ') or \r
(string='AS ')) then\r
RTP86_indent;\r
END; (* if before program *)\r
\r
IF(string='END ')OR(string='UNTIL ')\r
OR (string='OTHERWISE ')OR(String='ENDLOOP ')THEN semicolon\r
ELSE\r
IF (string=PUBLIC ') THEN state:= spublic\r
else if (string='PROGRAM ') or (string='PRIVATE ') THEN\r
state:= declare\r
else if (string='TYPE ') or\r
(string='VAR ') or (string='SHARED ')\r
THEN \r
BEGIN\r
IF state<>spublic THEN state:= declare;\r
END\r
ELSE IF string='BEGIN ' THEN state:= statement;\r
\r
\r
(* SEE IF UNSTACKING*)\r
IF prior<p1 THEN\r
BEGIN\r
IF (string='END ') AND (Norecord>0) THEN\r
BEGIN (*SPECIAL HANDLING OF RECORD *)\r
margin:= margin-3;\r
IF fresh THEN printline;\r
margin:= margin+3;\r
IF oldpos>0 THEN oldpos:= oldpos-indent;\r
Norecord:= NoRecord - 1;\r
END;\r
margin:= margin-indent;\r
top:= top-1; stacktop:= stack[top];\r
END\r
\r
ELSE\r
IF ((State=sPublic) AND ((string='PROCEDURE ') or\r
(string='FUNCTION '))) THEN\r
BEGIN\r
(* unstack *)\r
margin:= margin - indent;\r
top:= top - 1; stacktop:= stack[top];\r
end;\r
IF fresh THEN printline; (** SEE COMMENT IN BEGINNING OF PROCEDURE!! **)\r
\r
(* SEE IF STACKING*)\r
(** IF p2=0 THEN ACTUAL KEYWORD DOES NOT CAUSE\r
FURTHER INDENTION IN THE FOLLOWING LINES **)\r
IF p2>0 THEN\r
IF (string='CASE ') AND (state<>statement) THEN\r
BEGIN margin:= margin+spacing; indent:= indent+spacing;\r
stack[top]:= stacktop;\r
END\r
ELSE\r
BEGIN\r
IF top<ssize THEN top:= top+1;\r
prior:= p2;\r
IF string='RECORD ' THEN\r
BEGIN\r
indent:= spacing+pos-7-oldpos;\r
oldpos:= spacing+pos-7;\r
NoRecord:= NoRecord + 1;\r
end\r
ELSE indent:= spacing;\r
margin:= margin+indent;\r
stack[top]:= stacktop\r
END;\r
IF (string='FUNCTION ') OR (string='PROGRAM ') \r
or (string='PROCEDURE ') then skip(';')\r
ELSE\r
IF( string='WITH ') THEN \r
BEGIN\r
InWith:= true;\r
OldPos:= Spacing;\r
END\r
ELSE\r
IF string='END ' THEN\r
IF current= '.' THEN\r
WHILE NOT eof(inp) DO\r
(** Copy from input to output-file **)\r
IF eol THEN\r
BEGIN\r
writeln(outp);\r
readln_;\r
END\r
ELSE\r
BEGIN\r
read_(ch);\r
write(outp, ch);\r
END;\r
IF markmode THEN\r
BEGIN IF (key='BEGIN ') OR (key='REPEAT ') OR\r
( key='LOOP ') or\r
((key='CASE ') AND (state=statement)) OR (key='RECORD ')\r
THEN pushmark(margin+1 - spacing)\r
ELSE IF (key='END ') OR (key='UNTIL ')\r
or (key='ENDLOOP ')\r
THEN popmark;\r
END;\r
END; (* taking care of interesting keywords *)\r
END; (* if resword ... *)\r
END (* K IN [2..alfalength] *)\r
END (* IDENTIFIER*);\r
\r
\r
PROCEDURE semicolon;\r
(* UNSTACK UNTIL STACKTOP DOES NOT CONTAIN IF OR ELSE*)\r
BEGIN\r
\r
WITH stacktop DO\r
WHILE prior=5 DO\r
BEGIN\r
margin:= margin-indent;\r
top:= top-1;\r
stacktop:= stack[top]\r
END\r
END (* SEMICOLON*);\r
\r
\r
\r
PROCEDURE printline;\r
VAR pos: integer;\r
BEGIN\r
\r
fresh:= false; (* LINE IS PRINTED*);\r
IF linesmode THEN\r
BEGIN (* PRINT LINE NUMBER *)\r
write(outp, lineno: 5, ': ');\r
lineno:= lineno+1;\r
END;\r
IF not noind THEN write(outp, blank);\r
(*** ***) if (noind<>true) then\r
if not (lastpos=0) or markmode then\r
(*AN EMPTY LINE IS NOT SPACED*)\r
BEGIN nextmark:= 1;\r
FOR pos:= 1 TO margin DO\r
(** "margin" number of blanks are printed out. -\r
Perhabs including a "mark". **)\r
BEGIN\r
IF markmode THEN\r
BEGIN IF pos=markstack[nextmark] THEN\r
BEGIN write(outp, '!');\r
nextmark:= nextmark+1;\r
END\r
ELSE\r
write(outp, blank);\r
END\r
ELSE write(outp, blank);\r
END; (* markmode *)\r
\r
END; (* for *)\r
IF lastpos<>0 THEN\r
BEGIN\r
pos:= 0;\r
REPEAT pos:= pos+1; write(outp, line[pos]);\r
UNTIL pos=lastpos;\r
END;\r
writeeol;\r
END; (*PRINTLINE*)\r
\r
\r
PROCEDURE readline;\r
VAR pos: integer;\r
BEGIN\r
pos:= 0; lastpos:= 0; oldpos:= 0; fresh:= true; (* LINE IS READ, NOT PRINTED*)\r
ch:= blank;\r
IF myind=false THEN\r
(* Preceeding blanks and tabs in line are skipped - if wanted. *)\r
WHILE ((ch=blank) or (ord(ch)=ordoftab)) AND (NOT eol ) DO read_(ch);\r
WHILE NOT eol DO\r
BEGIN\r
IF pos<lsize THEN pos:= pos+1;\r
line[pos]:= ch;\r
IF ch<>blank THEN lastpos:= pos;\r
read_(ch)\r
END;\r
(* Now "lastpos" points at last character<>blank in the line *)\r
\r
IF inp^=ff THEN\r
BEGIN\r
formfeed:= true;\r
REPEAT\r
get(inp)\r
UNTIL inp^<>ff; (* skip ff's *)\r
END; (* if inp^=ff *)\r
\r
\r
IF ch<>blank THEN\r
BEGIN lastpos:= pos+1;\r
line[lastpos]:= ch;\r
END;\r
\r
line[lastpos+1]:= blank;\r
IF NOT eof(inp) THEN\r
readln_;\r
IF (idmode<>ord(ownid_)) or (reskeymode<>ord(ownkeyw_)) THEN shiftcase;\r
END (* READLINE*);\r
\r
PROCEDURE skip;\r
LABEL 11; (* exit in case of eof *)\r
BEGIN\r
IF fresh THEN printline;\r
\r
REPEAT\r
IF pos>=lastpos THEN\r
IF eof(inp) THEN\r
BEGIN\r
skiperror:= true;\r
GOTO 11;\r
END\r
ELSE\r
BEGIN readline; printline;\r
pos:= 0;\r
END;\r
pos:= pos+1; current:= line[pos];\r
IF ((skipend=';') OR (skipend=')')) AND\r
(current='(') AND (line[pos+1]<>'*') THEN\r
REPEAT (*SKIP PARAMETERLIST *)\r
skip(')');\r
pos:= pos + 1; current:= line[pos];\r
UNTIL line[pos-2]<>'*';\r
UNTIL current=skipend;\r
IF skipend=':' THEN\r
BEGIN\r
pos:= pos + 1; current:= line[pos];\r
END;\r
11: \r
END;\r
\r
(***** ---------- *****)\r
\r
\r
(* MAIN PROGRAM*)\r
BEGIN\r
(*\r
start_prio:= _ rqgetpriority(0, exc);\r
rqsetpriority(0, start_prio+1, exc);\r
*)\r
\r
initialize;\r
read_callparameters;\r
\r
IF markmode THEN\r
BEGIN FOR pos:= -1 TO lsize DO\r
markstack[pos]:= 0;\r
END;\r
IF myind THEN noind:= true;\r
\r
\r
WHILE NOT eof(inp) DO\r
BEGIN\r
readline;\r
pos:= 1; current:= line[pos];\r
WHILE pos<=lastpos DO\r
BEGIN\r
IF (current>='a') AND (current<='z') THEN current:= chr(ord(current)-32);\r
IF (current IN ['A'..'Z']) THEN\r
pasidentifier\r
ELSE\r
BEGIN\r
CASE current OF\r
';': semicolon;\r
'(', '<': BEGIN\r
IF line[pos+1]='*' THEN\r
BEGIN\r
IF pos=1 (* i.e. in front of the line *) THEN\r
pushindent(4, 2) (* indent 2 more positions *)\r
ELSE\r
pushindent(4, pos - 1); (* no further indention caused by comment *)\r
IF current='(' THEN endcomment:= ')'\r
ELSE endcomment:= '>';\r
REPEAT skip('*') UNTIL line[pos+1]=endcomment;\r
pos:= pos+1;\r
popindent;\r
END\r
ELSE\r
IF state<>statement THEN\r
IF current='<' THEN\r
skip('>') (* value initialization of array *)\r
ELSE\r
pushindent(4, pos); (* INDENTION OF SCALAR TYPES AND VARIANT FIELDS IN RECORDS *)\r
END;\r
')': BEGIN\r
IF state<>statement THEN\r
BEGIN(*UNSTACK INDENTION OF SCALAR TYPES AND VARIANT PARTS IN RECORDS*)\r
popindent;\r
END;\r
END;\r
':': IF InWith=false THEN\r
IF line[pos+1]<>'=' THEN\r
IF state=statement THEN\r
BEGIN (*INDENTION OF CASELABELS *)\r
semicolon;(*POP PREVIOUS STACKED CASELABELS AND IFSTATEMENTS *)\r
pushindent(5, oldpos + 2);\r
END;\r
\r
'-': \r
if line[ pos + 1 ]='-' then (* RTP86 comment - skip to eol *)\r
IF pos=1 (* i.e. in front of the line *) THEN\r
begin\r
pushindent(4, 2); (* indent 2 more positions *)\r
printline;\r
popindent;\r
pos:= lastpos;\r
end\r
else\r
pos:= lastpos; (** i.e.: skip rest of line **)\r
(*** end RTP86 comment ***)\r
\r
\r
'''': skip(''''); (* text string *)\r
'"': skip('"'); (* text string *)\r
\r
'$': begin\r
oldpos:= margin;\r
margin:= 1;\r
printline;\r
margin:= oldpos;\r
pos:= lastpos;\r
end;\r
\r
OTHERWISE; (* ALL OTHER ARE BLIND*)\r
END;\r
pos:= pos+1; current:= line[pos];\r
END;\r
IF fresh THEN printline\r
END (* SCAN OF LINE*);\r
IF fresh THEN printline\r
END (* SCAN OF INPUT FILE *);\r
IF fewends THEN writeln(opmess, ' ** WARNING, END(S) MISSING.');\r
IF skiperror THEN\r
writeln(opmess, ' ** premature end of file ');\r
10: ;\r
END.\r
\r
«eof»