{$A+,B-,D+,E+,F-,G-,I-,L+,N+,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
program help_compiler;
function upper(const s : string) : string;
var i : integer;
hs : string;
begin
hs:='';
for i:=1 to length(s) do
hs:=hs+upcase(s[i]);
upper:=hs;
end;
type
pstring = ^tstring;
ptopicrecord = ttopicrecord;
ttopicrecord = record
name : pstring;
startpos : longint;
next : ptopicrecord;
end;
var
last,topics : ptopicrecord;
output : file;
procedure error(const s : string);
begin
writeln(s);
halt(1);
end;
procedure parse(const name : string;firstpass : boolean);
var
input : text;
c : char;
function readstring : string;
var
s : string;
begin
s:='';
if ioresult<>0 then
error('Unerwartetes Dateiende');
while (((ord(c)>=ord('A')) and (ord(c)<=ord('Z')) or
(((ord(c)>=ord('a')) and (ord(c)<=ord('z')) or (c='_') do
begin
s:=s+c;
read(input,c);
if ioresult<>0 then
error('Unerwartetes Dateiende');
end;
readstring:=s;
end;
procedure skipspace;
begin
while (c=' ') or (c=#9) or (c=#13) or (c=#10) do
read(input,c);
end;
var
s : string;
p : ptopicrecord;
begin
assign(input,name);
reset(input);
if ioresult<>0 then
error('Eingabedatei '+name+' nicht gefunden');
read(t,c);
while true do
begin
if eof(input) then
break;
if firstpass then
begin
if c='\' then
begin
read(input,c);
s:=upper(readstring);
if s='TOPIC' then
begin
skipspace;
new(p);
p^.next:=nil;
s:=upper(readstring);
getmem(p^.name,length(s)+1);
p^.name^:=s;
if topics=nil then
topics:=p
else
last^.next:=p;
last:=p;
end
else if s='INPUT' then
begin
skipspace;
parse(upper(readstring),true);
end;
end;
end
else
begin
if c='\' then
begin
read(input,c);
s:=upper(readstring);
if s='TOPIC' then
begin
skipspace;
p:=topics;
s:=upper(readstring);
{ es müßte eigentlich jedes Thema vorhanden sein }
while p^.name^<>s do
p:=p^.next;
p^.startpos:=filepos(output);
end
else if s='INPUT' then
begin
skipspace;
parse(upper(readstring),true);
end;
end;
end;
close(input);
end;
var
l : longint;
p : ptopicrecord;
begin
writeln('FPK-Helpcompiler Version 0.1 Copyright (c) 1994,95 by FP Klämpfl');
if paramcount<>2 then
error('PPHC <Eingabedatei> <Ausgabedatei');
topics:=nil;
last:=nil;
parse(upper(paramstr(1),true);
assign(output,paramstr(2));
rewrite(output,1);
if ioresult<>0 then
error('Fehler beim Schreiben der Ausgabedatei');
l:=0;
p:=topics;
while p^.next<>nil do
begin
inc(l);
p:=p^.next;
end;
seek(output,20+l*4);
if ioresult<>0 then
error('Fehler beim Schreiben der Ausgabedatei');
parse(upper(paramstr(1),false);
seek(output,16);
p:=topics;
while p<>nil do
begin
blockwrite(output,p^.startpos,4);
if ioresult<>0 then
error('Fehler beim Schreiben der Ausgabedatei');
p:=p^.next;
end;
if ioresult<>0 then
error('Fehler beim Schreiben der Ausgabedatei');
close(output);
if ioresult<>0 then
error('Fehler beim Schreiben der Ausgabedatei');
end.