/* REXX */

/*
-----------------------------------------------------------------
  unpacker (v0.1) = public domain : free for any use

  AUTHOR: rugxulo _AT_ gmail

  TESTED: Regina 3.7, BRexx 2.1.9, r4 4.00, ooREXX 4.1.3

  BUG:    Can't use literal '*'+'/' pair in embedded data files.
-----------------------------------------------------------------
*/

/* --- UNPACKER BEGINS --- */

if arg() \= 0 then parse arg onlyfile . ; else onlyfile=''
parse source . . srcfile . ; lineno=0 ; writeln=0

bar = '===' ; prefix='/*' bar ; postfix = bar '*/'
headpost=' begins' postfix ; footpost=' ends' postfix
headlen=length(headpost) ; footlen=length(footpost)

if lines(srcfile)=1 then do while lines(srcfile) \= 0
  call grab
end
else do lines(srcfile)
  call grab
end

exit

grab:
  line=linein(srcfile) ; lineno=lineno+1
  if pos(headpost,line) \= 0 then do
    parse var line ' ' (bar) ' ' outfile (headpost) .
    if onlyfile='' then say outfile
    writeln=1
  end
  else if pos(footpost,line) \= 0 then writeln=0
  if pos(headpost,line)=0 & pos(footpost,line)=0 & writeln then ,
    if onlyfile='' | onlyfile=outfile then ,
      call lineout outfile, line
return

/* --- UNPACKER ENDS --- */

/*
------------------------------------------------------------
*** DATA BEGINS DATA BEGINS DATA BEGINS DATA BEGINS ***

/* these data files = public domain : free for any use */
------------------------------------------------------------

/* === invturbo.pas begins === */
{$ifdef FPC}{$mode tp}{$endif}
{$ifdef NODEBUG}{$R-,S-}{$else}{$R+,S+}{$endif}
{$ifdef CPU86}{$ifdef MSDOS}{$M 4096,0,196608}{$endif}{$endif}

program invturbo; {public domain, nenies proprajho, free for any use}
uses bytename,loadfile;

{$ifdef VER55}{$F+}{$endif}
procedure adjust(var oldline:pstring);
  type str20=string[20];
  var p,p2:integer; line:string[maxoldlinelen]; op:str20; size:string[4];

  function find(s:string):integer;
  begin find := pos(s,line)
  end; {find}

  function found(s:string):boolean;
  begin p := find(s); found := p <> 0
  end; {found}

  procedure finddel(s:string);
  begin
    if found(s) then line := copy(line,1,p-1) + copy(line,p+length(s),length(line)-(p+length(s))+1)
  end; {finddel}

  procedure replace(no,yes:string);
  var i:integer;
  begin
    if found(no) then for i := 1 to length(yes) do line[p+i-1] := yes[i]
  end; {replace}

  function fixname(myop:str20):linetype;
  var name:str20; i:integer;
  begin
    name := myop; i := pos('[',name);
    if i <> 0 then begin
      name := copy(name,1,i-1); myop := name + '+' + myop[length(myop)-1]
    end;
    if isbytename(name) then size := 'byte' else size := 'word';
    fixname := copy(line,1,p-1) + size + ' ptr[' + myop + ']'
  end; {fixname}

  function fixop1:boolean;
  const tab=#9;
  begin
    fixop1 := false;
    p := find(','); dec(p); p2 := p;
    while not (line[p] in [' ',tab]) do dec(p); inc(p);
    op := copy(line,p,p2-p+1);
    if (length(op) > length('DX')) and (op[1] in ['A'..'Z']) and (op[1] <> '[') then begin
      line := fixname(op) + copy(line,p2+1,length(line)-(p2+1)+1);
      fixop1 := true
    end
  end; {fixop1}

  procedure fixop2;
  begin
    p := find(','); inc(p); p2 := p;
    while (p2 < length(line)) and (line[p2] <> ' ') do inc(p2);
    if line[p2] = ' ' then dec(p2);
    if length(copy(line,p,p2-p+1)) > length('DX') then begin
      op := copy(line,p,p2-p+1);
      if (op[1] in ['A'..'Z']) and (op[1] <> '[') and ((length(op) > 2) and (op[3] <> ':')) then
        line := fixname(op)
    end
  end; {fixop2}

  procedure incdec;
  begin
    p := find('INC '); if p = 0 then p := find('DEC ');
    if p > 0 then begin
      while line[p] <> ' ' do inc(p); while line[p] = ' ' do inc(p);
      p2 := p; while (p2 < length(line)) and (line[p2] <> ' ') do inc(p2);
      if line[p2] = ' ' then dec(p2);
      if length(copy(line,p,p2)) > length('DX') then begin
        op := copy(line,p,p2);
        if (op[1] in ['A'..'Z']) and (op[1] <> '[') then
          line := fixname(op)
      end
    end
  end; {incdec}

  procedure fixplusbx;
  begin
    p2 := find('['); op := copy(line,p2+1,p-p2-1);
    if isbytename(op) then size := 'byte' else size := 'word';
    line := copy(line,1,p2-1) + size + ' ptr' + copy(line,p2,length(line)-p2+1)
  end; {fixplusbx}

  procedure fixlea;
  begin
    replace('LEA ','MOV '); p2 := find(',');
    line := copy(line,1,p2) + 'OFFSET ' + copy(line,p2+1,length(line)-(p2+1)+1)
  end; {fixlea}

  procedure jmpshort;
  const jumpnum:integer=0;
  begin
    inc(jumpnum);
    if not (jumpnum in
      [3..6,12,14,17,19..21,23,24,30,36,39,42,45,47..70,89]) then
        line := copy(line,1,p+3) + 'SHORT ' + copy(line,p+4,length(line)-(p+4)+1)
  end; {jmpshort}

  procedure fixseg;
  const cseg:boolean=false;
  begin
    if found('RemoveNewInt9:') or found('CLC') then cseg := not cseg;
    if cseg and found('MOV ') and (not found('[0')) and found('[') then
      line := copy(line,1,p-1) + ' cs:' + copy(line,p,length(line)-p+1)
  end; {fixseg}

begin {adjust}
  if length(oldline^) > 0 then begin
    line := oldline^;

    if found('Assume') or found('ENDP') then line := '';

    finddel('[0]'); finddel('Word Ptr ');

    if found('+BX') then
      fixplusbx
    else if found('LEA ') then
      fixlea
    else if found(' PROC ') then
      line := copy(line,1,find(' ')-1) + ':'
    else if found('JMP ') then
      jmpshort;

    if not found(',') then
      incdec
    else if not (found(' DB ') or found(' DW ')
      or found(',OF') or found(',Of') or found('ASSUME')) then
        if not fixop1 then fixop2;

    fixseg; replace('40:','DS:');

    oldline^ := line
  end
end; {adjust}
{$ifdef VER55}{$F-}{$endif}

begin {main}
  {$ifdef MEMAVAIL}writeln('memavail = ',memavail);{$endif} {196736}

  assign(oldasm,'INVADERS.ASM'); reset(oldasm);
  load; writeln('loaded'); close(oldasm);
  {$ifdef MEMAVAIL}writeln('memavail = ',memavail);{$endif} { 29388}
  doall(adjust); writeln('adjusted');

  assign(newasm,'inv.asm'); rewrite(newasm);
  doall(show); writeln('written'); close(newasm); cleanup;
  {$ifdef MEMAVAIL}writeln('memavail = ',memavail){$endif}  {196736}
end.
/* === invturbo.pas ends === */

/* === bytename.pas begins === */
{$ifdef FPC}{$mode tp}{$endif}
{$ifdef NODEBUG}{$R-,S-}{$else}{$R+,S+}{$endif}
unit bytename; {public domain, nenies proprajho, free for any use}

interface

const maxbytenames=60;
type bytenamestr=string[19];
var bytenames:array [1..maxbytenames] of bytenamestr;
procedure getbytenames(s:string);
function isbytename(name:string):boolean;

implementation

procedure getbytenames(s:string);
const bytenum:integer=1;
begin
  if (s[1] in ['A'..'Z']) and (pos(' DB ',s) > 0) then begin
    bytenames[bytenum] := copy(s,1,pos(' ',s)-1); inc(bytenum)
  end
end; {getbytenames}

function isbytename(name:string):boolean;
var i:integer; done:boolean;
begin i := 1; done := false;
  while (i <= maxbytenames) and (not done) do begin
    done := bytenames[i] = name;
    inc(i)
  end;
  isbytename := done
end; {isbytename}

end.
/* === bytename.pas ends === */

/* === loadfile.pas begins === */
{$ifdef FPC}{$mode tp}{$endif}
{$ifdef NODEBUG}{$R-,S-}{$else}{$R+,S+}{$endif}
unit loadfile; {public domain, nenies proprajho, free for any use}

interface

const maxlines=2276; maxlinelen=72; maxoldlinelen=131; linesread:integer=0;
type pstring=^linetype; linetype=string[maxlinelen];
     doitproc=procedure(var line:pstring);
var src:array [1..maxlines] of pstring; oldasm,newasm:text;

procedure load;
procedure doall(doit:doitproc);
procedure show(var line:pstring);
procedure cleanup;

implementation

uses bytename;

procedure load;
var line:string[maxoldlinelen];

  procedure nocomments;
  var p:integer;
  begin
    p := pos(';',line);
    if p <> 0 then begin
      if p > 1 then dec(p); while line[p] = ' ' do dec(p);
      line := copy(line,1,p)
    end
  end; {nocomments}

  procedure nospaces;
  const twoblanks='  ';
  var p,p2:integer;
  begin
    p := pos('"',line);
    if p > 0 then begin
      p2 := pos(' DB ',line); while line[p2] = ' ' do dec(p2);
      line := copy(line,1,p2) + ' DB ' + copy(line,p,length(line)-p+1)
    end
    else
      while pos(twoblanks,line) > 0 do begin
        p := pos(twoblanks,line);
        if p > 0 then begin
          p2 := p;
          while (line[p2] = ' ') do inc(p2);
          line := copy(line,1,p) + copy(line,p2,length(line)-p2+1)
        end
      end
  end; {nospaces}

begin {load}
  while not eof(oldasm) do begin
    readln(oldasm,line); inc(linesread);
    if (length(line) = 0) or (line[1] = ';') then
      dec(linesread)
    else begin
      nocomments; nospaces;
      new(src[linesread]); src[linesread]^ := line;
      getbytenames(src[linesread]^)
    end
  end
end; {load}

procedure doall(doit:doitproc);
var i:integer;
begin for i := 1 to linesread do doit(src[i])
end; {doall}

procedure show(var line:pstring);
begin if length(line^) > 0 then writeln(newasm,line^)
end; {show}

procedure cleanup;
var i:integer;
begin for i := 1 to linesread do dispose(src[i])
end; {cleanup}

end.
/* === loadfile.pas ends === */


# --- extract.awk begins ---
#!/usr/bin/awk -f

/[b]egins ===/{
  fname=$3 ; print fname
  while (getline > 0) {
    if ($0 !~ / [e]nds ===/) {
      print > fname
    }
    else {
      close(fname)
      break
    }
  }
}
# --- extract.awk ends ---

------------------------------------------------------------
*** DATA ENDS DATA ENDS DATA ENDS DATA ENDS ***
------------------------------------------------------------
*/

/* EOF */
