/* 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:bigline; 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
    fromold(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:');

    toold(oldline,line);
  end
end; {adjust}
{$ifdef VER55}{$F-}{$endif}

procedure showmem;
begin {$ifdef MEMAVAIL}writeln('memavail = ',memavail);{$else}writeln{$endif}
end; {showmem}

begin {main}
  showmem;

  assign(oldasm,'INVADERS.ASM'); reset(oldasm);
  load; writeln('loaded'); close(oldasm);
  showmem;

  doall(adjust); writeln('adjusted');
  showmem;

  assign(newasm,'inv.asm'); rewrite(newasm);
  doall(show); writeln('written'); close(newasm); cleanup;

  showmem
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]; bigline=string[maxoldlinelen];
     doitproc=procedure(var line:pstring);
var src:array [1..maxlines] of pstring; oldasm,newasm:text;

procedure load;
procedure toold(var older:pstring; var newer:bigline);
procedure fromold(var newer:bigline; var older:pstring);
procedure doall(doit:doitproc);
procedure show(var line:pstring);
procedure cleanup;

implementation

uses bytename;

var strlensize:byte;

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;
{$ifndef NOGETMEM}getmem(src[linesread],length(line)+strlensize);
{$else}new(src[linesread]);
{$endif}
      src[linesread]^ := line;
      getbytenames(src[linesread]^)
    end
  end
end; {load}

procedure toold(var older:pstring; var newer:bigline);
begin
{$ifndef NOGETMEM}getmem(older,length(newer)+strlensize);{$endif}
  older^ := newer
end; {toold}

procedure fromold(var newer:bigline; var older:pstring);
begin newer := older^;
{$ifndef NOGETMEM}freemem(older,length(older^)+strlensize){$endif}
end; {fromold}

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
{$ifndef NOGETMEM}freemem(src[i],length(src[i]^)+strlensize)
{$else}dispose(src[i])
{$endif}
end; {cleanup}

var str1:string[1];

begin strlensize := sizeof(str1)-sizeof(char)
end.
/* === loadfile.pas ends === */

/* === fpcturbo.txt begins === */
INVTURBO.EXE = INVTURBO.PAS + LOADFILE.PAS + BYTENAME.PAS
             = (optional define) "NOGETMEM"

input  = INVADERS.ASM
output = INV.ASM

  INVADERS.ASM = 137,621 bytes, 2956 lines, 131 maximum line length
  INV.ASM      =  52,610 bytes, 2190 lines,  72 maximum line length

(using "-dMEMAVAIL -dNODEBUG -dNOGETMEM"):

  TP  5.5   DOS         Large   =  9,472 byte .EXE = 166,148 bytes mem used
  FPC 3.2.2 i8086-msdos Compact = 32,120 byte .EXE = 182,080 bytes mem used

(using "-dMEMAVAIL -dNODEBUG"):

  TP                            =  9,600 byte .EXE =  50,514 bytes mem used
  FPC                           = 32,264 byte .EXE =  68,052 bytes mem used

(IIRC, TP has smaller 8-byte-based malloc vs. DOS default 16-byte paragraphs)

(so FPC's Small model [128 kb total] should work, right??)

  FPC                   Small   = 21,890 byte .EXE = *** RUNTIME ERROR 203 ***

(only 51,870 bytes mem free at startup of Small model .EXE)

Too bad!


(* --- HELLO.PAS begins --- *)
{$ifdef FPC}{$mode tp}{$endif}
{$ifdef CPU86}{$ifdef MSDOS}{$M 4096,0,640000}{$endif}{$endif}
                            {N.B. saving 12 kb of memory with reduced stack}
program hello; {FreeDOS kernel 2041; 613,264 bytes conventional memory free}
begin writeln(memavail)
end.
  { FPC 3.2.2 i8086-msdos vs. TP 5.5 DOS }

  { FPC Tiny    =  44,994; .EXE = 14,594 }
  {  "  Small   =  59,098; .EXE = 14,538 }
  {  "  Medium  =  58,982; .EXE = 16,128 }
  {  "  Compact = 583,516; .EXE = 22,928 }
  {  "  Large   = 581,884; .EXE = 24,790 }
  {  "  Huge    = 580,844; .EXE = 28,402 }

  { TP  Large   = 604,800, .EXE =  2,912 }
(* --- HELLO.PAS ends --- *)
/* === fpcturbo.txt ends === */

/* === p2c.bug begins === */
The (circa 1999) DJGPP build of P2C 1.20 (p2c.exe) won't translate
LOADFILE.PAS correctly (crashes / SIGSEGV). Previously, it would only
work on the second try (??), but now it won't even do that.

(EDIT: Okay, try "-M0", then LOADFILE translates okay, but you'll
still have to do the following fix.)

Ironically, the OpenWatcom-built .EXE (see P2C_WAT.MAK) will (now)
still work if you delete these four lines first (done automatically
in the makefile by OpenWatcom's VI):

  gsed -i~ -e "/mem(/d" loadfile.pas

In other words, P2C doesn't like "getmem() / freemem()" but prefers
the older (less efficient) way with "new() / dispose()" instead.

N.B. P2C ignores all preprocessor (e.g. "{$ifdef}") commands and
     compiles *everything*! (Hey, I tried to make it easy.)
/* === p2c.bug 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 */
