|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 36864 (0x9000)
Types: TextFile
Names: »indentpas«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »indentpas«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »indentpas«
program indent(input,output);
(* version 9/10/79 *)
LABEL 10;
CONST
blank=' ';
lsize=240; (* LONGEST LINE*)
ssize= 90; (* DEEPEST STACK LOAD*)
ksize= 51; (* ENTIRE NO OF KEYWORDS*)
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Æ1..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*)
localline, (* pascal-program-local-line-numbers *)
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);
skipmode, finismode, procdecl, longlines, specifier, myind,eolmade,nolab,firstid,labelline,
noind, noapo, nowarn,autoeol, skipcomment,skiptext,endmode,fewends,msgmade:boolean;
pl11mode,linesmode,pasmode,markmode:boolean;
idmode:(nochange,lowercase,uppercase);(*CHANGE PASCAL-IDENTIFIERS
TO LC OR UC, AND KEYWORDS TO UC*)
outputfile,
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Å*)
table:ARRAYÆ1..23Å OF tablelement;
(* ACTUALLY THIS BOUND OF 23 IS "TSIZE" *)
keyword: ARRAYÆ1..ksizeÅ OF alfa;
keynum:ARRAYÆ1..13Å OF integer;
eol:char;
value
alfanum=Æ'0'..'9','A'..'Z','_'Å;
linepos=0;
lineno=1;
localline = -1;
noind=false; noapo=true; nowarn=true; fewends=false;
autoeol=false; skipcomment=false; skiptext=false;
myind=false; eolmade=false; nolab=false; endmode=false;
outputfile=false;
skiptekst=false;
pl11mode=false;
linesmode=false;
pasmode=true;
markmode=false;
idmode=nochange;
skipmode=false; finismode=false; procdecl=false;
specifier=false;
longlines=false; msgmade=false;
markpointer=0;
top = 1;
PROCEDURE algolinit;
BEGIN
margin:=1;
tsize:=23;
stackÆ0Å.prior :=10; (*BOTTOM NEVER UNSTACKED*);
stackÆ0Å.indent :=0;
stackÆ1Å.prior :=4;
stackÆ1Å.indent :=2; (*START WITH THE SAME AS BEGIN*);
(* KEYWORD P1 P2 INDENT*)
; tableÆ1Å.string:='BEGIN '; tableÆ1Å.p1:=2; tableÆ1Å.p2:=4; tableÆ1Å.spacing:=2;
; tableÆ2Å.string:='CLASS '; tableÆ2Å.p1:=0; tableÆ2Å.p2:=1; tableÆ2Å.spacing:=3;
tableÆ3Å.string:='CLOSE '; tableÆ3Å.p1:=5; tableÆ3Å.p2:=0; tableÆ3Å.spacing:=0;
; tableÆ4Å.string:='COMMENT '; tableÆ4Å.p1:=0; tableÆ4Å.p2:=0; tableÆ4Å.spacing:=4;
; tableÆ5Å.string:='ELSE '; tableÆ5Å.p1:=6; tableÆ5Å.p2:=5; tableÆ5Å.spacing:=1;
; tableÆ6Å.string:='END '; tableÆ6Å.p1:=5; tableÆ6Å.p2:=0; tableÆ6Å.spacing:=0;
; tableÆ7Å.string:='IF '; tableÆ7Å.p1:=0; tableÆ7Å.p2:=5; tableÆ7Å.spacing:=1;
tableÆ8Å.string:='OPEN '; tableÆ8Å.p1:=2; tableÆ8Å.p2:=4; tableÆ8Å.spacing:=2;
; tableÆ9Å.string:='OTHERWISE '; tableÆ9Å.p1:=6; tableÆ9Å.p2:=5; tableÆ9Å.spacing:=1;
; tableÆ10Å.string:='PROCEDURE '; tableÆ10Å.p1:=0; tableÆ10Å.p2:=1; tableÆ10Å.spacing:=2;
; tableÆ11Å.string:='WHEN '; tableÆ11Å.p1:=0; tableÆ11Å.p2:=5; tableÆ11Å.spacing:=1;
; tableÆ12Å.string:='"BEGIN '; tableÆ12Å.p1:=2; tableÆ12Å.p2:=4; tableÆ12Å.spacing:=2;
; tableÆ13Å.string:='"CLASS '; tableÆ13Å.p1:=0; tableÆ13Å.p2:=1; tableÆ13Å.spacing:=3;
tableÆ14Å.string:='"CLOSE '; tableÆ14Å.p1:=5; tableÆ14Å.p2:=0; tableÆ14Å.spacing:=0;
; tableÆ15Å.string:='"COMMENT '; tableÆ15Å.p1:=0; tableÆ15Å.p2:=0; tableÆ15Å.spacing:=4;
; tableÆ16Å.string:='"ELSE '; tableÆ16Å.p1:=6; tableÆ16Å.p2:=5; tableÆ16Å.spacing:=1;
; tableÆ17Å.string:='"END '; tableÆ17Å.p1:=5; tableÆ17Å.p2:=0; tableÆ17Å.spacing:=0;
; tableÆ18Å.string:='"IF '; tableÆ18Å.p1:=0; tableÆ18Å.p2:=5; tableÆ18Å.spacing:=1;
tableÆ19Å.string:='"OPEN '; tableÆ19Å.p1:=2; tableÆ19Å.p2:=4; tableÆ19Å.spacing:=2;
; tableÆ20Å.string:='"OTHERWISE'; tableÆ20Å.p1:=6; tableÆ20Å.p2:=5; tableÆ20Å.spacing:=1;
; tableÆ21Å.string:='"PROCEDURE'; tableÆ21Å.p1:=0; tableÆ21Å.p2:=1; tableÆ21Å.spacing:=2;
; tableÆ22Å.string:='"WHEN '; tableÆ22Å.p1:=0; tableÆ22Å.p2:=5; tableÆ22Å.spacing:=1;
; tableÆ23Å.string:='"ZZZZ '; tableÆ23Å.p1:=0; tableÆ23Å.p2:=0; tableÆ23Å.spacing:=0;
keywordÆ1Å:='ACTIVATE '; keywordÆ2Å:='AFTER ';
keywordÆ3Å:='ARRAY '; keywordÆ4Å:='AT ';
keywordÆ5Å:='BEFORE '; keywordÆ6Å:='BEGIN ';
keywordÆ7Å:='BOOLEAN '; keywordÆ8Å:='CHARACTER '; keywordÆ9Å:='CLASS ';
keywordÆ10Å:='CODE '; keywordÆ11Å:='CLOSE '; keywordÆ12Å:='COMMENT ';
keywordÆ13Å:='DELAY '; keywordÆ14Å:='DO ';
keywordÆ15Å:='ELSE '; keywordÆ16Å:='END ';
keywordÆ17Å:='FALSE '; keywordÆ18Å:='FOR ';
keywordÆ19Å:='GOTO '; keywordÆ20Å:='IF ';
keywordÆ21Å:='IN '; keywordÆ22Å:='INNER ';
keywordÆ23Å:='INSPECT '; keywordÆ24Å:='INTEGER ';
keywordÆ25Å:='IS '; keywordÆ26Å:='LABEL ';
keywordÆ27Å:='NAME '; keywordÆ28Å:='NEW ';
keywordÆ29Å:='NONE '; keywordÆ30Å:='NOTEXT ';
keywordÆ31Å:='OPEN ';
keywordÆ32Å:='OTHERWISE '; keywordÆ33Å:='PRIOR ';
keywordÆ34Å:='PROCEDURE '; keywordÆ35Å:='QUA ';
keywordÆ36Å:='REACTIVATE'; keywordÆ37Å:='REAL ';
keywordÆ38Å:='REF '; keywordÆ39Å:='STEP ';
keywordÆ40Å:='STRING ';
keywordÆ41Å:='SWITCH '; keywordÆ42Å:='TEXT ';
keywordÆ43Å:='THEN '; keywordÆ44Å:='THIS ';
keywordÆ45Å:='TRUE '; keywordÆ46Å:='UNTIL ';
keywordÆ47Å:='VALUE '; keywordÆ48Å:='VIRTUAL ';
keywordÆ49Å:='WHEN '; keywordÆ50Å:='WHILE ';
keywordÆ51Å:='ZZZZ ';
END; (*INITIALISER*)
PROCEDURE initialiser;
CONST
length1=17;
length2=44;
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,3),
('CONST ',3,2,2),
('ELSE ',6,5,1),
('END ',5,0,0),
('FORWARD ',4,0,0),
('FUNCTION ',0,2,2),
('IF ',0,5,1),
('LABEL ',3,2,2),
('PROCEDURE ',0,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));
pascalkeys= ('IF ', 'DO ', 'OF ', 'TO ', 'IN ',
'OR ', 'END ', 'FOR ', 'VAR ', 'NIL ',
'DIV ', 'MOD ', 'SET ', 'AND ', 'NOT ',
'THEN ', 'ELSE ', 'WITH ', 'GOTO ', 'CASE ',
'TYPE ', 'FILE ', 'BEGIN ', 'UNTIL ', 'WHILE ',
'ARRAY ', 'CONST ', 'LABEL ', 'VALUE ', 'REPEAT ',
'PASCAL ', 'RECORD ', 'DOWNTO ', 'PACKED ', 'RANDOM ',
'MODULE ', 'FORTRAN ', 'FORWARD ', 'PROGRAM ', 'FUNCTION ',
'EXTERNAL ', 'PROCEDURE ', 'OTHERWISE ', ' ');
BEGIN
keynumÆ1Å := 1; keynumÆ2Å := 1; keynumÆ3Å := 7; keynumÆ4Å := 16; keynumÆ5Å := 23;
keynumÆ6Å := 30; keynumÆ7Å := 37; keynumÆ8Å := 40; keynumÆ9Å := 42; keynumÆ10Å := 44;
keynumÆ11Å := 44; keynumÆ12Å := 44; keynumÆ13Å := 44;
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Å;
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,'SWITCHES 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,' NOLAB LABELS ARE NOT LEFT JUSTIFIED');
writeln(output,' LINES LINE NUMBERS ARE GENERATED');
writeln(output,' PL11 PL11 SYNTAX ASSUMED');
writeln(output,' ALGOL ALGOL SYNTAX ASSUMED');
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);
writeln(output,'DEFAULT SYNTAX IS PASCAL');
writeln(output);
END;
IF id='algol ' THEN
BEGIN
pasmode:=false;
pl11mode:=false;
END
ELSE IF id='pl11 ' THEN pl11mode:=true
ELSE 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 IF id='nolab ' THEN nolab:=true
ELSE IF id='apo ' THEN noapo:=false
ELSE error:=true;
END;
paramno := paramno + 1;
j := system(paramno,int,id);
END;
IF pasmode THEN initialiser
ELSE
BEGIN
idmode:=nochange;
algolinit;
END;
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;
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;
PROCEDURE algidentifier;
(* 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;
FUNCTION endorelse(a:integer): boolean;
BEGIN endorelse:=(key='END ') OR (key='"END ') OR
(key='ELSE ') OR (key='"ELSE ')
END;
BEGIN
k:=0;
REPEAT
IF (k<alfalength) AND (current <> '.') THEN
BEGIN
aÆkÅ:=current;
k:=k+1;
END;
pos:=pos+1; current:=lineÆposÅ;
UNTIL NOT (current IN (alfanum + Æ'.'Å)) ;
IF (current=':') AND NOT (lineÆpos+1Å IN Æ'=','-'Å) THEN
labelline:=firstid AND NOT (nolab OR skipcomment OR skiptext OR skipmode);
IF k IN Æ2..alfalengthÅ 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;
IF (endmode=false) OR endorelse(k) THEN
WITH tableÆtryÅDO
BEGIN
IF (string=key) AND NOT (procdecl) OR (key='COMMENT ') OR (key='"COMMENT ')THEN
WITH stacktop DO
BEGIN (* KEYWORD AFFECTING MARGIN IS FOUND *)
IF(string='END ') OR (string='"END ') THEN semicolon;
(* SEE IF UNSTACKING*)
IF prior<p1 THEN
BEGIN
margin:=margin-indent;
top:=top-1; stacktop:=stackÆtopÅ;
END;
IF fresh THEN printline;
(* SEE IF STACKING*)
IF (p2>0) AND ((prior<>1) OR (p2<>1)) THEN
BEGIN IF p2=1 THEN
BEGIN
procdecl:=true;
specifier:=true
END;
IF top<ssize THEN top:=top+1;
prior:=p2; indent:=spacing;
margin:=margin+indent;
stackÆtopÅ:=stacktop
END;
IF (string='PROCEDURE ') OR (string='"PROCEDURE')
OR (string='CLASS ') OR (string='"CLASS ') THEN
BEGIN IF procdecl THEN specifier:=true;
skip(';')
END
ELSE IF (string='COMMENT ') OR (string='"COMMENT ') THEN
BEGIN margin:=margin+2;
IF procdecl THEN specifier:=true;
skipmode:=true;
skip(';');
margin:=margin-2
END
END (* TAKING CARE OF INTERESTING KEYWORDS*) ELSE
IF (stacktop.prior = 1) THEN (* MAYBE PROC- OR CLASS-
DECLARATION*)
BEGIN
IF procdecl THEN
IF (key='INTEGER ') OR (key='"INTEGER ')
OR (key='BOOLEAN ') OR (key='"BOOLEAN ')
OR (key='REAL ') OR (key='"REAL ')
OR (key='PROCEDURE ') OR (key='"PROCEDURE')
OR (key='CHARACTER ') OR (key='"CHARACTER')
OR (key='VALUE ') OR (key='"VALUE ')
OR (key='REF ') OR (key='"REF ')
OR (key='NAME ') OR (key='"NAME ')
OR (key='ARRAY ') OR (key='"ARRAY ')
OR (key='LABEL ') OR (key='"LABEL ')
OR (key='TEXT ') OR (key='"TEXT ')
OR (key='STRING ') OR (key='"STRING ')
OR (key='SWITCH ') OR (key='"SWITCH ')
OR (key='VIRTUAL ') OR (key='"VIRTUAL ')
THEN BEGIN
specifier:=true; skip(';');
END ELSE
(* NOW WE SHOULD BE RIGHT BEFORE THE
PROCEDURE- OR CLASS-BODY. WE THEN START
LOOKING FOR SINGLE OR COMPOUND STATEMENT*)
IF (key<>'BEGIN ') AND (key<>'"BEGIN ') THEN
BEGIN (* SINGLE OR EMPTY STATEMENT*)
specifier:=false; procdecl:=false;
top:=top-1;
margin:=margin-stacktop.indent;
stacktop:=stackÆtopÅ;
IF fresh THEN printline;
IF (key='IF ') OR (key='"IF ') THEN
BEGIN (*IF IS STACKED*)
top:=top+1; stacktop.prior:=p2;
stacktop.indent:=spacing;
margin:=margin+stacktop.indent;
stackÆtopÅ:=stacktop
END
END
ELSE
BEGIN procdecl:=false;
specifier:=false;
(*BEGIN IS STACKED*)
margin:=margin - stacktop.indent;
IF fresh THEN printline;
stacktop.indent:=spacing;
stacktop.prior:=p2;
margin:=margin+stacktop.indent;
stackÆtopÅ:=stacktop
END; IF fresh THEN printline
END
END;
IF markmode THEN
BEGIN
IF key='BEGIN ' THEN pushmark(margin-1)
ELSE IF key='END ' THEN popmark;
END;
END (* K IN Æ2..alfalengthÅ *)
END (* IDENTIFIER*);
PROCEDURE apostrophes;
VAR pos,pos1,k,hi,lo,try :integer;
current:char;
key:alfa;
a:ARRAYÆ0..alfalengthÅ OF char;
BEGIN (*CHECK/ADD APOSTROPHES*)
pos:=1;
IF (lastpos<>0) AND labelline THEN
BEGIN pos:=0; write1(blank);
REPEAT
pos:=pos+1;
write1(lineÆposÅ)
UNTIL lineÆposÅ=':';
FOR k:=pos+2 TO margin DO write1(blank);
REPEAT pos:=pos+1 UNTIL lineÆposÅ<>blank;
END;
current:=lineÆposÅ;
IF lastpos<>0 THEN
REPEAT
IF (current IN Æ'A'..'Z'Å) AND (pos<>lastpos) THEN
BEGIN (*IDENTIFIER*)
k:=0; pos1:=pos;
REPEAT IF k<alfalength THEN
BEGIN aÆkÅ:=current; k:=k+1; END;
pos1:=pos1+1;
current:=lineÆpos1Å
UNTIL NOT (current IN alfanum);
IF k<=alfalength THEN
BEGIN (*MIGHT BE KEYWORD*)
FOR k:=k TO alfalength-1 DO aÆkÅ:=blank;
pack(a,0,key);
lo:=1; hi:=ksize;
REPEAT try:=(lo+hi) DIV 2;
IF key>=keywordÆtryÅ THEN lo:=try+1;
IF key<=keywordÆtryÅ THEN hi:=try-1;
UNTIL lo>hi;
IF (key='END ') OR (key='"END ') OR (key='ELSE ') OR
(key='"ELSE ') THEN endmode:=false;
IF (keywordÆtryÅ=key) AND NOT (skiptext OR skipcomment OR endmode) THEN
BEGIN (*KEYWORD*)
IF pos<>1 THEN
IF lineÆpos-1Å='"' THEN
BEGIN
FOR pos:=pos TO (pos1-1) DO write1(lineÆposÅ);
pos:=pos1; IF lineÆpos1Å<>'"' THEN write1('"');
IF pos>=lastpos THEN writeeol;
END
ELSE
BEGIN write1('"');
FOR pos:=pos TO (pos1-1) DO write1(lineÆposÅ);
IF lineÆpos1Å<>'"' THEN write1('"'); pos:=pos1;
IF pos>=lastpos THEN writeeol;
END
ELSE
BEGIN write1('"');
FOR pos:=pos TO (pos1-1) DO write1(lineÆposÅ);
IF lineÆpos1Å<>'"' THEN write1('"'); pos:=pos1;
IF pos>=lastpos THEN writeeol;
END;
IF (key='COMMENT ') OR (key='"COMMENT ') THEN skipcomment:=true;
IF (key='END ') OR (key='"END ') THEN endmode:=true
END (*KEYWORD*)
ELSE
BEGIN
FOR pos:=pos TO (pos1-1) DO write1(lineÆposÅ);
pos:=pos1;
IF pos>=lastpos THEN writeeol;
END
END (*MIGHT BE KEYWORD*)
ELSE
BEGIN (*NOT KEYWORD*)
FOR pos:=pos TO (pos1-1) DO write1(lineÆposÅ);
pos:=pos1; IF pos>=lastpos THEN writeeol;
END (*KEYWORD*)
END (*IDENTIFIER*)
ELSE IF pos>=lastpos THEN writeeol
ELSE
BEGIN pos:=pos+1;
write1(current);
IF (current=';') AND endmode THEN endmode:=false;
IF (current=';') AND skipcomment THEN skipcomment:=false
ELSE IF current='"' THEN skiptext:= NOT (skiptext);
current:=lineÆposÅ;
IF pos>=lastpos THEN writeeol;
END
UNTIL (pos>=lastpos) OR (pos1>=lastpos)
ELSE writeeol
END; (*CHECK/ADD APOSTROPHES*)
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(true,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:='''';
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'Å
THEN k:=0 ELSE k:=11;
REPEAT
IF k<alfalength THEN BEGIN aÆ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) ;
IF k IN Æ2..alfalengthÅ 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='PROCEDURE ') 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;
END (* TAKING CARE OF INTERESTING KEYWORDS*);
IF markmode THEN
BEGIN IF (key='BEGIN ') OR (key='REPEAT ') THEN
pushmark(margin-1)
ELSE IF ((key='CASE ') AND (state=statement)) OR (key='RECORD ')
THEN pushmark(margin-2)
ELSE IF (key='END ') OR (key='UNTIL ')
THEN popmark;
END;
END (* K IN Æ2..alfalengthÅ *)
END (* IDENTIFIER*);
PROCEDURE semicolon;
(* UNSTACK UNTIL STACKTOP DOES NOT CONTAIN IF OR ELSE*)
BEGIN
IF NOT pasmode THEN
BEGIN
IF procdecl THEN
IF specifier THEN specifier:=false
ELSE
BEGIN (*UNSTACK PROCEDURE*)
procdecl:=false;
top:=top-1;
margin:=margin-stacktop.indent;
stacktop:=stackÆtopÅ
END;
END; (* NOT PASMODE *)
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 NOT(pl11mode AND (lineÆ1Å='Æ' )) THEN
BEGIN
IF (finismode=false) AND (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 *)
END; (* PL11: NO INDENTION IN COMPILER OPTION LINES *)
IF ( skipmode OR finismode OR noapo) AND (lastpos<>0) THEN BEGIN
pos:=0;
REPEAT pos:=pos+1; write1(lineÆposÅ);
UNTIL pos=lastpos;
writeeol;
END
ELSE apostrophes;
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;
readln;
IF idmode>nochange THEN shiftcase;
END (* READLINE*);
PROCEDURE skip;
BEGIN
IF NOT procdecl THEN skipmode:=true;
IF fresh THEN printline;
REPEAT
IF pos>=lastpos THEN
IF eof(input) THEN
BEGIN
IF skipend='"' THEN
writeln(output,'** TEXTSTRING NOT FINISHED **')
ELSE
writeln(output,' ** COMMENT NOT FINISHED. ');
END
ELSE
BEGIN readline; printline;
pos:=0;
END;
pos:=pos+1; current:=lineÆposÅ;
IF pasmode THEN
BEGIN
IF (skipend=';') AND (current='(') AND (lineÆpos+1Å<>'*') THEN
REPEAT (*SKIP PARAMETERLIST *)
skip(')');
IF pos=1 THEN pos:=2;
UNTIL lineÆpos-1Å<>'*';
END;
UNTIL current=skipend;
skipmode:=false;
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) AND NOT finismode 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
BEGIN
IF pasmode THEN pasidentifier ELSE algidentifier;
END
ELSE
BEGIN
CASE current OF
';': semicolon;
'(': IF pasmode THEN
BEGIN
IF lineÆpos+1Å='*' THEN
BEGIN
pushindent(4,pos+1);
REPEAT skip('*') UNTIL lineÆpos+1Å=')';
pos:=pos+1;
popindent;
END
ELSE
IF state=declare THEN
pushindent(4,pos); (* INDENTION OF SCALAR TYPES AND VARIANT FIELDS IN RECORDS *)
END;
')':IF pasmode THEN
BEGIN
IF state=declare THEN
BEGIN(*UNSTACK INDENTION OF SCALAR TYPES AND VARIANT PARTS IN RECORDS*)
popindent;
END;
END;
':':IF pasmode THEN
IF lineÆpos+1Å <> '=' THEN
IF state=statement THEN
BEGIN (*INDENTION OF CASELABELS *)
semicolon;(*POP PREVIOUS STACKED CASELABELS AND IFSTATEMENTS *)
pushindent(5,pos);
END;
'!': IF NOT (pl11mode OR pasmode) THEN skip(';'); (* SKIP COMMENT *)
'''': IF pl11mode OR pasmode THEN skip(''''); (*TEXT*)
'"': IF NOT(pl11mode) THEN skip('"'); (* SKIP TEXT STRING *)
'$': IF NOT(pl11mode OR pasmode) THEN pos:=pos+3;
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. ');
close(input);
10:;
END.
▶EOF◀