/* 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 files.mod 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.m begins === */
(* public domain, nenies proprajho, free for any use *)

MODULE obenasm; (* Oxford or Oberon-M *)
IMPORT Files;

PROCEDURE Adjust;
  CONST maxline=150;
  TYPE  linetype=ARRAY maxline OF CHAR;
  VAR   line:linetype; cseg:BOOLEAN; oldasm,newasm,incasm:Files.File;

PROCEDURE Length(s:ARRAY OF CHAR):INTEGER;
VAR i:INTEGER;
BEGIN i := 0; WHILE s[i] # 0X DO INC(i) END;
RETURN i
END Length;

PROCEDURE readline;
CONST CR=0DX; LF=0AX;
VAR n:INTEGER;
BEGIN n := -1;
  REPEAT
    INC(n);
    Files.ReadChar(oldasm,line[n])
  UNTIL (line[n]=CR) OR (line[n]=LF);
  IF line[n]=CR THEN Files.ReadChar(oldasm,line[n]) END;
  line[n] := 0X
END readline;

PROCEDURE writeline(s:ARRAY OF CHAR);
BEGIN Files.WriteString(newasm,s); Files.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);
VAR i,slen:INTEGER;
BEGIN slen := Length(s);
  i := Length(line); WHILE i >= ofs DO line[i+slen] := line[i]; DEC(i) END;
  i := 0; WHILE i < slen DO line[ofs+i] := s[i]; INC(i) END
END ins;

PROCEDURE ins1(k:CHAR; ofs:INTEGER);
VAR s: ARRAY 2 OF CHAR;
BEGIN s := "?"; s[0] := k; ins(s,ofs)
END ins1;

PROCEDURE del(ofs,num:INTEGER);
VAR i,len:INTEGER;
BEGIN len := Length(line);
  i := ofs+num; WHILE i <= len+1 DO line[i-num] := line[i]; INC(i) END
END del;

PROCEDURE findchar(k:CHAR):INTEGER;
VAR n,rc,len:INTEGER; done:BOOLEAN;
BEGIN rc := -1; len := Length(line);
  IF len > 0 THEN
    n := 0; done := FALSE;
    WHILE (n < len) & ~done DO
      IF k = line[n] THEN
        rc := n;
        done := TRUE
      END;
      INC(n)
    END
  END;
RETURN rc
END findchar;

PROCEDURE foundchar(k:CHAR):BOOLEAN;
BEGIN p := findchar(k);
RETURN p # -1
END foundchar;

PROCEDURE find(s:ARRAY OF CHAR):INTEGER;
VAR i,slen,len,rc:INTEGER; bak:linetype;
BEGIN rc := -1; slen := LEN(s)-1; len := Length(line);
  IF len >= slen THEN
    bak := line;
    REPEAT
      IF foundchar(s[0]) THEN
        IF len+1 < p+slen-1 THEN p := -1
        ELSE
          i := 0; WHILE i < slen DO tmp[i] := line[i+p]; INC(i) END;
          tmp[slen] := 0X;
          IF tmp = s THEN rc := p; p := -1;
          ELSE line[p] := "$"
          END
        END
      END
    UNTIL p = -1;
    line := bak
  END;
RETURN rc
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,LEN(s)-1) END
END finddel;

PROCEDURE sub(older,newer:ARRAY OF CHAR);
BEGIN IF found(older) THEN del(p,LEN(older)-1); ins(newer,p) END
END sub;

PROCEDURE writeinc():BOOLEAN;
VAR i:INTEGER; rc:BOOLEAN;
BEGIN
  IF isupper(line[0]) & (found(" DB") OR found(" DW")) THEN
    p := findchar(" "); p2 := p; WHILE line[p2]=" " DO INC(p2) END;
    i := 0; WHILE i <= p-1 DO tmp[i] := line[i]; INC(i) END; tmp[p] := 0X;
    Files.WriteString(incasm,"%define s_"); Files.WriteString(incasm,tmp);
    Files.WriteChar(incasm," "); Files.WriteChar(incasm,line[p2+1]);
    Files.WriteLn(incasm);
    rc := TRUE
  ELSE
    rc := FALSE
  END;
RETURN rc
END writeinc;

PROCEDURE fixproc;
BEGIN
  IF found("PROC") THEN
    p := findchar(" "); line[p] := ":"; line[p+1] := 0X
  END
END fixproc;

PROCEDURE incdec;
VAR i,len:INTEGER;
BEGIN
  IF found("INC ") OR found("DEC ") THEN
    len := 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
        i := p; WHILE i <= p2 DO tmp[i-p] := line[i]; INC(i) END;
        tmp[p2-p+1] := 0X;
        line[len] := "]"; line[len+1] := 0X;
        ins1("[",p); ins(tmp,p); ins("s_",p)
      END
    END
  END
END incdec;

PROCEDURE fixop1;
VAR i:INTEGER;
BEGIN p2 := findchar(",");
  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
      i := p; WHILE i <= p2 DO tmp[i-p] := line[i]; INC(i) END;
      tmp[p2-p+1] := 0X;
      ins1("]",findchar(",")); ins1("[",p); ins(tmp,p); ins("s_",p)
    END
  END
END fixop1;

PROCEDURE fixop2;
VAR i,len:INTEGER;
BEGIN p2 := findchar(";");
  IF foundchar(",") & ((p2 = -1) 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]=" " THEN DEC(p2) END;
    IF (p2 > p) & ((p2-p+1) > 2) & isupper(line[p]) THEN
      i := p; WHILE i <= p2 DO tmp[i-p] := line[i]; INC(i) END;
      tmp[p2-p+1] := 0X;
      ins1("]",p2+1); ins1("[",p); ins(tmp,p); ins("s_",p)
    END
  END
END fixop2;

PROCEDURE fixplusbx;
VAR i:INTEGER;
BEGIN
  IF found("+BX") THEN
    p := findchar("[")+1; p2 := findchar("+")-1;
    i := p; WHILE i <= p2 DO tmp[i-p] := line[i]; INC(i) END;
    tmp[p2-p+1] := 0X;
    DEC(p);
    ins(tmp,p);
    ins("s_",p)
  END
END fixplusbx;

PROCEDURE unbrakdig;
BEGIN
  IF foundchar("]") & (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
  IF foundchar("[") & brakdig() THEN del(p-2,2) END;
  IF foundchar("]") & brakdig() THEN line[p-2] := "+" END
END fixbrakdig;

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

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

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

BEGIN (* adjustit *)
  IF 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 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 := Files.Open("INVADERS.ASM","r");
  IF oldasm = NIL THEN HALT(255) END;

  newasm := Files.Open("inv-nasm.asm","w");
  incasm := Files.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 ~Files.Eof(oldasm) DO readline; adjustit END;

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

BEGIN
  Adjust
END obenasm.
/* === obenasm.m ends === */

/* === oxford.bat begins === */
@unzip -qjn C:\ZIPS\ASM\invadr11.zip *.ASM
@set O1=obenasm
@for %%a in (exe k) do if exist %O1%.%%a del %O1%.%%a
@if not exist %O1%.m ren %O1%.mod *.m >NUL
obc %1 %2 %3 %O1%.m -o %O1%.exe
@if errorlevel 1 goto end
%O1%.exe
@if errorlevel 1 goto end
nasm inv-nasm.asm -o inv-nasm.com
@echo inv-nasm.com    FFF22EF9
@crc32 inv*.com
:end
@set O1=
/* === oxford.bat ends === */

/* === oberonm.bat begins === */
@unzip -qjn C:\ZIPS\ASM\invadr11.zip *.ASM
@unzip -qn C:\ZIPS\OBERON\obernm12 oc.exe io.mod sys.obj
@set O1=obenasm
@if exist %O1%.exe del %O1%.exe >NUL
@if not exist %O1%.mod ren %O1%.m *.mod >NUL
@REM ... sed is optional (saves space) ...
@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
@if not "%1"=="186" set I0=8086
@for %%a in (io files %O1%) do oc %%a def %I0%
@set I0=
nasm16 hackomf.asm -o hackomf.com
hackomf %O1%.obj
val %O1%+files+io+sys;
@if exist %O1%.exe goto okay
tlink /x %O1%+files+io+sys;
@if exist %O1%.exe goto okay
alink -oEXE %O1% files io sys
@if exist %O1%.exe goto okay
jwlink op q format dos file %O1%,io,files,sys
@if exist %O1%.exe goto okay
djlink %O1%.obj io.obj files.obj sys.obj
@if not exist %O1%.exe goto end
:okay
dir %O1%.exe | find /i "exe"
::diet -X %O1%.exe >NUL
upx-nrv -qq --ultra-brute --lzma --8086 %O1%.exe
%O1%.exe
@if errorlevel 1 goto end
nasm16 -O3 inv-nasm.asm -o inv-nasm.com
@echo inv-nasm.com    FFF22EF9
@crc32 inv*.com
:end
@del *.ref files.obj io.obj %O1%.obj >NUL
@set O1=
/* === oberonm.bat ends === */

/* === files.mod begins === */
MODULE Files; (* Oberon-M *)
IMPORT IO;
TYPE File* = POINTER TO RECORD handle:INTEGER; eof:BOOLEAN END;

PROCEDURE Close*(f:File);
BEGIN IO.FileClose(f.handle); f := NIL
END Close;

PROCEDURE Open*(name:ARRAY OF CHAR; mode:CHAR): File;
VAR f:File; buf:ARRAY 2 OF CHAR;
BEGIN
  IF mode="r" THEN NEW(f); IO.FileOpen(name,f.handle,0);
  ELSIF mode="w" THEN NEW(f); IO.FileCreate(name,f.handle,0);
  ELSE HALT(255)
  END;
  IF f.handle=0 THEN f := NIL ELSE f.eof := FALSE END;
  RETURN f
END Open;

PROCEDURE ReadChar*(f:File; VAR buf:CHAR);
VAR res:INTEGER;
BEGIN IO.FileRd(buf,f.handle,1,res); f.eof := res = 0
END ReadChar;

PROCEDURE Eof*(f:File): BOOLEAN;
BEGIN RETURN f.eof
END Eof;

PROCEDURE WriteString*(f:File; s:ARRAY OF CHAR);
VAR res,slen:INTEGER;
BEGIN slen := 0; WHILE s[slen] # 0X DO INC(slen) END;
  IO.FileWrt(s,f.handle,slen,res)
END WriteString;

PROCEDURE WriteChar*(f:File; k:CHAR);
VAR s:ARRAY 2 OF CHAR;
BEGIN s := "?"; s[0] := k; WriteString(f,s)
END WriteChar;

PROCEDURE WriteLn*(f:File);
CONST CR=0DX; LF=0AX;
VAR s:ARRAY 3 OF CHAR;
BEGIN s := "\n"; s[0] := CR; s[1] := LF; WriteString(f,s)
END WriteLn;

END Files.
/* === files.mod 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 */
