⟦b3b129f9c⟧

TextFile

program indent(input,output);
(* version 80.02.15  *)
label 10;
const
blank=' ';
lsize=240; (* LONGEST LINE*)
ssize= 90; (* DEEPEST STACK LOAD*)
ksize= 51; (* ENTIRE NO OF KEYWORDS*)
toplength = 9;  (* longest identifier *)

type
stackelement= record
prior,indent:integer
end;
tablelement = record
string:alfa;
p1,p2,spacing:integer
end;
var
alfanum:set of char; (*HOLDS SET OF ALPHANUMERIC SYMBOLS *)
tsize:integer;       (* NO OF INTERESTING KEYWORDS *)
line:arrayÆ0..lsizeÅ of char; (* LINE LEFT JUSTIFIED*)
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*)
state: (declare,statement);
skiperror, longlines, formfeed, myind,eolmade,firstid,labelline,
noind,  nowarn,autoeol, skipcomment,skiptext,fewends:boolean;
linesmode,markmode:boolean;
idmode:(nochange,lowercase,uppercase);(*CHANGE PASCAL-IDENTIFIERS
TO LC OR UC, AND KEYWORDS TO UC*)
outputfile,
skiptekst:boolean;   (*USED IN SHIFTCASE*)
endcomment,    (*  '>' or ')' depending on the start of the comment *)
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Å*)
table:arrayÆ1..25Å of tablelement;
(* ACTUALLY THIS BOUND OF 25 IS "TSIZE" *)
keyword: arrayÆ1..ksizeÅ of alfa;
keynum:arrayÆ1..13Å of integer;






value
alfanum=Æ'0'..'9','A'..'Z','_'Å;
linepos=0;
lineno=1;
noind=false;       nowarn=true; fewends=false;
autoeol=false;  skipcomment=false;   skiptext=false;
myind=false;   eolmade=false;
outputfile=false;
skiptekst=false;
linesmode=false;
markmode=false;
idmode=nochange;
skiperror = false;
longlines=false;
markpointer=0;

top = 1;

procedure initialiser;
const
length1 = 25;
length2 = 45;
var
i,j:integer;
pascaltable : arrayÆ1..length1Å of tablelement;
pascalkeys:arrayÆ1..length2Å of alfa;
value
pascaltable=(('BEGIN     ',4,4,2),
('CASE      ',0,4,2),
('CHANNEL   ',0,5,2),
('CONST     ',3,2,2),
('ELSE      ',6,5,2),
('END       ',5,0,0),
('EXTERNAL  ',4,0,0),
('FOR       ',0,5,2),
('FORWARD   ',4,0,0),
('FUNCTION  ',0,2,2),
('IF        ',0,5,2),
('LABEL     ',3,2,2),
('LOCK      ',0,5,2),
('PREFIX    ',3,2,2),
('PROCEDURE ',0,2,2),
('PROCESS   ',3,2,2),
('PROGRAM   ',3,2,2),
('RECORD    ',0,2,3),
('REPEAT    ',0,4,2),
('TYPE      ',3,2,2),
('UNTIL     ',5,0,0),
('VALUE     ',3,2,2),
('VAR       ',3,2,2),
('WHILE     ',0,5,2),
('WITH      ',0,5,2));

pascalkeys= ('IF        ', 'DO        ', 'OF        ', 'TO        ', 'IN        ',
'OR        ', 'END       ', 'FOR       ', 'VAR       ', 'NIL       ',
'DIV       ', 'MOD       ', 'SET       ', 'AND       ', 'NOT       ',
'THEN      ', 'ELSE      ', 'WITH      ', 'GOTO      ', 'CASE      ',
'LOCK      ',
'TYPE      ', 'FILE      ', 'BEGIN     ', 'UNTIL     ', 'WHILE     ',
'ARRAY     ', 'CONST     ', 'LABEL     ', 'VALUE     ', 'REPEAT    ',
'RECORD    ', 'DOWNTO    ', 'PACKED    ', 'PREFIX    ', 'INCLUDE    ',
'PROCESS    ', 'CHANNEL   ', 'FORWARD   ', 'PROGRAM   ', 'FUNCTION  ',
'EXTERNAL  ', 'PROCEDURE ', 'OTHERWISE ', '          ');
begin
keynumÆ1Å :=  1; keynumÆ2Å :=  1; keynumÆ3Å :=  7; keynumÆ4Å := 16; keynumÆ5Å := 24;
keynumÆ6Å := 31; keynumÆ7Å := 36; keynumÆ8Å := 41; keynumÆ9Å := 43; keynumÆ10Å := 45;
keynumÆ11Å := 45; keynumÆ12Å := 45; keynumÆ13Å := 45;

for i:=1 to length1 do tableÆiÅ:=pascaltableÆiÅ;
if idmode>nochange then
for i:=1 to length2 do keywordÆiÅ:=pascalkeysÆiÅ;
tsize:=length1;
margin:=3;
for i:=1 to lsize do lineÆiÅ:=blank;
stackÆ0Å.prior:=10; (* bottom never unstack *)
stackÆ0Å.indent:=0;
stackÆ1Å.indent:=2;
stackÆ1Å.prior:=2;
stacktop:=stackÆ1Å;
lineÆ 0 Å := ' '; (* anything <> from *, used in skip *)
end;



procedure fileid;
const
power12 = 4096;
equality = 6;
point = 8;
var
i,j,int,paramno : integer;
error : boolean;
id : alfa;
begin
paramno := 1;
error := false;
i:=system(paramno,int,id);
if i div power12 = equality then
begin (* get outputfile *)
i:=system(0,int,id);
if i mod power12 = 10 then
begin
outputfile:=true;
open(output,id);
rewrite(output);
end
else
begin
writeln(' ??? illegal output-filename');
goto 10;
end;
paramno:=paramno + 1;
end;

(* get input file *)
i:=system(paramno,int,id);
if i mod power12 = 10 then
if (id='h') or (id='help') then paramno := paramno-1 (* not error *)
else
begin
open(input,id);
reset(input);
end
else
begin
if outputfile then close(output);
writeln(' ??? illegal input-filename');
goto 10;
end;
paramno:=paramno+1;
j:=system(paramno,int,id);
while j <>0 do
begin
if j mod power12 <> 10 then error:=true
else
begin
if j div power12 = point then error:=true;
i:=alfalength;
if ((id='h         ')
or (id='help      ')) then
begin (* HELP INFORMATION *);
writeln(output,'HELP INFORMATION:');
writeln(output, 'call :', nl,
'                  1                             9', nl,
'( output_file  = )  indent input_file ( option )' , nl,
'                  0                             0', nl);
writeln(output,' options available are:');
writeln(output,' NOIND      NO INDENTION IS PERFORMED');
writeln(output,' WARN       WARNING IF LINE LONGER THAN 72 CHARACTERS');
writeln(output,' MYIND      INDENTION IS NOT TOUCHED');
writeln(output,' LINES      LINE NUMBERS ARE GENERATED');
writeln(output,' LC         GENERATE LC IDENTIFIERS AND UC PASCAL-KEYWORDS');
writeln(output,' UC         GENERATE UC IDENTIFIERS AND PASCAL-KEYWORDS');
writeln(output,' MARK       MARK BEGIN-END MATCHING');
writeln(output,' LIST       EQUIVALENT TO  LINES MARK ');
writeln(output, ' HELP       produce this list');
writeln(output);
end;
if id='warn      ' then nowarn:=false
else if id='myind     ' then myind:=true
else if id='noind     ' then noind:=true
else if id='lc        ' then idmode:=lowercase
else if id='uc        ' then idmode:=uppercase
else if id='autoeol   ' then autoeol:=true
else if id='lines     ' then linesmode:=true
else if id='mark      ' then markmode:=true
else if id='list      ' then
begin
linesmode:=true;
markmode:=true;
end
else error:=true;

end;
paramno := paramno + 1;
j := system(paramno,int,id);
end;
initialiser;


if error then
begin
writeln(output,'call: "indent help", for help ');
close(input);
goto 10;
end;
end;

procedure writeeol;
begin linepos:=linepos+1;
if (linepos>73) and (nowarn=false) then
begin   writeln;
writeln(' ***** THIS LINE CONTAINED MORE THAN 72 CHARACTERS              POS 72 ^ ');
longlines:=true
end;
if formfeed then page(output)
else
writeln;
linepos:=0
end;



procedure write1(ch:char);
var k:integer;
begin              linepos:=linepos+1;
if (linepos>72) and autoeol then
begin
writeln;
linepos:=0;   eolmade:=true
end;
write(ch)
end; (*WRITE1*)



procedure pushmark(pos:integer);
begin if markpointer<lsize then
markpointer:=markpointer+1;
markstackÆmarkpointerÅ:=pos;
end;



procedure popmark;
begin markstackÆmarkpointerÅ:=0;
if markpointer>0 then
markpointer:=markpointer-1;
end;



procedure printline; forward;
procedure semicolon; forward;

procedure skip(skipend:char); forward;


function resword(length:integer;name:alfa):boolean;
var
i:integer;
res:boolean;
begin
res:=false;
i:=keynumÆlengthÅ;
length:=keynumÆlength+1Å;
repeat
if keywordÆiÅ=name then res:=true;
i:=i+1;
until(i>=length) or res;
resword:=res;
end;


procedure changeletters(lowercase:boolean;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:=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 UC *)
var
k,pos:integer;
key:alfa;
current:char;
begin
pos:=1;
current:=lineÆposÅ;
while pos<=lastpos do
begin
if skiptekst then
begin
if current=skipchar then
begin
if ((skipchar='*') and (lineÆ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;
pos:=pos+1;
current:=lineÆposÅ;
if (current>='a') and (current<='z') then current:=chr(ord(current)-32);
until not (current in alfanum);
pos:=pos-1;
if resword(k-1,key) then changeletters(false,pos)
else changeletters(idmode=lowercase,pos);
end;
'0','1','2','3','4',
'5','6','7','8','9':
begin
repeat pos:=pos+1 until not (lineÆposÅ in Æ'0'..'9'Å);
if lineÆposÅ='(' then pos:=pos-1;(*MIGHT BE START OF COMMENT *)
end;
'(':
if lineÆpos+1Å='*' then
begin
skiptekst:=true;
skipchar:='*';
pos:=pos+1;
end;
"'", '"' :
begin
skiptekst:=true;
skipchar:= current;
end;
end
otherwise;
end;
pos:=pos+1;
current:=lineÆ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:=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*)
var a:arrayÆ0..alfalengthÅ of char; key:alfa;
k,hi,lo,try:integer;

begin
if  current in Æ'B','C','E','F','I','L','P','R','T','U','V','W'Å
then k:=0 else k:=toplength + 1;
repeat
if k < toplength then
aÆ k Å := current;
k := k + 1;
pos:=pos+1; current:=lineÆ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 k:=k to alfalength-1 do aÆkÅ:=blank;
pack(a,0,key);
lo:=1; hi:=tsize;
repeat try:=(lo+hi)div 2;
with tableÆtryÅ do
begin if key>=string then lo:=try+1;
if key<=string then hi:=try-1;
end;
until lo>hi;

with tableÆtryÅdo
if string=key then
with stacktop do
begin (* KEYWORD AFFECTING MARGIN IS FOUND *)
if(string='END       ')or(string='UNTIL     ')then semicolon
else if (string='TYPE      ') or (string='VAR       ') then state:=declare
else if string='BEGIN     ' then state:= statement;


(* SEE IF UNSTACKING*)
if prior<p1 then
begin
if (string='END       ') and (state=declare) then
begin (*SPECIAL HANDLING OF RECORD *)
margin:=margin-3;
if fresh then printline;
margin:=margin+3;
if oldpos>0 then oldpos:=oldpos-indent;
end;
margin:=margin-indent;
top:=top-1; stacktop:=stackÆtopÅ;
end;
if fresh then printline;
(* SEE IF STACKING*)
if p2>0 then
if (string='CASE      ') and (state=declare) then
begin margin:=margin+spacing; indent:=indent+spacing;
stackÆtopÅ:=stacktop;
end
else
begin
if top<ssize then top:=top+1;
prior:=p2;
if string='RECORD    ' then
begin
indent:=spacing+pos-7-oldpos;
oldpos:=spacing+pos-7;
end                else indent:=spacing;
margin:=margin+indent;
stackÆtopÅ:=stacktop
end;
if (string='FUNCTION  ') or (string = 'PROCESS') or(string='PROCEDURE ') then skip(';')
else
if string = 'LOCK      ' then skip(':')
else
if string='END       ' then
if current= '.' then
while not eof(input) do
if eoln(input) then
begin
writeln;
readln;
end
else
begin
read(ch);
write(ch);
end;
if markmode then
begin if (key='BEGIN     ') or (key='REPEAT    ') or
((key='CASE      ') and (state=statement)) or (key='RECORD    ')
then pushmark(margin+1 - spacing)
else if (key='END       ') or (key='UNTIL     ')
then popmark;
end;
end; (* taking care of interesting keywords *)
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Å
end
end (* SEMICOLON*);



procedure printline;
var pos:integer;
begin
fresh:=false;   (* LINE IS PRINTED*);
if linesmode then
begin (* PRINT LINE NUMBER *)
write(lineno:5,':');
lineno:=lineno+1;
end;
if   (noind=false) then write1(blank);
if  not ((lastpos=0) or noind or labelline)  or markmode then
(*AN EMPTY LINE IS NOT SPACED*)
begin nextmark:=1;
for pos:=1 to margin do
begin
if markmode then
begin if pos=markstackÆnextmarkÅ then
begin write('!');
nextmark:=nextmark+1;
end
else
write1(blank);
end
else write1(blank);
end; (* markmode *)

end; (* for *)
if lastpos <> 0 then
begin
pos:=0;
repeat pos:=pos+1; write1(lineÆposÅ);
until pos=lastpos;
end;
writeeol;
end; (*PRINTLINE*)


procedure readline;
var pos:integer;
begin
pos:=0; lastpos:=0; oldpos:=0; fresh:=true; (* LINE IS READ, NOT PRINTED*)
ch := blank;
if myind=false then
while (ch=blank) and (not eoln(input) ) do read(ch);
while not eoln(input) do
begin
if pos<lsize then pos:=pos+1;
lineÆposÅ:=ch;
if ch<>blank then lastpos:=pos;
read(ch)
end;
if ch<>blank then
begin lastpos:=pos+1;
lineÆlastposÅ:=ch;
end;

lineÆlastpos+1Å:=blank;
formfeed := input^ = ff;
readln;
if idmode>nochange then shiftcase;
end (* READLINE*);

procedure skip;
label 11; (* exit in case of eof *)
begin
if fresh then printline;

repeat
if pos>=lastpos then
if eof(input) then
begin
skiperror := true;
goto 11;
end
else
begin readline; printline;
pos:=0;
end;
pos:=pos+1; current:=lineÆposÅ;
if ((skipend=';') or (skipend=')')) and
(current='(') and (lineÆpos+1Å <> '*') then
repeat (*SKIP PARAMETERLIST *)
skip(')');
pos := pos + 1; current := lineÆposÅ;
until lineÆpos-2Å<>'*';
until current=skipend;
if skipend = ':' then
begin
pos := pos + 1; current := lineÆposÅ;
end;
11:
skiptext:=false;  skipcomment:=false
end;

(* PROGRAM*)
begin
stacktop:=stackÆ1Å;



fileid;

if markmode then
begin for pos:=-1 to lsize do
markstackÆposÅ:=0;
end;


if autoeol then nowarn:=true;
if myind then noind:=true;


while  not eof(input)  do
begin
readline;
labelline:=false; firstid:=true;
pos:=1; current:=lineÆposÅ;
while 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Æpos+1Å='*' then
begin
if pos = 1 (* i.e. in front of the line *) then
pushindent(4, 2)  (* indent 2 more positions *)
else
pushindent(4, pos - 1); (* no further indention caused by comment *)
if current = '(' then endcomment := ')'
else endcomment := '>';
repeat skip('*') until lineÆpos+1Å=endcomment;
pos:=pos+1;
popindent;
end
else
if state=declare then
if current = '<' then
skip('>') (* value initialization of array *)
else
pushindent(4,pos); (* INDENTION OF SCALAR TYPES AND VARIANT FIELDS IN RECORDS *)
end;
')' : begin
if state=declare then
begin(*UNSTACK INDENTION OF SCALAR TYPES AND VARIANT PARTS IN RECORDS*)
popindent;
end;
end;
':' : if lineÆpos+1Å <> '=' then
if state=statement then
begin (*INDENTION OF CASELABELS *)
semicolon;(*POP PREVIOUS STACKED CASELABELS AND IFSTATEMENTS *)
pushindent(5,oldpos + 2);
end;
"'": skip("'"); (* text string *)
'"': skip('"'); (* text string *)
end
otherwise; (* ALL OTHER ARE BLIND*)
pos:=pos+1; current:=lineÆposÅ;
end;
firstid:=false;
if fresh then printline
end (* SCAN OF LINE*);
if fresh then printline
end (* SCAN OF INPUT FILE *);
if outputfile then close(output);
if longlines then
writeln(output,' ** WARNING, LINE(S) OF MORE THAN 72 CHARACTERS.');
if fewends then writeln(output,' ** WARNING, END(S) MISSING.');
if eolmade then writeln(output,' ** nl(s) generated.   ');
if skiperror then
writeln(output, ' ** premature end of file  ');
close(input);
10:;
end.
      
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦b3b129f9c⟧ TextFile

Derivation

TextFile
