leff@smu.edu (Laurence Leff) (12/14/89)
{the following program takes a collection of troff macros as standard output
on standard output, it will generate a listing of same
it will produce a unique
number on each line for each backslash followed
by a left bracket
for each backslash followed by a right bracket will have the number of
the corresponding backslash followed by a capital E
if there is no corresponding left bracket, an exclamation mark will be
produced instead. This is an indication of some sort of error.
this is intended as an aid in matching troff macros
left brackets with right brackets}
program p33(input,output);
const
NOCPL=1000;
CountBufferConstant=15;
type
Buffer = array [1..NOCPL] of char;
var
EOF:boolean;
InputBuffer: Buffer;
InputBufferLength: integer;
OutputBuffer: Buffer;
OutputBufferLength: integer;
Number:integer;
CountBuffer: Buffer;
CountBufferLength:integer;
Stack:array[0..20] of integer;
StackCount:integer;
function ctd(x: char): integer;
forward;
function ctd1(x: integer): char;
forward;
procedure BOB(var X: Buffer);
var
i: integer;
begin
for i := 1 to NOCPL do begin
X[i] := ' '
end
end; { BOB }
procedure AddSpacetoBuffer(var B: Buffer; var P: integer);
forward;
procedure AddBuffertoBuffer(Source: Buffer; SourceLength: integer; var Target: Buffer; var TargetLength: integer);
forward;
procedure ReadLine(var String: Buffer; var StringLength: integer; var tf: text; var EOFflag: boolean);
forward;
procedure OutputLine(String: Buffer; StringLength: integer; var TextFile: text);
forward;
procedure AddIntegertoBuffer(Number: integer; var B: Buffer; var P: integer);
forward;
procedure AddChartoBuffer(c: char; var B: Buffer; var P: integer);
forward;
procedure IntegertoBuffer(Number: integer; var B: Buffer; var L: integer);
forward;
function ctd1;
begin
ctd1 := chr(x + ord('0'))
end; { ctd1 }
procedure ReadLine;
var
i: integer;
temp1: boolean;
begin
BOB(String);
i := 1;
if not eof(tf) then
temp1 := eoln(tf)
else
temp1 := true;
while not temp1 do begin
read(tf, String[i]);
i := i + 1;
if not eof(tf) then
temp1 := eoln(tf)
else
temp1 := true
end;
if not eof(tf) then begin
readln(tf);
EOFflag := false
end else begin
EOFflag := true
end;
StringLength := i - 1
end; { ReadLine }
procedure OutputLine;
var
i: integer;
begin
for i := 1 to StringLength do begin
write(TextFile, String[i]);
end;
writeln(TextFile)
end; { OutputLine }
procedure MoveField(SourceBuffer: Buffer; SourceField, SourceLength: integer; var TargetBuffer: Buffer; TargetField, TargetLength: integer);
var
i, pos1, pos2: integer;
begin
pos1 := SourceField;
pos2 := TargetField;
i := 1;
while (i <= SourceLength) and (pos2 <= TargetLength) do begin
TargetBuffer[pos2] := SourceBuffer[pos1];
i := i + 1;
pos1 := pos1 + 1;
pos2 := pos2 + 1
end
end; { MoveField }
procedure AddIntegertoBuffer;
var
TempBuffer: Buffer;
TempBufferLength: integer;
begin
IntegertoBuffer(Number, TempBuffer, TempBufferLength);
AddBuffertoBuffer(TempBuffer, TempBufferLength, B, P)
end; { AddIntegertoBuffer }
procedure AddBuffertoBuffer;
var
pos1, pos2: integer;
begin
pos2 := TargetLength;
pos1 := 1;
while pos1 <= SourceLength do begin
pos2 := pos2 + 1;
Target[pos2] := Source[pos1];
pos1 := pos1 + 1
end;
TargetLength := pos2
end; { AddBuffertoBuffer }
procedure AddSpacetoBuffer;
begin
AddChartoBuffer(' ', B, P)
end; { AddSpacetoBuffer }
procedure AddChartoBuffer;
begin
P := P + 1;
B[P] := c
end; { AddChartoBuffer }
procedure IntegertoBuffer;
var
MPOT: integer; {maximum power of ten}
NOD: integer; {number of digits}
digit, i: integer;
TempNumber: integer;
begin
{determine maximum power of ten and number of digits}
MPOT := 1;
NOD := 1;
while MPOT <= Number do begin
MPOT := MPOT * 10;
NOD := NOD + 1
end;
MPOT := MPOT div 10;
TempNumber := Number;
i := 1;
while MPOT >= 1 do begin
digit := TempNumber div MPOT;
B[i] := ctd1(digit);
i := i + 1;
TempNumber := TempNumber mod MPOT;
MPOT := MPOT div 10
end;
L := i - 1;
if L = 0 then begin
B[1] := '0';
L := 1
end
end; { IntegertoBuffer }
function ctd;
var
ValuetoReturn: integer;
begin
ValuetoReturn := ord(x) - ord('0');
if (ValuetoReturn < 0) or (ValuetoReturn > 9) then
begin
write(output,'barf 6');
writeln;
ValuetoReturn:=0;
ctd:=ValuetoReturn div ValuetoReturn;
end;
ctd := ValuetoReturn
end; { ctd }
procedure CreateCounts;
var i:integer;
begin
BOB(CountBuffer);
CountBufferLength:=0;
i:=1;
while(i<=InputBufferLength-1) do begin
if (InputBuffer[i]='\') & (InputBuffer[i+1]='{') then begin
Number:=Number+1;
StackCount:=StackCount+1;
Stack[StackCount]:=Number;
AddIntegertoBuffer(Number,CountBuffer,CountBufferLength);
AddSpacetoBuffer(CountBuffer,CountBufferLength);
end;
if (InputBuffer[i]='\') & (InputBuffer[i+1]='}') then begin
if StackCount=0 then begin
AddChartoBuffer('!',CountBuffer,CountBufferLength);
end
else begin
AddIntegertoBuffer(Stack[StackCount],CountBuffer,CountBufferLength);
AddChartoBuffer('E',CountBuffer,CountBufferLength);
AddSpacetoBuffer(CountBuffer,CountBufferLength);
StackCount:=StackCount-1;
end;
end;
i:=i+1;
end;
CountBufferLength:=CountBufferConstant;
end;
begin
Number:=0;
StackCount:=0;
EOF:=false;
while(not EOF)do begin
ReadLine(InputBuffer,InputBufferLength,input,EOF);
if (not EOF) then begin
CreateCounts;
OutputBufferLength:=0;
CountBufferLength:=CountBufferConstant;
AddBuffertoBuffer(CountBuffer,CountBufferLength,OutputBuffer,OutputBufferLength);
AddBuffertoBuffer(InputBuffer,InputBufferLength,OutputBuffer,OutputBufferLength);
OutputLine(OutputBuffer,OutputBufferLength,output);
end;
end;
end.
Laurence Leff, Ph.D |A job is like sex, when you do it for money
CS,SMU, Dallas, Texas 75275-0122, |You take away all the fun.
Phone: 214-692-3459 Moderator comp.doc.techreports/TRLIST, Symbolic Math List
convex!smu!leff leff%smu.uucp@uunet E1AR0002 at SMUVM1 (BITNET)