{
****************************************************************************

        interrupt help compiler version 1.0 - written 1997 by future vision

        this compiler generates an index file of ralf browns interrupt
        list for use with intruders interrupt help uilm

****************************************************************************
}
{$I-}
{$N-}
{$E-}
{$D-}
{$L-}
{$Y-}
{$X-}

uses
  crt,dos;

const
  infile  :string='interrupt.lst';
  outfile :string='interrupt.idx';
  pr      :string='³/Ä\';

type
  msp     =^ms;
  ms      =record
             regs   :word;
             lines  :word;
             pos    :longint;
             _int   :byte;
             _ah    :byte;
             _al    :byte;
             _bh    :byte;
             _bl    :byte;
             _ch    :byte;
             _cl    :byte;
             _dh    :byte;
             _dl    :byte;
             _si    :word;
             _di    :word;
             next   :msp;
           end;
  mtp      =^mt;
  mt       =record
              lines :word;
              pos   :longint;
              next  :mtp;
              num   :longint;
            end;

var
  mod_flag:boolean;
  ti      :text;
  fi      :file;
  fo      :file;
  s       :string;
  e,t,c   :msp;
  f,u,d   :mtp;
  topics  :word;
  lines   :longint;
  tables  :word;
  b       :word;
  db      :boolean;
  di      :integer;
  fp,ofp  :longint;
  st      :array[1..90] of char;
  inint   :boolean;
  intab   :boolean;
  tb,otb  :word;
  sm      :longint;

procedure errorh(id:string);
begin
  writeln;
  writeln('error in line :',lines:8,' ',id);
  halt;
end;

procedure done;
begin
  gotoxy(69,wherey);
  writeln('..done.');
end;

function  get_dat:boolean;
var
  ts      :string;
begin
  ts:=copy(s,1,2);
  delete(s,1,2);
  if pos('-',ts)>0 then
    get_dat:=false
  else begin
    get_dat:=true;
    if ts[1] in ['A'..'F'] then ts[1]:=chr(ord(ts[1])-7);
    if ts[2] in ['A'..'F'] then ts[2]:=chr(ord(ts[2])-7);
    b:=(ord(ts[1])-48)*16+ord(ts[2])-48;
  end;
end;

begin
if paramcount>0 then begin
  if (pos('?',paramstr(1))>0) or (paramcount>1) then begin
    writeln('help compiler v1.0 for the interrupt list by ralf brown'#10#13,
            '     usage: IHC.EXE [input_file]'#10#13,
            '            IHC.EXE -? for help'#13#10,
            '     default input_file is INTERRUP.LST, output file is INTERRUP.IDX');
    halt;
  end;
  infile:=paramstr(1);
end;
assign(ti,infile);
reset(ti);
if ioresult<>0 then begin
  writeln('error opening input file ''',infile,''', run ihc.exe -? for help');
  halt;
end;
readln(ti,s);
if copy(s,1,14)<>'Interrupt List' then begin
  writeln('warning: probably not the interrupt list..press ENTER to continue anyway');
  if readkey<>#13 then halt;
end;
sm:=1;
while sm<length(s) do begin
  if s[sm]=#9 then begin
    delete(s,sm,1);
    for otb:=1 to 8-((sm-1) mod 8) do insert(' ',s,sm);
  end;
  inc(sm);
end;
writeln(s);
readln(ti,s);
writeln(s);
writeln;
sm:=0;
while (sm<2) and (not eof(ti)) do begin
  readln(ti,s);
  if pos(' entries)',s)>0 then begin
    delete(s,1,pos('(',s));
    s:=copy(s,1,pos(' ',s)-1);
    val(s,topics,tb);
    inc(sm);
  end else if pos(' tables)',s)>0 then begin
    delete(s,1,pos('(',s));
    s:=copy(s,1,pos(' ',s)-1);
    val(s,tables,tb);
    inc(sm);
  end;
end;
close(ti);
if sm=2 then begin
  writeln('assuming ',topics,' topics and ',tables,' tables');
  if memavail<=((sizeof(ms)+15) div 16)*16*topics+
               ((sizeof(mt)+15) div 16)*16*tables then begin
    writeln('warning: low memory..press ENTER to continue anyway');
    if readkey<>#13 then halt;
  end;
end;

otb:=0;
inint:=false;
intab:=false;
e:=nil;
c:=e;
f:=nil;
d:=f;
topics:=0;
lines:=0;
tables:=0;
sm:=memavail;

assign(fi,infile);
reset(fi,1);
while not eof(fi) do begin
  fp:=filepos(fi);
  blockread(fi,s[1],90,di);
  if di<90 then s[di]:=#13;
  di:=1;
  while s[di]<>#13 do inc(di);
  if di>90 then errorh('line too long');
  s[0]:=chr(di-1);
  seek(fi,fp+di+1);
  inc(lines);
  if inint then begin
    if c^.lines=65000 then errorh('to many lines in topic');
    inc(c^.lines);
  end;
  if intab then inc(d^.lines);
  if s='' then intab:=false;
  write(#13'processing line  :',lines:8,' topics :',topics:5, ' tables :',tables:5,fp*100/filesize(fi):6:1,'%');
  if copy(s,1,8)='--------' then begin
    inint:=false;
    intab:=false;
    if s[9]<>'!' then begin
      inint:=true;
      inc(topics);
      delete(s,1,10);
      if maxavail<sizeof(ms) then errorh('out of memory');
      getmem(t,sizeof(ms));
      if e=nil then
        e:=t
      else c^.next:=t;
      c:=t;
      t^.pos:=filepos(fi);
      t^.next:=nil;
      t^.regs:=0;
      t^.lines:=$ffff;
      t^._al:=0;
      t^._ah:=0;
      t^._bl:=0;
      t^._bh:=0;
      t^._cl:=0;
      t^._ch:=0;
      t^._dl:=0;
      t^._dh:=0;
      t^._si:=0;
      t^._di:=0;
      db:=get_dat;
      t^._int:=b;
      if get_dat then begin
        t^.regs:=t^.regs or 1;
        t^._ah:=b;
        if get_dat then begin
          t^.regs:=t^.regs or 2;
          t^._al:=b;
        end;
      end;
      if pos('BX',s)>0 then begin
        insert('BH',s,pos('BX',s)+2);
        insert('BL',s,pos('BH',s)+4);
        delete(s,pos('BX',s),2);
      end;
      if pos('BH',s)>0 then begin
        delete(s,1,pos('BH',s)+1);
        db:=get_dat;
        t^.regs:=t^.regs or 4;
        t^._bh:=b;
      end;
      if pos('BL',s)>0 then begin
        delete(s,1,pos('BL',s)+1);
        db:=get_dat;
        t^.regs:=t^.regs or 8;
        t^._bl:=b;
      end;
      if pos('CX',s)>0 then begin
        insert('CH',s,pos('CX',s)+2);
        insert('CL',s,pos('CH',s)+4);
        delete(s,pos('CX',s),2);
      end;
      if pos('CH',s)>0 then begin
        delete(s,1,pos('CH',s)+1);
        db:=get_dat;
        t^.regs:=t^.regs or 16;
        t^._ch:=b;
      end;
      if pos('CL',s)>0 then begin
        delete(s,1,pos('CL',s)+1);
        db:=get_dat;
        t^.regs:=t^.regs or 32;
        t^._cl:=b;
      end;
      if pos('DX',s)>0 then begin
        insert('DH',s,pos('DX',s)+2);
        insert('DL',s,pos('DH',s)+4);
        delete(s,pos('DX',s),2);
      end;
      if pos('DH',s)>0 then begin
        delete(s,1,pos('DH',s)+1);
        db:=get_dat;
        t^.regs:=t^.regs or 64;
        t^._dh:=b;
      end;
      if pos('DL',s)>0 then begin
        delete(s,1,pos('DL',s)+1);
        db:=get_dat;
        t^.regs:=t^.regs or 128;
        t^._dl:=b;
      end;
      if pos('SI',s)>0 then begin
        delete(s,1,pos('SI',s)+1);
        db:=get_dat;
        t^._si:=b;
        db:=get_dat;
        t^._si:=t^._si*256+b;
        t^.regs:=t^.regs or 256 or 512;
      end;
      if pos('DI',s)>0 then begin
        delete(s,1,pos('DI',s)+1);
        db:=get_dat;
        t^._di:=b;
        db:=get_dat;
        t^._di:=t^._di*256+b;
        t^.regs:=t^.regs or 1024 or 2048;
      end;
      if t^.regs=0 then t^.regs:=4095;            {sensitive for all register}
    end;
  end else if pos('(Table ',s)>0 then begin
    val(copy(s,pos('(Table ',s)+7,4),tb,di);
    if maxavail<sizeof(mt) then errorh('out of memory');
    getmem(u,sizeof(mt));
    u^.next:=nil;
    if f=nil then
      f:=u
    else d^.next:=u;
    d:=u;
    u^.num:=tb;
    if pos('(Table ',s)=1 then begin
      u^.lines:=0;
      u^.pos:=fp;
    end else begin
      u^.lines:=1;
      u^.pos:=ofp;
    end;
    intab:=true;
    inc(tables);
    otb:=tb;
  end;
  ofp:=fp;
end;
done;
close(fi);
assign(fo,outfile);
rewrite(fo,1);
blockwrite(fo,topics,2);
blockwrite(fo,tables,2);
t:=e;
lines:=0;
while t<>nil do begin
  blockwrite(fo,t^,sizeof(ms)-sizeof(msp));
  t:=t^.next;
  inc(lines);
  write(#13'writing topic index :',lines:5,lines*100/topics:6:1,'%');
end;
done;
mod_flag:=true;
otb:=0;
while mod_flag do begin
  u:=f;
  mod_flag:=false;
  write(#13'sorting table index : ',pr[otb+1]);
  otb:=(otb+1) mod 4;
  repeat
    if u^.num>u^.next^.num then begin
      mod_flag:=true;
      lines:=u^.next^.num;
      u^.next^.num:=u^.num;
      u^.num:=lines;
    end;
    u:=u^.next;
  until u^.next=nil;
end;
done;
u:=f;
lines:=0;
otb:=0;
while u<>nil do begin
  if u^.num<>otb+1 then begin
    writeln(#10#13'warning : missing tables between ',otb,' and ',u^.num,'..creating dummy');
    for di:=otb+1 to u^.num-1 do begin
      ofp:=2;
      blockwrite(fo,ofp,2);
      ofp:=0;
      blockwrite(fo,ofp,4);
    end;
  end;
  otb:=u^.num;
  blockwrite(fo,u^,sizeof(mt)-sizeof(mtp)-4);
  u:=u^.next;
  inc(lines);
  write(#13'writing table index :',lines:5,lines*100/tables:6:1,'%');
end;
done;
close(fo);
writeln('temporary used memory ',sm-memavail,' bytes');
writeln('done.');
end.
