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

/* === m2nasm.mod begins === */
(* public domain, nenies proprajho, free for any use *)
MODULE m2nasm;

FROM InOut IMPORT WriteString,WriteLn;
FROM Myfiles IMPORT OpenRead,Create,Close,readline,writeline;
FROM lines IMPORT linetype;
FROM nasmhelp IMPORT oldasm,newasm,incasm,fixnasm;
FROM inc2tiny IMPORT maketiny;

PROCEDURE makenasm;
CONST invaders="INVADERS.ASM";
VAR line:linetype;
BEGIN
  IF ~OpenRead(oldasm,invaders) THEN
    WriteString("NOTFOUND: "); WriteString(invaders); WriteLn; HALT
  END;

  IF Create(newasm,"inv-nasm.asm") & Create(incasm,"inv-nasm.inc") THEN
    writeline(newasm,"%idefine offset"); writeline(newasm,"%define LEA MOV");
    writeline(newasm,"%define B byte");  writeline(newasm,"%define W word");
    writeline(newasm,'%include "inv-nasm.inc"');

    WHILE readline(oldasm,line) DO fixnasm(line) END;

    Close(incasm); Close(newasm)
  END;

  Close(oldasm)
END makenasm;

BEGIN
  WriteString("inv-nasm.asm    inv-nasm.inc"); WriteLn; makenasm;
  WriteString("inv-tiny.asm"); WriteLn; maketiny
END m2nasm.
/* === m2nasm.mod ends === */

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

CONST max=60; maxlen=19;
TYPE  str=ARRAY [0..maxlen] OF CHAR;

PROCEDURE getall():BOOLEAN;
PROCEDURE is(s:ARRAY OF CHAR):BOOLEAN;

END bytedef.
/* === bytedef.def ends === */

/* === bytedef.mod begins === */
(* public domain, nenies proprajho, free for any use *)
IMPLEMENTATION MODULE bytedef;

FROM InOut IMPORT WriteString,WriteLn;
FROM Str IMPORT Length,Assign,Delete,CompareStr;
FROM Myfiles IMPORT File,OpenRead,Close,readline;

VAR defbyte:ARRAY [1..max] OF str;

PROCEDURE getall():BOOLEAN;
VAR incfile:File; index:[1..max+1]; s:ARRAY [0..31] OF CHAR; len:CARDINAL;
BEGIN index := 1;
  IF ~OpenRead(incfile,"inv-nasm.inc") THEN
    WriteString("NOTFOUND: inv-nasm.inc"); WriteLn; RETURN FALSE
  END;

  WHILE readline(incfile,s) DO
    IF (s[Length(s)-1] = 'B') THEN
      Delete(s,0,10); len := Length(s); Delete(s,len-2,2);
      Assign(s,defbyte[index]); INC(index)
    END
  END;
  Close(incfile);

  RETURN TRUE
END getall;

PROCEDURE is(s:ARRAY OF CHAR):BOOLEAN;
VAR n:CARDINAL;
BEGIN
  FOR n := 1 TO max DO
    IF CompareStr(defbyte[n],s)=0 THEN RETURN TRUE END
  END;
  RETURN FALSE
END is;

END bytedef.
/* === bytedef.mod ends === */

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

CONST maxline=150;
TYPE linetype=ARRAY [0..maxline] OF CHAR;

PROCEDURE finddel(this:ARRAY OF CHAR; VAR that:ARRAY OF CHAR);
PROCEDURE sub(this,that:ARRAY OF CHAR; VAR str:ARRAY OF CHAR);

END lines.
/* === lines.def ends === */

/* === lines.mod begins === */
(* public domain, nenies proprajho, free for any use *)
IMPLEMENTATION MODULE lines;

FROM Str IMPORT FindNext,Length,Insert,Delete;

PROCEDURE finddel(this:ARRAY OF CHAR; VAR that:ARRAY OF CHAR);
VAR isfound:BOOLEAN; where,len:CARDINAL;
BEGIN FindNext(this,that,0,isfound,where);
  IF isfound THEN
    len := Length(this); Delete(that,where,len)
  END
END finddel;

PROCEDURE sub(this,that:ARRAY OF CHAR; VAR str:ARRAY OF CHAR);
VAR isfound:BOOLEAN; where,len:CARDINAL;
BEGIN FindNext(this,str,0,isfound,where);
  IF isfound THEN
    len := Length(this); Delete(str,where,len); Insert(that,where,str)
  END
END sub;

END lines.
/* === lines.mod ends === */

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

PROCEDURE isdigit(k:CHAR):BOOLEAN;
PROCEDURE isxdigit(k:CHAR):BOOLEAN;
PROCEDURE isupper(k:CHAR):BOOLEAN;
PROCEDURE islower(k:CHAR):BOOLEAN;
PROCEDURE isalpha(k:CHAR):BOOLEAN;
PROCEDURE isalnum(k:CHAR):BOOLEAN;

END ctype.
/* === ctype.def ends === */

/* === ctype.mod begins === */
(* public domain, nenies proprajho, free for any use *)
IMPLEMENTATION MODULE ctype;

PROCEDURE isdigit(k:CHAR):BOOLEAN;
BEGIN RETURN (k >= '0') & (k <= '9')
END isdigit;

PROCEDURE isxdigit(k:CHAR):BOOLEAN;
BEGIN
RETURN isdigit(k) OR ((k >= 'a') & (k <= 'f')) OR ((k >= 'A') & (k <= 'F'))
END isxdigit;

PROCEDURE isupper(k:CHAR):BOOLEAN;
BEGIN RETURN (k >= 'A') & (k <= 'Z')
END isupper;

PROCEDURE islower(k:CHAR):BOOLEAN;
BEGIN RETURN (k >= 'a') & (k <= 'z')
END islower;

PROCEDURE isalpha(k:CHAR):BOOLEAN;
BEGIN RETURN isupper(k) OR islower(k)
END isalpha;

PROCEDURE isalnum(k:CHAR):BOOLEAN;
BEGIN RETURN isalpha(k) OR isdigit(k)
END isalnum;

END ctype.
/* === ctype.mod ends === */

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

FROM Myfiles IMPORT File;

VAR oldasm,newasm,incasm:File;

PROCEDURE fixnasm(VAR line:ARRAY OF CHAR);

END nasmhelp.
/* === nasmhelp.def ends === */

/* === nasmhelp.mod begins === */
(* public domain, nenies proprajho, free for any use *)
IMPLEMENTATION MODULE nasmhelp;

FROM Str IMPORT FindNext,Extract,Length,Append,Insert,Delete;
FROM ctype IMPORT isdigit,isupper,isalnum;
FROM lines IMPORT finddel,sub;
FROM Myfiles IMPORT WriteChar,writeline,writestring,writeln;

MODULE segoverride;
IMPORT FindNext,Insert;
EXPORT fixseg;
VAR cseg:BOOLEAN;
PROCEDURE fixseg(VAR l:ARRAY OF CHAR);
VAR where:CARDINAL;
  PROCEDURE found(this:ARRAY OF CHAR):BOOLEAN;
  VAR isfound:BOOLEAN;
  BEGIN FindNext(this,l,0,isfound,where);
  RETURN isfound
  END found;
BEGIN
  IF found("RemoveNewInt9:") OR found("CLC") THEN cseg := ~cseg END;
  IF cseg & found("MOV ") & ~found("[0") & found("[") THEN
    Insert("cs:",where+1,l)
  END
END fixseg;
BEGIN cseg := FALSE
END segoverride;

PROCEDURE fixnasm(VAR line:ARRAY OF CHAR);
  VAR tmp:ARRAY [0..20] OF CHAR; p,p2:CARDINAL;

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

  PROCEDURE Ins(this:ARRAY OF CHAR; ofs:INTEGER);
  BEGIN Insert(this,ofs,line)
  END Ins;

  PROCEDURE writeinc():BOOLEAN;
  VAR rc:BOOLEAN;
  BEGIN
    IF isupper(line[0]) & (found(" DB") OR found(" DW")) THEN
      IF found(' ') THEN p2 := p END; WHILE line[p2]=' ' DO INC(p2) END;
      Extract(line,0,p,tmp);
      writestring(incasm,"%define s_"); writestring(incasm,tmp);
      WriteChar(incasm,' '); WriteChar(incasm,line[p2+1]);
      writeln(incasm);
      rc := TRUE
    ELSE
      rc := FALSE
    END;
  RETURN rc
  END writeinc;

  PROCEDURE fixproc;
  VAR len:CARDINAL;
  BEGIN
    IF found("PROC") & found(' ') THEN
      Ins(':',p); INC(p); len := Length(line); Delete(line,p,len-p)
    END
  END fixproc;

  PROCEDURE incdec;
  VAR len:CARDINAL;
  BEGIN
    IF found("INC ") OR found("DEC ") THEN
      INC(p,4);
      WHILE line[p]=' ' DO INC(p) END;
      IF line[p] # '[' THEN
        p2 := p; len := Length(line);
        WHILE (p2 < len-1) & (line[p2] # ' ') &
          (isalnum(line[p2]) OR (line[p2]='_')) DO
            INC(p2)
        END;
        IF line[p2]=' ' THEN DEC(p2) END;
        IF ((p2-p+1) > 2) THEN
          Extract(line,p,p2-p+1,tmp);
          Append(']',line); Ins('[',p); Ins(tmp,p); Ins("s_",p)
        END
      END
    END
  END incdec;

  PROCEDURE fixop1;
  BEGIN
    IF found(',') & (line[p-1] # ']') THEN
      DEC(p); p2 := p;
      REPEAT DEC(p) UNTIL (line[p]=' ') OR
        ~(isalnum(line[p]) OR (line[p]='_'));
      INC(p);
      IF ((p2-p+1) > 2) & (line[p] # '[') & isupper(line[p]) THEN
        Extract(line,p,p2-p+1,tmp);
        p2 := p;
        IF found(',') THEN
          Ins(']',p); Ins('[',p2); Ins(tmp,p2); Ins("s_",p2)
        END
      END
    END
  END fixop1;

  PROCEDURE fixop2;
  VAR len:CARDINAL; semicolon:BOOLEAN;
  BEGIN FindNext(';',line,0,semicolon,p2);
    IF found(',') & ((~semicolon) OR (p2 > p)) & (line[p] # '[') THEN
      INC(p); p2 := p; len := Length(line);
      WHILE (p2 < len-1) & (line[p2] # ' ') &
        (isalnum(line[p2]) OR (line[p2]='_')) DO
          INC(p2)
      END;
      IF (line[p2]=' ') OR (p2 > len-1) THEN DEC(p2) END;
      IF (p2 > p) & ((p2-p+1) > 2) & isupper(line[p]) THEN
        Extract(line,p,p2-p+1,tmp);
        IF p2=len-1 THEN Append(']',line) ELSE Ins(']',p2+1) END;
        Ins('[',p); Ins(tmp,p); Ins("s_",p)
      END
    END
  END fixop2;

  PROCEDURE fixplusbx;
  VAR isfound:BOOLEAN;
  BEGIN
    IF found("+BX") THEN
      FindNext('[',line,0,isfound,p); INC(p);
      FindNext('+',line,0,isfound,p2); DEC(p2);
      Extract(line,p,p2-p+1,tmp);
      DEC(p);
      Ins(tmp,p); Ins("s_",p)
    END
  END fixplusbx;

  PROCEDURE unbrakdig;
  BEGIN
    IF found(']') & (line[p-2]='[') & isdigit(line[p-1]) THEN
      line[p-2] := '_'; Delete(line,p,1)
    END
  END unbrakdig;

  PROCEDURE fixbrakdig;
    PROCEDURE brakdig():BOOLEAN;
    BEGIN
      RETURN (line[p-2]='_') & isdigit(line[p-1])
    END brakdig;
  BEGIN
    IF found('[') & brakdig() THEN Delete(line,p-2,2) END;
    IF found(']') & brakdig() THEN line[p-2] := '+' END
  END fixbrakdig;

BEGIN (* fixnasm *)
  IF Length(line)=0 THEN writeln(newasm); RETURN
  ELSIF (line[0]=';') OR found("LEA ") THEN
    writeline(newasm,line); RETURN
  ELSIF found("CODE_SEG") OR found("END") THEN RETURN
  END;

  IF found("OldInt9Address") THEN sub(" DD "," DW 0,",line) END;

  IF writeinc() THEN writeline(newasm,line); RETURN END;

  finddel("[0]",line);

  IF ~found(",O") THEN (* "O[fF][^ ]*" *)
    sub("ES:[","[ES:",line); finddel("40:",line); finddel("Word Ptr ",line);

    fixproc; unbrakdig;
    fixop1; fixop2; incdec; fixplusbx;
    fixbrakdig; fixseg(line)
  END;

  writeline(newasm,line)
END fixnasm;

END nasmhelp.
/* === nasmhelp.mod ends === */

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

PROCEDURE maketiny;

END inc2tiny.
/* === inc2tiny.def ends === */

/* === inc2tiny.mod begins === */
(* public domain, nenies proprajho, free for any use *)
IMPLEMENTATION MODULE inc2tiny;

FROM InOut IMPORT WriteString,WriteLn;
FROM Str IMPORT FindNext,Length,Assign,Extract,Append,Insert,Delete;
FROM Myfiles IMPORT File,OpenRead,Create,Close,readline,writeline;
FROM ctype IMPORT isdigit,isxdigit,isalpha;
FROM lines IMPORT linetype;
IMPORT bytedef;

PROCEDURE maketiny;
VAR line:linetype;

  PROCEDURE adjust;
  VAR p,p2:CARDINAL; isfound:BOOLEAN;

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

    PROCEDURE Ins(this:ARRAY OF CHAR; ofs:INTEGER);
    BEGIN Insert(this,ofs,line)
    END Ins;

    PROCEDURE Del(ofs,num:INTEGER);
    BEGIN Delete(line,ofs,num)
    END Del;

    PROCEDURE fixhexnums;
    VAR hexbegin,hexend:CARDINAL;

      PROCEDURE foundhexnum():BOOLEAN;
      VAR p,len:CARDINAL;
      BEGIN len := Length(line);
        FOR p := 0 TO len-1 DO
          IF isdigit(line[p]) & (p < len-1) THEN
            hexbegin := p; p2 := p+1;
            WHILE isxdigit(line[p2]) & (p2 < len-1) DO INC(p2) END;
            IF CAP(line[p2])='H' THEN
              hexend := p2-1;
              RETURN TRUE
            END
          END
        END;
        RETURN FALSE
      END foundhexnum;

    BEGIN
      WHILE foundhexnum() DO
        Del(hexend+1,1); Ins("0x",hexbegin)
      END
    END fixhexnums;

  VAR tmp:bytedef.str;

  BEGIN (* adjust *)
    IF isalpha(line[0]) & (found(" DB ") OR found(" DW ")) THEN
      IF found(' ') THEN Ins(": ",p) END
    ELSIF found("+BX") THEN
      Del(p,3); FindNext('[',line,0,isfound,p2); Ins("BX+",p2+1)
    ELSIF found('[') & (line[p+3]=':') & (CAP(line[p+2])='S') THEN
      Assign("?s",tmp); Extract(line,p+1,2,tmp); Append(" ",tmp);
      Del(p+1,3); Ins(tmp,0)
    ELSIF found("LEA ") THEN
      Del(p,3); Ins("MOV",p)
    ELSIF found(",O") & (CAP(line[p+2])='F') THEN
      Del(p+1,7)
    END;

    IF found("s_") THEN
      FindNext('[',line,0,isfound,p2);
      Extract(line,p+2,p2-p-2,tmp); Del(p,p2-p);
      IF bytedef.is(tmp) THEN Ins("byte",p) ELSE Ins("word",p) END
    END;

    IF ((found(",AL") OR found(" AL,")) & found("byte[")) OR
       ((found(",AX") OR found(" AX,")) & found("word["))
    THEN
      Del(p,4)
    END;

    fixhexnums
  END adjust;

VAR nasmasm,tinyasm:File;

BEGIN (* maketiny *)
  IF bytedef.getall() THEN
    IF ~OpenRead(nasmasm,"inv-nasm.asm") THEN
      WriteString("NOTFOUND: inv-nasm.asm"); WriteLn; HALT
    END;

    IF Create(tinyasm,"inv-tiny.asm") THEN
      WHILE readline(nasmasm,line) DO
        IF (Length(line) > 0) & (line[0] # ';') & (line[0] # '%') THEN
          adjust;
          writeline(tinyasm,line)
        END
      END;
      Close(tinyasm)
    END;
    Close(nasmasm)
  END
END maketiny;

END inc2tiny.
/* === inc2tiny.mod ends === */

/* === m2nasm.bat begins === */
@echo off
if not exist INVADERS.ASM goto end
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 end
:fst
if "%M2LIB%"=="" goto end
copy *.fst *.mod >NUL
for %%a in (Str Myfiles) do if not exist %%a.mod goto end
loadfix genmake m2nasm
loadfix m2comp m2nasm /m
loadfix m2link m2nasm /o
del *.m2o *.dbg *.mak >NUL
if not exist m2nasm.exe goto end
goto run
:gpm
if "%M2SYM%"=="" goto end
copy *.gpm *.mod >NUL
for %%a in (Str Myfiles) do if not exist %%a.mod goto end
gpmake m2nasm
del *.obj *.syx *.rfx >NUL
if not exist m2nasm.exe goto end
goto run
:xds
REM (uses Japheth's HX)
if "%HDPMI%"=="" goto end
if "%DPMILDR%"=="" goto end
copy *.xds *.mod >NUL
for %%a in (Str Myfiles) do if not exist %%a.mod goto end
xc.exe =m m2nasm
del tmp.lnk *.obj *.sym >NUL
if not exist m2nasm.exe goto end
xstrip -q -n m2nasm.exe
goto run
:m2c
if "%DJGPP%"=="" goto end
if "%M2C%"=="" goto end
copy *.m2c *.mod >NUL
for %%a in (Str Myfiles) do if not exist %%a.mod goto end
m2c -strict -O -make m2nasm.mod -o m2nasm.exe
del *.o >NUL
if not exist m2nasm.exe goto end
:run
cls
echo on
:pack
@if "%1"=="xds" goto execute
::diet -X m2nasm.exe
upx-nrv -qq --best --lzma --8086 m2nasm.exe
:execute
m2nasm.exe
nasm16 -O3 inv-nasm.asm -o inv-nasm.com
nasm16 -O3 inv-tiny.asm -o inv-nas2.com
tinyasm inv-tiny.asm -o inv-tiny.com
fasm inv-tiny.asm inv-fasm.com >NUL
@echo off
echo.
echo CRC32 =       0xFFF22EF9
echo.
crc32 inv-*.com
:end
/* === m2nasm.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 */
