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

/* === bytename.def begins === */
DEFINITION MODULE bytename;

CONST maxbytenames=60;
TYPE bytenamestr=ARRAY [0..19] OF CHAR;
VAR bytenames:ARRAY [1..maxbytenames] OF bytenamestr;

PROCEDURE getbytenames(s:ARRAY OF CHAR);
PROCEDURE isbytename(name:ARRAY OF CHAR):BOOLEAN;

END bytename.
/* === bytename.def ends === */

/* === bytename.mod begins === */
(* public domain, nenies proprajho, free for any use *)
IMPLEMENTATION MODULE bytename;
FROM Str IMPORT FindNext,Extract,CompareStr;
VAR bytenum:INTEGER;

PROCEDURE getbytenames(s:ARRAY OF CHAR);
VAR found:BOOLEAN; here:CARDINAL;
BEGIN
  IF ((s[0] >= 'A') & (s[0] <= 'Z')) THEN
    FindNext(" DB ",s,0,found,here);
    IF found THEN
      FindNext(" ",s,0,found,here);
      Extract(s,0,here,bytenames[bytenum]);
      INC(bytenum)
    END
  END
END getbytenames;

PROCEDURE isbytename(name:ARRAY OF CHAR):BOOLEAN;
VAR i:INTEGER; done:BOOLEAN;
BEGIN i := 1; done := FALSE;
  WHILE (i <= maxbytenames) & ~done DO
    done := CompareStr(bytenames[i],name) = 0;
    INC(i)
  END;
  RETURN done
END isbytename;

BEGIN bytenum := 1
END bytename.
/* === bytename.mod ends === */

/* === loadfile.def begins === */
DEFINITION MODULE loadfile;

CONST maxlinelen=72; maxoldlinelen=131;
TYPE pstring=POINTER TO linetype; linetype=ARRAY [0..maxlinelen] OF CHAR;
     oldlinetype=ARRAY [0..maxoldlinelen] OF CHAR;
     doitproc=PROCEDURE (VAR pstring);

PROCEDURE load;
PROCEDURE doall(doit:doitproc);
PROCEDURE show(VAR line:pstring);

END loadfile.
/* === loadfile.def ends === */

/* === loadfile.mod begins === */
(* public domain, nenies proprajho, free for any use *)
IMPLEMENTATION MODULE loadfile;
FROM InOut IMPORT Read,WriteString,WriteLn,Done,EOL;
FROM Storage IMPORT ALLOCATE;
FROM Str IMPORT FindNext,Extract,Append,Assign,Length;
FROM bytename IMPORT getbytenames;

CONST maxlines=2276;
VAR src:ARRAY [1..maxlines] OF pstring; linesread:CARDINAL;

PROCEDURE load;
VAR line:oldlinetype;

  PROCEDURE nocomments;
  VAR found:BOOLEAN; here:CARDINAL;
  BEGIN
    FindNext(";",line,0,found,here);
    IF found THEN
      IF here > 0 THEN DEC(here) END; WHILE line[here] = ' ' DO DEC(here) END;
      Extract(line,0,here+1,line)
    END
  END nocomments;

  PROCEDURE nospaces;
  CONST twoblanks="  ";
  VAR p,p2,len:CARDINAL; X,X2:oldlinetype; found:BOOLEAN;
  BEGIN
    FindNext('"',line,0,found,p);
    IF found THEN
      FindNext(" DB ",line,0,found,p2); WHILE line[p2] = ' ' DO DEC(p2) END;
      Extract(line,0,p2+1,X);
      len := Length(line); Extract(line,p,len-p+1,X2);
      Assign(X,line); Append(" DB ",line); Append(X2,line);
    ELSE
      REPEAT
        FindNext(twoblanks,line,0,found,p);
        IF found THEN
          p2 := p;
          WHILE line[p2] = ' ' DO INC(p2) END;
          Extract(line,0,p+1,X);
          len := Length(line); Extract(line,p2,len-p2+1,X2);
          Assign(X,line); Append(X2,line)
        END
      UNTIL ~found;
    END
  END nospaces;

  PROCEDURE readline(VAR buf:ARRAY OF CHAR):BOOLEAN;
  CONST Tab=11C;
  VAR k:CHAR; i:INTEGER;
  BEGIN i := 0;
    REPEAT
      Read(k); IF ~Done THEN RETURN FALSE END;
      IF (k > EOL) OR (k = Tab) THEN
        buf[i] := k;
        INC(i)
      END
    UNTIL k = EOL;
    buf[i] := 0C; RETURN TRUE
  END readline;

BEGIN (* load *)
  linesread := 0;
  REPEAT
    IF readline(line) THEN INC(linesread) END;
    IF (Length(line) = 0) OR (line[0] = ';') THEN
      DEC(linesread)
    ELSE
      nocomments; nospaces;
      ALLOCATE(src[linesread],SIZE(linetype)); (* NEW(src[linesread]); *)
      Assign(line,src[linesread]^);
      getbytenames(src[linesread]^)
    END
  UNTIL ~Done
END load;

PROCEDURE doall(doit:doitproc);
VAR i:CARDINAL;
BEGIN FOR i := 1 TO linesread DO doit(src[i]) END
END doall;

PROCEDURE show(VAR line:pstring);
BEGIN
  IF Length(line^) > 0 THEN
    WriteString(line^); WriteLn
  END
END show;

END loadfile.
/* === loadfile.mod ends === */

/* === invmod2.mod begins === */
(* public domain, nenies proprajho, free for any use *)
MODULE invmod2;
FROM loadfile IMPORT pstring,oldlinetype,load,doall,show;
FROM bytename IMPORT isbytename;
FROM InOut IMPORT OpenInput,CloseInput,OpenOutput,CloseOutput,
       WriteString,WriteLn,Done;
FROM Str IMPORT FindNext,Extract,Append,Assign,Length;

MODULE shortjumps;
IMPORT Extract,Length,Append,oldlinetype;
EXPORT jmpshort;
VAR jumpnum:CARDINAL;
PROCEDURE jmpshort(at:CARDINAL; VAR l:oldlinetype);
VAR X,X2:oldlinetype; len:CARDINAL;
BEGIN INC(jumpnum);
  CASE jumpnum OF
    3..6,12,14,17,19..21,23,24,30,36,39,42,45,47..70,89: ;
  ELSE
    Extract(l,0,at+4,X); X[at+4] := 0C;
    len := Length(l); Extract(l,at+4,len-(at+4)+1,X2);
    l := X; Append("SHORT ",l); Append(X2,l)
  END
END jmpshort;
BEGIN jumpnum := 0
END shortjumps;

MODULE segoverride;
IMPORT FindNext,Extract,Append,Length,oldlinetype;
EXPORT fixseg;
VAR cseg:BOOLEAN;
PROCEDURE fixseg(VAR l:oldlinetype);
VAR at,len:CARDINAL; X,X2:oldlinetype;
  PROCEDURE found(s:ARRAY OF CHAR):BOOLEAN;
  VAR isfound:BOOLEAN;
  BEGIN FindNext(s,l,0,isfound,at);
  RETURN isfound
  END found;
BEGIN
  IF found("RemoveNewInt9:") OR found("CLC") THEN cseg := ~cseg END;
  IF cseg & found("MOV ") & ~found("[0") & found("[") THEN
    Extract(l,0,at,X); Append(" cs:",X);
    len := Length(l); Extract(l,at,len-at+1,X2);
    l := X; Append(X2,l)
  END
END fixseg;
BEGIN cseg := FALSE
END segoverride;

PROCEDURE adjust(VAR oldline:pstring);
  TYPE str20=ARRAY [0..20] OF CHAR;
  VAR p,p2:CARDINAL; line,X,X2:oldlinetype;
      op:str20; size:ARRAY [0..4] OF CHAR;

  PROCEDURE found(s:ARRAY OF CHAR):BOOLEAN;
  VAR isfound:BOOLEAN;
  BEGIN FindNext(s,line,0,isfound,p);
  RETURN isfound
  END found;

  PROCEDURE finddel(s:ARRAY OF CHAR);
  VAR len,slen:CARDINAL;
  BEGIN
    IF found(s) THEN
      Extract(line,0,p,X);
      slen := Length(s); len := Length(line);
      Extract(line,p+slen,len-(p+slen)+1,X2);
      line := X; Append(X2,line)
    END
  END finddel;

  PROCEDURE replace(no,yes:ARRAY OF CHAR);
  VAR i:CARDINAL;
  BEGIN
    IF found(no) THEN
      FOR i := 0 TO Length(yes)-1 DO line[p+i] := yes[i] END
    END
  END replace;

  PROCEDURE fixname(myop:str20);
  VAR name:str20; s:ARRAY [0..1+1] OF CHAR; found:BOOLEAN; here:CARDINAL;
  BEGIN
    s := " "; name := myop;
    FindNext('[',name,0,found,here);
    IF found THEN
      Extract(name,0,here,X); Assign(X,name); Append('+',X);
      s[0] := myop[Length(op)-2]; Append(s,X); Assign(X,myop)
    END;
    IF isbytename(name) THEN size := "byte" ELSE size := "word" END;
    Extract(line,0,p,X); Append(size,X); Append(" ptr[",X);
    Append(myop,X); Append(']',X)
  END fixname;

  PROCEDURE fixop1():BOOLEAN;
  CONST tab=11C;
  VAR rc:BOOLEAN; len:CARDINAL;
  BEGIN rc := FALSE;
    IF found(',') THEN DEC(p); p2 := p END;
    WHILE ~((line[p]=' ') OR (line[p]=tab)) DO DEC(p) END; INC(p);
    Extract(line,p,p2-p+1,op);
    IF (Length(op) > 2) & ((op[0] >= 'A') & (op[0] <= 'Z')) & (op[0] # '[') THEN
      fixname(op); len := Length(line); Extract(line,p2+1,len-(p2+1)+1,X2);
      line := X; Append(X2,line);
      rc := TRUE
    END;
    RETURN rc
  END fixop1;

  PROCEDURE fixop2;
  BEGIN
    IF found(',') THEN INC(p); p2 := p END;
    WHILE (p2 < Length(line)) & (line[p2] # ' ') DO INC(p2) END;
    IF line[p2] = ' ' THEN DEC(p2) END;
    Extract(line,p,p2-p+1,X);
    IF Length(X) > 2 THEN
      Extract(line,p,p2-p+1,op);
      IF ((op[0] >= 'A') & (op[0] <= 'Z')) & (op[0] # '[') & ((Length(op) > 2) & (op[2] # ':')) THEN
        fixname(op); line := X
      END
    END
  END fixop2;

  PROCEDURE incdec;
  BEGIN
    IF found("INC ") OR found("DEC ") THEN
      WHILE line[p] # ' ' DO INC(p) END; WHILE line[p] = ' ' DO INC(p) END;
      p2 := p; WHILE (p2 < Length(line)) & (line[p2] # ' ') DO INC(p2) END;
      IF line[p2] = ' ' THEN DEC(p2) END;
      Extract(line,p,p2-p+1,X);
      IF Length(X) > 2 THEN
        Extract(line,p,p2-p+1,op);
        IF ((op[0] >= 'A') & (op[0] <= 'Z')) & (op[0] # '[') THEN
          fixname(op); line := X
        END
      END
    END
  END incdec;

  PROCEDURE fixplusbx;
  VAR oldp,len:CARDINAL;
  BEGIN
    oldp := p; IF found('[') THEN p2 := p END; p := oldp;
    Extract(line,p2+1,p-p2-1,op);
    IF isbytename(op) THEN size := "byte" ELSE size := "word" END;
    Extract(line,0,p2,X); Append(size,X); Append(" ptr",X);
    len := Length(line); Extract(line,p2,len-p2+1,X2);
    line := X; Append(X2,line)
  END fixplusbx;

  PROCEDURE fixlea;
  VAR len:CARDINAL;
  BEGIN
    replace("LEA ","MOV "); IF found(',') THEN p2 := p END;
    Extract(line,0,p2+1,X); Append("OFFSET ",X);
    len := Length(line); Extract(line,p2+1,len-(p2+1)+1,X2);
    line := X; Append(X2,line)
  END fixlea;

BEGIN (* adjust *)
  IF Length(oldline^) > 0 THEN
    Assign(oldline^,line);

    IF found("Assume") OR found("ENDP") THEN line := "" END;

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

    IF found("+BX") THEN
      fixplusbx
    ELSIF found("LEA ") THEN
      fixlea
    ELSIF found(" PROC ") THEN
      IF found(" ") THEN Extract(line,0,p,X); Append(':',X); line := X END
    ELSIF found("JMP ") THEN
      jmpshort(p,line)
    END;

    IF ~found(',') THEN
      incdec
    ELSIF ~((found(" DB ") OR found(" DW "))
      OR found(",OF") OR found(",Of") OR found("ASSUME")) THEN
        IF ~fixop1() THEN fixop2 END
    END;

    fixseg(line); replace("40:","DS:");

    Assign(line,oldline^)
  END
END adjust;

PROCEDURE WriteStr(s:ARRAY OF CHAR);
BEGIN WriteString(s); WriteLn
END WriteStr;

BEGIN (* main *)
  WriteStr("Enter 'INVADERS.ASM' for input:"); OpenInput(".ASM");
  IF ~Done THEN WriteStr("Oops!"); HALT END;
  load; WriteStr("loaded"); CloseInput;
  doall(adjust); WriteStr("adjusted");

  WriteStr("Enter 'inv.asm' for output:"); OpenOutput(".asm");
  doall(show); CloseOutput; WriteStr("written")
END invmod2.
/* === invmod2.mod ends === */

/* === invmod2.bat begins === */
@echo off
for %%a in (fst gpm xds m2c) do if "%1"=="%%a" goto %%a
echo.
echo %0 m2 (where "m2" is one of: fst gpm xds m2c)
echo.
goto bye
:fst
if "%M2LIB%"=="" goto bye
copy Str.fst *.mod >NUL
if not exist Str.mod goto bye
loadfix genmake invmod2
loadfix m2comp invmod2 /m
loadfix m2link invmod2 /o
del *.m2o *.dbg *.mak >NUL
goto upx
:gpm
if "%M2LIB%"=="" goto bye
if "%M2SYM%"=="" goto bye
copy Str.gpm *.mod >NUL
if not exist Str.mod goto bye
gpmake invmod2
del *.obj *.syx *.rfx >NUL
goto upx
:xds
REM (using Japheth's HX)
if "%HDPMI%"=="" goto bye
if "%DPMILDR%"=="" goto bye
copy Str.xds *.mod >NUL
if not exist Str.mod goto bye
xc.exe =m invmod2
xstrip -q -n invmod2.exe
del tmp.lnk *.obj *.sym >NUL
goto end
:m2c
if "%M2C%"=="" goto bye
copy Str.m2c *.mod >NUL
if not exist Str.mod goto bye
m2c.exe -strict -O -make invmod2.mod -o invmod2.exe
del *.o >NUL
:upx
upx-nrv -qq --best --lzma --8086 *.exe
:end
dir invmod2.exe | find /i "exe"
:bye
/* === invmod2.bat 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 */
