/* REXX */

/*
-----------------------------------------------------------------
  unpacker (v0.1g) = 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 unmatched '*'+'/' in embedded data files.
-----------------------------------------------------------------
*/

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

allexclude=''

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

if host='UNIX' then exclude=allexclude 'oberonm.bat hackomf.asm'
else exclude=allexclude ''

bar = '===' ; prefix='/*' bar ; postfix = reverse(prefix)
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 ; len=length(line)
  if pos(headpost,line) \= 0 then do
    parse var line (prefix) ' ' outfile (headpost) .
    if only='' then
      if wordpos(outfile,exclude)=0 then say outfile
      else say '...skipping...' outfile
    writeln=1
  end
  else if pos(footpost,line) \= 0 then writeln=0
  if pos(headpost,line)=0 & pos(footpost,line)=0 & writeln then do
    if (only='' & wordpos(outfile,exclude)=0) | only=outfile then ,
      call lineout outfile,line
  end
  else if pos(footpost,line) \= 0 & only=outfile then exit
return

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

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

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

/* === obenasm.mod begins === */
(*$MAIN+ *)
(* public domain, nenies proprajho, free for any use *)

MODULE obenasm; (* Oxford or XDS or Oberon-M *)
IMPORT F := Myfiles,S := Str,inc2tiny;

PROCEDURE Adjust;
  VAR line:ARRAY 150 OF CHAR; cseg:BOOLEAN; str:ARRAY 2 OF CHAR;
      oldasm,newasm,incasm:F.File;

PROCEDURE writeline(s:ARRAY OF CHAR);
BEGIN F.WriteString(newasm,s); F.WriteLn(newasm)
END writeline;

PROCEDURE adjustit;
VAR p,p2:INTEGER; tmp:ARRAY 21 OF CHAR;

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

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 isalnum(k:CHAR):BOOLEAN;
BEGIN RETURN isupper(k) OR islower(k) OR isdigit(k)
END isalnum;

PROCEDURE ins(s:ARRAY OF CHAR; ofs:INTEGER);
BEGIN S.Insert(s,ofs,line)
END ins;

PROCEDURE del(ofs,num:INTEGER);
BEGIN S.Delete(line,ofs,num)
END del;

PROCEDURE find(s:ARRAY OF CHAR):INTEGER;
BEGIN RETURN S.Pos(s,line,0)
END find;

PROCEDURE found(s:ARRAY OF CHAR):BOOLEAN;
BEGIN p := find(s);
RETURN p # -1
END found;

PROCEDURE finddel(s:ARRAY OF CHAR);
BEGIN IF found(s) THEN del(p,S.Length(s)) END
END finddel;

PROCEDURE sub(older,newer:ARRAY OF CHAR);
BEGIN IF found(older) THEN del(p,S.Length(older)); ins(newer,p) END
END sub;

PROCEDURE writeinc():BOOLEAN;
BEGIN
  IF isupper(line[0]) & (found(" DB") OR found(" DW")) THEN
    str := " "; p := find(str); p2 := p; WHILE line[p2]=" " DO INC(p2) END;
    S.Extract(line,0,p,tmp);
    F.WriteString(incasm,"%define s_"); F.WriteString(incasm,tmp);
    F.WriteChar(incasm," "); F.WriteChar(incasm,line[p2+1]);
    F.WriteLn(incasm);
    RETURN TRUE
  ELSE
    RETURN FALSE
  END
END writeinc;

PROCEDURE fixproc;
BEGIN
  IF found("PROC") THEN
    str := " "; p := find(str);
    str := ":"; ins(str,p); del(p+1,S.Length(line)-p-1)
  END
END fixproc;

PROCEDURE incdec;
VAR len:INTEGER;
BEGIN
  IF found("INC ") OR found("DEC ") THEN
    len := S.Length(line); INC(p,4);
    WHILE line[p]=" " DO INC(p) END;
    IF line[p] # "[" THEN
      p2 := p;
      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
        S.Extract(line,p,p2-p+1,tmp); str := "]"; S.Append(str,line);
        str := "["; ins(str,p); ins(tmp,p); ins("s_",p)
      END
    END
  END
END incdec;

PROCEDURE fixop1;
VAR str2:ARRAY 2 OF CHAR;
BEGIN str := ","; p2 := find(str);
  IF (p2 # -1) & (line[p2-1] # "]") THEN
    DEC(p2); p := p2;
    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
      S.Extract(line,p,p2-p+1,tmp);
      str := "]"; str2 := ","; ins(str,find(str2));
      str := "["; ins(str,p); ins(tmp,p); ins("s_",p)
    END
  END
END fixop1;

PROCEDURE fixop2;
VAR len:INTEGER;
BEGIN str := ";"; p2 := find(str);
  str := ",";
  IF found(str) & ((p2 = -1) OR (p2 > p)) & (line[p] # "[") THEN
    INC(p); p2 := p; len := S.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) & ((p2-p+1) > 2) & isupper(line[p]) THEN
      S.Extract(line,p,p2-p+1,tmp);
      str := "]"; ins(str,p2+1); str := "["; ins(str,p);
      ins(tmp,p); ins("s_",p)
    END
  END
END fixop2;

PROCEDURE fixplusbx;
BEGIN
  IF found("+BX") THEN
    str := "["; p := find(str)+1; str := "+"; p2 := find(str)-1;
    S.Extract(line,p,p2-p+1,tmp);
    DEC(p); ins(tmp,p); ins("s_",p)
  END
END fixplusbx;

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

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

PROCEDURE fixseg;
BEGIN
  IF ~cseg & (find("RemoveNewInt9:")=0) THEN cseg := TRUE END;

  str := "["; IF cseg & found(str) & (line[p+1] # "0") THEN ins("cs:",p+1) END;

  IF cseg & found("CLC") THEN cseg := FALSE END
END fixseg;

BEGIN (* adjustit *)
  IF S.Length(line)=0 THEN writeline(line); RETURN
  ELSIF (line[0]=";") OR found("LEA ") THEN writeline(line); RETURN
  ELSIF found("CODE_SEG") OR found("END") THEN RETURN
  END;

  IF (line[0]="O") & (find("OldInt9Address")=0) THEN sub(" DD "," DW 0,") END;

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

  finddel("[0]");

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

    fixproc; unbrakdig;
    fixop1; fixop2; incdec; fixplusbx;
    fixbrakdig; fixseg
  END;

  writeline(line)
END adjustit;

BEGIN (* Adjust *) cseg := FALSE;

  oldasm := F.Open("INVADERS.ASM","r"); IF oldasm = NIL THEN HALT(255) END;
  newasm := F.Open("inv-nasm.asm","w"); incasm := F.Open("inv-nasm.inc","w");

  writeline("%idefine offset"); writeline("%define LEA MOV");
  writeline("%define B byte"); writeline("%define W word");
  writeline("%include 'inv-nasm.inc'");

  WHILE ~F.Eof(oldasm) DO IF F.readline(oldasm,line) > 0 THEN adjustit END END;

  F.Close(oldasm); F.Close(newasm); F.Close(incasm)
END Adjust;

BEGIN (* main *) Adjust; inc2tiny.make
END obenasm.
/* === obenasm.mod ends === */

/* === inc2tiny.mod begins === */
(* public domain, nenies proprajho, free for any use *)
MODULE inc2tiny;
IMPORT F := Myfiles,S := Str;

CONST maxbytenames=60;
TYPE  bytestr = POINTER TO ARRAY 19+1 OF CHAR;
VAR   bytenames:ARRAY maxbytenames OF bytestr;

PROCEDURE getbytenames;
VAR line:ARRAY 31+1 OF CHAR; num,len:INTEGER; nasminc:F.File;
BEGIN num := 0; nasminc := F.Open("inv-nasm.inc","r");
  IF nasminc = NIL THEN HALT(255) END;
  WHILE ~F.Eof(nasminc) DO
    IF F.readline(nasminc,line) > 0 THEN
      len := S.Length(line);
      IF (len > 0) & (line[len-1]="B") THEN
        NEW(bytenames[num]);
        S.Extract(line,10,len-12,bytenames[num]^);
        INC(num)
      END
    END
  END;
  F.Close(nasminc)
END getbytenames;

PROCEDURE isbytename(s:ARRAY OF CHAR):BOOLEAN;
VAR n:INTEGER; done:BOOLEAN;
BEGIN done := FALSE; n := 0;
  WHILE (n < maxbytenames) & ~done DO
    IF bytenames[n]^ = s THEN done := TRUE END;
    INC(n)
  END;
  RETURN done
END isbytename;

PROCEDURE writenew;
VAR line:ARRAY 150+1 OF CHAR; p,p2:INTEGER; attr:SET; str:ARRAY 2 OF CHAR;
    myseg:ARRAY 4 OF CHAR; tmp:ARRAY 19+1+2 OF CHAR; oldasm,newasm:F.File;
CONST hasdigit=0; hasbrak=1; hascolon=2; hascomma=3;

  PROCEDURE find(s:ARRAY OF CHAR):INTEGER;
  BEGIN RETURN S.Pos(s,line,0)
  END find;

  PROCEDURE found(s:ARRAY OF CHAR):BOOLEAN;
  BEGIN p := find(s); RETURN p # -1
  END found;

  PROCEDURE ins(s:ARRAY OF CHAR;n:INTEGER);
  BEGIN S.Insert(s,n,line)
  END ins;

  PROCEDURE del(ofs,num:INTEGER);
  BEGIN IF ofs > -1 THEN S.Delete(line,ofs,num) END
  END del;

  PROCEDURE sub(older,newer:ARRAY OF CHAR);
  BEGIN IF found(older) THEN del(p,S.Length(older)); ins(newer,p) END
  END sub;

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

  PROCEDURE fixhexnums;
  VAR hexbegin,hexend:INTEGER;

    PROCEDURE foundhexnum():BOOLEAN;
    VAR y,z,len:INTEGER;

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

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

    BEGIN (* foundhexnum *) len := S.Length(line);
      y := 0;
      WHILE y < len DO
        IF isdigit(line[y]) & (y < len-1) THEN
          hexbegin := y; z := y+1;
          WHILE isxdigit(line[z]) & (z < len-1) DO INC(z) END;
          IF line[z]="h" THEN
            hexend := z-1;
            RETURN TRUE
          END
        END;
        INC(y)
      END;
      RETURN FALSE
    END foundhexnum;

  BEGIN hexbegin := -1; hexend := -1;
    WHILE foundhexnum() DO del(hexend+1,1); ins("0x",hexbegin) END;
  END fixhexnums;

  PROCEDURE getattr():SET;
  VAR i:INTEGER; s:SET;
  BEGIN i := 0; s := {};
    WHILE (i < S.Length(line)) & (line[i] # ";") DO
      CASE line[i] OF
          "0".."9": INCL(s,hasdigit)
        | "[": INCL(s,hasbrak)
        | ":": INCL(s,hascolon)
        | ",": INCL(s,hascomma)
      ELSE
      END;
      INC(i)
    END;
    RETURN s
  END getattr;

  PROCEDURE isseg(k:CHAR):BOOLEAN;
  BEGIN
    CASE k OF
      "c","C","d","D","e","E","s","S": RETURN TRUE
    ELSE RETURN FALSE
    END
  END isseg;

BEGIN (* writenew *) myseg := "?S "; oldasm := F.Open("inv-nasm.asm","r");
  IF oldasm = NIL THEN HALT(255) END; newasm := F.Open("inv-tiny.asm","w");

  WHILE ~F.Eof(oldasm) DO
    IF F.readline(oldasm,line) # 0 THEN ; END;

    IF (S.Length(line) > 0) & (line[0] # "%") THEN
      p := -1;

      IF line[0] # ";" THEN
        attr := getattr();

        IF hasdigit IN attr THEN fixhexnums END;

        IF (hasbrak IN attr) & found("+BX") THEN
          del(p,3);
          REPEAT DEC(p) UNTIL line[p]="[";
          ins("BX+",p+1)
        END;

        IF {hascolon,hasbrak} * attr = {hascolon,hasbrak} THEN
          str := ":";
          IF found(str) & (CAP(line[p-1])="S") & (line[p-3]="[")
             & isseg(line[p-2])
          THEN
            myseg[0] := CAP(line[p-2]); del(p-2,3); ins(myseg,0)
          END
        END;
  
        IF hascomma IN attr THEN
          sub("LEA ","MOV ");
          IF found(",O") & (CAP(line[p+2])="F") THEN del(p+1,7) END
        END;

        IF (hasbrak IN attr) & found("s_") THEN
          str := "["; p2 := find(str); S.Extract(line,p+2,p2-p-2,tmp);
          IF isbytename(tmp) THEN
            S.Insert("s_",0,tmp); sub(tmp,"byte")
          ELSE
            S.Insert("s_",0,tmp); sub(tmp,"word")
          END
        END;

        IF isupper(line[0]) & (found(" DB ") OR found(" DW ")) THEN
          str := " "; IF found(str) THEN str := ":"; ins(str,p) END
        END;

        IF {hascomma,hasbrak} * attr = {hascomma,hasbrak} THEN
          IF found(",AL") OR found(" AL,") THEN sub("byte["," [")
          ELSIF found(",AX") OR found(" AX,") THEN sub("word["," [")
          END
        END
      END;

      F.WriteString(newasm,line); F.WriteLn(newasm)
    END
  END;

  F.Close(newasm); F.Close(oldasm)
END writenew;

PROCEDURE make*;
BEGIN getbytenames; writenew
END make;

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

/* === oberonm.bat begins === */
@echo off
if not exist %0 %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
if "%NASM%"=="" set NASM=nasm16
if "%SED%"=="" set SED=sed
if "%1"=="link" goto link
set O1=obenasm
if "%1"=="run" goto run
if not exist INVADERS.ASM goto end
for %%a in (io myfiles str inc2tiny %O1%) do if not exist %%a.mod goto end
for %%a in (hackomf) do if not exist %%a.com %NASM% -o %%a.com %%a.asm
:sedbegin
if not exist io.old if exist io.mod ren io.mod *.old
%SED% -n -e "/^PROC.* Put/,/END RS/d;/^PROC.* Ch/,/END Ch/d;w io.mod" io.old
if not exist io.mod if exist io.old ren io.old *.mod
:sedend
for %%a in (io myfiles str inc2tiny %O1%) do if exist %%a.mod oc %%a def 8086
call %0 link val %O1% inc2tiny str myfiles io sys
if not exist %O1%.exe goto end
upx-nrv -qq --ultra-brute --lzma --8086 %O1%.exe
:run
echo on
%O1%.exe
%NASM% -O3 -o inv-nasm.com inv-nasm.asm
%NASM% -O3 -o inv-nas2.com inv-tiny.asm
tinyasm -o inv-tiny.com inv-tiny.asm
fasm inv-tiny.asm inv-fasm.com >NUL
crc32 inv-*.com
@echo off
goto end
:link
shift
if "%2"=="" goto bye
for %%a in (sys %2) do if not exist %%a.obj goto bye
echo ... linking %2 ...
hackomf %2.obj
if "%1"=="val" val %2+%3+%4+%5+%6+%7; >NUL
if "%1"=="tlink" tlink /x %2+%3+%4+%5+%6+%7;
if "%1"=="jwlink" jwlink op q format dos file %2,%3,%4,%5,%6,%7
if "%1"=="djlink" djlink %2.obj %3.obj %4.obj %5.obj %6.obj %7.obj
if "%1"=="alink" alink -oEXE %2 %3 %4 %5 %6 %7
goto bye
:end
set O1=
if "%NASM%"=="nasm16" set NASM=
if "%SED%"=="sed" set SED=
:bye
/* === oberonm.bat ends === */

/* === hackomf.asm begins === */
MODEND equ $8A
REGINT equ $70
COMENT equ $88
CMTTYPE equ 0
CMTCLASS equ $0DA
CHKSUM equ 0

org $100
Komenco:
 mov si,$80
 xor bh,bh
 mov bl,[si]
 mov byte[bx+si+1],0

 mov ax,$3D02
 mov dx,$82
 int $21
 jc Fino
 mov [handle],ax
Seek:
 call Seekit
 jc Fino
Read:
 mov ah,$3F
 mov bx,[handle]
 mov cx,21
 mov dx,buf
 int $21
 jc Fino
Seek2:
 call Seekit
 jc Fino
Modify:
 cmp byte[buf+16],MODEND
 jnz Fino

 cmp byte[buf],REGINT
 jnz Fino
 mov byte[buf],COMENT

 mov al,CMTTYPE
 mov di,buf+3
 stosb
 mov al,CMTCLASS
 stosb
 mov al,' '
 mov cx,10
 rep stosb

 mov al,CHKSUM
 stosb
Write:
 mov ah,$40
 mov bx,[handle]
 mov cx,21
 mov dx,buf
 int $21
 jc Fino
Close:
 mov ah,$3E
 mov bx,[handle]
 int $21
 jc Fino
 mov byte[myerror],0
Fino:
 mov ah,$4C
 mov al,[myerror]
 int $21

Seekit:
 mov ax,$4202
 mov bx,[handle]
 mov cx,-1
 mov dx,-21
 int $21
 ret

myerror db 1
handle dw 0
buf:
/* === hackomf.asm ends === */


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

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

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

/* EOF */
