/* 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 */
------------------------------------------------------------

/* === invep.pas begins === */
{$extended-pascal}
program invep(output,oldasm,newasm); {public domain, nenies proprajho, free for any use}
import bytename; loadfile;

procedure adjust;
  var jumpnum:integer value 0; cseg:boolean value false;

  procedure dec(var i:integer); begin i:=i-1 end; {dec}
  procedure inc(var i:integer); begin i:=i+1 end; {inc}

  procedure adjustit(var oldline:pstring);
  var p,p2:integer; line:linetype; op:string(20); size:string(4);

    function find(s:string):integer;
    begin find := index(line,s)
    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 := substr(line,1,p-1) + substr(line,p+length(s))
    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:string):linetype;
    var name:string(20); i:integer;
    begin
      name := myop; i := index(name,'[');
      if i <> 0 then begin
        name := substr(name,1,i-1); myop := name + '+' + myop[length(myop)-1]
      end;
      if isbytename(name) then size := 'byte' else size := 'word';
      fixname := substr(line,1,p-1) + size + ' ptr[' + myop + ']'
    end; {fixname}

    function fixop1:boolean;
    const tab=chr(9);
    begin
      fixop1 := false;
      p := find(','); dec(p); p2 := p;
      while not (line[p] in [' ',tab]) do dec(p); inc(p);
      op := substr(line,p,p2-p+1);
      if (length(op) > length('DX')) and (op[1] in ['A'..'Z']) and (op[1] <> '[') then begin
        line := fixname(op) + substr(line,p2+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(substr(line,p,p2-p+1)) > length('DX') then begin
        op := substr(line,p,p2-p+1);
        if (op[1] in ['A'..'Z']) and_then (op[1] <> '[') and_then ((length(op) > 2) and_then (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(substr(line,p,p2-p+1)) > length('DX') then begin
          op := substr(line,p,p2-p+1);
          if (op[1] in ['A'..'Z']) and (op[1] <> '[') then
            line := fixname(op)
        end
      end
    end; {incdec}

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

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

    procedure jmpshort;
    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 := substr(line,1,p+3) + 'SHORT ' + substr(line,p+4)
    end; {jmpshort}

    procedure fixseg;
    begin
      if found('RemoveNewInt9:') or found('CLC') then cseg := not cseg;
      if cseg and_then found('MOV ') and_then (not found('[0')) and_then found('[') then
        line := substr(line,1,p-1) + ' cs:' + substr(line,p)
    end; {fixseg}

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

      if found('Assume') or_else 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 := substr(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:');

      new(oldline,length(line)); oldline^ := line
    end
  end; {adjustit}

var oldbind,newbind:bindingtype;

begin {adjust}
  oldbind := binding(oldasm); oldbind.name := 'INVADERS.ASM';
  bind(oldasm,oldbind);
  if not binding(oldasm).existing then begin
    writeln('Not found!'); halt
  end;
  reset(oldasm);

  load; writeln('loaded'); doall(adjustit); writeln('adjusted');

  newbind := binding(newasm); newbind.name := 'inv.asm';
  bind(newasm,newbind); rewrite(newasm);

  doall(show); writeln('written'); cleanup
end; {adjust}

begin {main}
  adjust
end.
/* === invep.pas ends === */

/* === bytename.pas begins === */
{$extended-pascal}
module bytename; {public domain, nenies proprajho, free for any use}
export bytename = (bytenames,getbytenames,isbytename);

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

end;

{ ============================================================ }

procedure getbytenames;
const maxbytenamelen=19;
begin
  if (s[1] in ['A'..'Z']) and_then (index(s,' DB ') > 0) then begin
    bytenames[bytenum] := s[1..index(s,' ')-1]; bytenum := bytenum+1
  end
end; {getbytenames}

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

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

/* === loadfile.pas begins === */
{$extended-pascal}
module loadfile; {public domain, nenies proprajho, free for any use}
export loadfile = (pstring,linetype,oldasm,newasm,load,doall,show,cleanup);

const maxlines=2956; maxlinelen=131;
type pstring=^string; linetype=string(maxlinelen);
var src:array [1..maxlines] of pstring; linesread:integer value 0;
    oldasm,newasm:bindable text;

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

end;

{ ============================================================ }

import bytename;

procedure load;
var line:linetype;

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

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

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

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

procedure show;
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 */
