program odlgen;
{  odl conversion program - for use with nbs pascal 1.6 }
{  18 April 1980  }


{ this program converts odl files with module names in the form
  %IIInnn to actual procedure names enclosed in % 's and vice versa.
 The program solicits an option number:
         1 implies convert names to III  form,
         2 implies convert III to names.

  The program uses 3 files:
    
       sfile - output from pass 2 of compiler with 'p' option.

       odl   - the input odl file.

       newodl - the output odl file.

  Note that when option 1 is used the input odl file must contain
       the procedure names enclosed in % 's, e.g %getbyte% .
       when option 2 is used the input odl file must contain procedure
       name in the form %IIInnn  .
 
  Program usage:
 
  odlgen sfile.ext odl.ext newodl.ext
 
  written by:
    Stephen Kamnitzer
    Consolidated Computer
    50 Gervais Drive
    Don Mills
    Ontario, Canada, M3C 1Z3
 
  minor modifications by:
    Bill Heidebrecht
    TRW DSSG
    One Space Park
    Redondo Beach, CA 90278
}

const
  maxlen = 20;
  maxsym = 255;
 
type
  stabrec = record
    snum: integer;
    sname: array [1..maxlen] of char
  end;
 
var
  c: char;
  stab: array [0..maxsym] of stabrec;
  sp: integer;
  ok: boolean;
  sfile, odl, newodl: text;
 
 
function getodl: char;
begin
  getodl := odl@; get(odl);
end {getodl} ;
 
procedure putnewodl(c:char);
begin
  newodl@ := c; put(newodl);
end {putnewodl} ;
 
 
procedure iiitosymb;
var c,d,c1,c2,c3: char;
  i,j,n:integer;
begin
while not eof(odl) do
begin
  n := 0;
  d := getodl; putnewodl(d);
  if d = '%' then
    begin
      c1 := getodl; c2 := getodl; c3 := getodl;
     if (c1='I') and (c2='I') and (c3='I') then        
      begin
        for i := 1 to 3 do
          begin
             c := getodl;
             if (c <'0') or (c > '9') then writeln(output,'bad IIIXXX')
             else n := 10 * n + ord(c) - ord('0');
          end;
    i := 1;
    while ( i <= sp) and (stab[i].snum <> n ) do i := succ(i);
    if i > sp then
    begin
      writeln(output,n,' not found'); break(output);
      putnewodl('?')
    end
    else for j := 1 to 18 do
         if stab[i].sname[j]<>' ' then putnewodl(stab[i].sname[j]);
    putnewodl('%');
    end
    else writeln(output,' % not followed by III');
    end;
end {while}
end {iiitosymb};
 
 
procedure symbtoiii;
var
  c:char;
  nm: array [1..maxlen] of char;
  len,i,j,n:integer;
  c3: array [1..3] of char;
begin
while not eof(odl) do
begin
c :=getodl;
if c = '%' then 
  begin
     for i := 1 to maxlen do nm[i] := ' ';
     c := getodl; i :=1;
     while (c <> '%') and (i < maxlen) do
       begin
         nm[i] := c; i := succ(i);
         c := getodl;
       end;
     if i > maxlen then begin writeln(output,' name too long');
       break(output); end;
     i := 1;
     while (nm <>stab[i].sname) and (i <=sp) do i :=succ(i);
     if i > sp then
     begin
       writeln(output,nm, ' not found'); break(output);
       putnewodl('?');  i := 1
     end;
      n := stab[i].snum;
      for i := 1 to 3 do putnewodl('I');
      for i := 3 downto 1 do
       begin
        c3[i] := chr( (n mod 10) +ord('0')); n := n div 10;
      end;
      for i := 1 to 3 do putnewodl(c3[i]);
  end {= '%'}
else putnewodl(c);
end {while};
end {symbtoiii} ;
 
 
function getbyte: char;
begin
  getbyte := sfile@; get(sfile);
end {getbyte};
 
 
procedure readsyms;
var
  i,j,n: integer;
  c:char;
begin
  sp :=0;
while not eof(sfile) do
    begin
      if sp < maxsym then sp := succ(sp)
	else writeln(output, ' Too many procedures.');
      with stab[sp] do
        begin
          for i :=1 to maxlen do sname[i] := ' ';
           snum := 0;
           for j := 1 to 3 do
            begin
               c := getbyte;
               if c = ' ' then n := 0 
              else n := ord(c) - ord('0');
               if (n<0) or (n>9) then begin writeln(output,'bad procnr');
                         break(output); end;
                   snum := 10 * snum + n;
               end;
               c :=getbyte; c := getbyte;
              for i := 1 to 18 do sname[i] := getbyte;
       break(output);
        end;
       readln(sfile); c := getbyte;
    end;
  writeln(output, sp:6, ' symbols read.')
end {readsyms};
 
 
procedure openfiles;
begin
  if argc = 4 then
  begin
    ok := true;
    reset  (sfile,  argv[1]@, 2);
    reset  (odl,    argv[2]@, 2);
    rewrite(newodl, argv[3]@, 2)
  end else
  begin
    ok := false;
    writeln(output, ' Incorrect number of args.')
  end
end {openfiles};
 
 
begin {odlgen}
  openfiles;
  if ok then
  begin
    readsyms;
    writeln(output,' Enter 1 if symb to III, or 2 if III to symb:');
    break(output);
    readln(input,c);
    if c = '1' then symbtoiii
      else if c = '2' then iiitosymb
      else writeln(output, ' Illegal option.')
  end {if ok}
end {odlgen} .
                           