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

/* === isonasm.pas begins === */
{$classic-pascal}
{public domain, nenies proprajho, free for any use}

program isonasm(oldasm,newasm,incasm);
var oldasm,newasm,incasm:text;

procedure adjust;
  const maxline=150;
  type
    linetype=record
      len:integer;
      data:packed array [1..maxline] of char
    end;
  var line:linetype; cseg:boolean;

  procedure readline(var filein:text; var l:linetype);
  var n:integer;
  begin
    n := 1;
    while not eoln(filein) do begin
      read(filein,l.data[n]);
      n := n + 1
    end;
    readln(filein);
    l.len := n-1
  end; {readline}

  procedure adjustit;
  label 411,911;
  const maxstr=15;
  type  str=packed array [1..maxstr] of char;
        tmpstr=packed array [1..20] of char;
  var   p,p2:integer; tmp:tmpstr;

  procedure inc(var i:integer); begin i:=i+1 end; {inc}
  procedure dec(var i:integer); begin i:=i-1 end; {dec}

  procedure writeline(var fileout:text);
  begin
    with line do
      if len > 0 then
        writeln(fileout,data:len)
      else
        writeln(fileout)
  end; {writeline}

  function lenstr(s:str):integer;
  var i:integer;
  begin
    lenstr := 0; i := 0;
    repeat inc(i) until (s[i]='$') or (i=maxstr);
    if s[i]='$' then lenstr := i-1
  end; {lenstr}

  procedure ins(s:str; n:integer);
  var i,slen:integer;
  begin
    slen := lenstr(s);
    for i := line.len downto n do line.data[i+slen] := line.data[i];
    for i := 1 to slen do line.data[n+i-1] := s[i];
    line.len := line.len + slen
  end; {ins}

  procedure instmp(s:tmpstr; n,slen:integer);
  var i:integer;
  begin
    for i := line.len downto n do line.data[i+slen] := line.data[i];
    for i := 1 to slen do line.data[n+i-1] := s[i];
    line.len := line.len + slen
  end; {instmp}

  procedure del(ofs,num:integer);
  var i:integer;
  begin
    for i := ofs+num to line.len do line.data[i-num] := line.data[i];
    line.len := line.len - num
  end; {del}

  function findchar(k:char):integer;
  var n:integer; done:boolean;
  begin
    findchar := 0;
    if line.len > 0 then begin
      n := 1; done := false;
      while (n <= line.len) and (not done) do begin
        if k = line.data[n] then begin
          findchar := n;
          done := true
        end;
        inc(n)
      end
    end
  end; {findchar}

  function foundchar(k:char):boolean;
  begin p := findchar(k); foundchar := p <> 0
  end; {foundchar}

  function find(s:str):integer;
  var tmp:str; i,slen:integer; bak:linetype;
  begin
    find := 0; slen := lenstr(s);
    if line.len >= slen then begin
      bak := line;
      repeat
        if foundchar(s[1]) then
        if line.len < p+slen-1 then p := 0
        else begin
          tmp := '               ';
          for i := p to p+slen-1 do tmp[i-p+1] := line.data[i];
          tmp[slen+1] := '$';
          if tmp = s then begin find := p; p := 0 end
          else line.data[p] := '$'
        end
      until p = 0;
      line := bak
    end
  end; {find}

  function found(s:str):boolean;
  begin p := find(s); found := p <> 0
  end; {found}

  function foundstart(s:str):boolean;
  var tmp:str; i,slen:integer;
  begin
    slen := lenstr(s);
    if (line.len >= slen) and (line.data[1]=s[1]) then begin
      tmp := '               ';
      for i := 1 to slen do tmp[i] := line.data[i];
      tmp[slen+1] := '$';
      foundstart := tmp = s
    end
    else foundstart := false
  end; {foundstart}

  function foundend(s:str):boolean;
  var tmp:str; i,slen:integer;
  begin
    slen := lenstr(s);
    if (line.len >= slen) and (line.data[line.len]=s[slen]) then begin
      tmp := '               ';
      for i := 1 to slen do tmp[i] := line.data[line.len-slen+i];
      tmp[slen+1] := '$';
      foundend := tmp = s
    end
    else foundend := false
  end; {foundend}

  procedure finddel(s:str);
  begin if found(s) then del(p,lenstr(s))
  end; {finddel}

  procedure sub(older,newer:str);
  begin if found(older) then begin del(p,lenstr(older)); ins(newer,p) end
  end; {sub}

  function writeinc:boolean;
  var i:integer;
  begin
    if (line.data[1] in ['A'..'Z']) and
      (found('DB $           ') or found('DW $           '))
    then begin
      p := findchar(' '); p2 := p; while line.data[p2]=' ' do inc(p2);
      for i := 1 to p-1 do tmp[i] := line.data[i];
      writeln(incasm,'%define s_',tmp:p-1,' ',line.data[p2+1]);
      writeinc := true
    end
    else writeinc := false
  end; {writeinc}

  procedure fixproc;
  begin
    if found('PROC $         ') then begin
      p := findchar(' '); line.data[p] := ':';
      line.len := p
    end
  end; {fixproc}

  procedure incdec;
  var i:integer;
  begin
    p := find('INC $          ');
    if p=0 then p := find('DEC $          ');
    if p <> 0 then begin
      p := p + 4;
      while line.data[p]=' ' do inc(p);
      if line.data[p] <> '[' then begin
        p2 := p;
        repeat inc(p2) until (p2=line.len) or (line.data[p2]=' ') or
          (not ((line.data[p2] in ['a'..'z','A'..'Z']) or
                (line.data[p2] in ['0'..'9','_'])));
        if line.data[p2]=' ' then dec(p2);
        if ((p2-p+1) > 2) then begin
          for i := p to p2 do tmp[i-p+1] := line.data[i];
          ins(']$             ',p2+1);
          ins('[$             ',p);
          instmp(tmp,p,p2-p+1);
          ins('s_$            ',p)
        end
      end
    end
  end; {incdec}

  procedure fixop1;
  var i:integer;
  begin
    p2 := findchar(',');
    if p2 <> 0 then if line.data[p2-1] <> ']' then begin
      dec(p2); p := p2;
      repeat dec(p) until (line.data[p]=' ') or
        (not ((line.data[p] in ['a'..'z','A'..'Z']) or
              (line.data[p] in ['0'..'9','_'])));
      inc(p);
      if ((p2-p+1) > 2) and (line.data[p] <> '[') and
        (line.data[p] in ['A'..'Z']) then begin
          for i := p to p2 do tmp[i-p+1] := line.data[i];
          ins(']$             ',findchar(','));
          ins('[$             ',p);
          instmp(tmp,p,p2-p+1);
          ins('s_$            ',p)
      end
    end
  end; {fixop1}

  procedure fixop2;
  var i:integer;
  begin
    p2 := findchar(';');
    if foundchar(',') then
    if ((p2=0) or (p2 > p)) and (line.data[p] <> '[') then begin
      inc(p); p2 := p;
      while (p2 < line.len) and (line.data[p2] <> ' ') and
        ((line.data[p2] in ['a'..'z','A'..'Z']) or
         (line.data[p2] in ['0'..'9','_'])) do
          inc(p2);
      if line.data[p2]=' ' then dec(p2);
      if (p2 > p) and ((p2-p+1) > 2) and (line.data[p] in ['A'..'Z'])
        then begin
          for i := p to p2 do tmp[i-p+1] := line.data[i];
          ins(']$             ',p2+1);
          ins('[$             ',p);
          instmp(tmp,p,p2-p+1);
          ins('s_$            ',p)
      end
    end
  end; {fixop2}

  procedure fixplusbx;
  var i:integer;
  begin
    if found('+BX$           ') then begin
      p := findchar('[')+1; p2 := findchar('+')-1;
      for i := p to p2 do tmp[i-p+1] := line.data[i];
      dec(p);
      instmp(tmp,p,p2-p);
      ins('s_$            ',p);
    end
  end; {fixplusbx}

  procedure unbrakdig;
  begin
    if foundchar(']') then
    if (line.data[p-2]='[') and (line.data[p-1] in ['0'..'9']) then begin
      line.data[p-2] := '_'; del(p,1)
    end
  end; {unbrakdig}

  procedure fixbrakdig;
    function brakdig:boolean;
    begin brakdig := false;
      if (p <> 0) then
        brakdig := (line.data[p-2]='_') and (line.data[p-1] in ['0'..'9'])
    end; {brakdig}
  begin
    if foundchar('[') then if brakdig then del(p-2,2);
    if foundchar(']') then if brakdig then line.data[p-2] := '+'
  end; {fixbrakdig}

  procedure fixseg;
  begin
    with line do begin
      if not cseg then if foundstart('RemoveNewInt9:$') then cseg := true;

      if cseg then
        if foundchar('[') then if data[p+1] <> '0' then
          ins('cs:$           ',p+1);

      if cseg then if foundend('CLC$           ') then cseg := false
    end
  end; {fixseg}

  begin {adjustit}
    if line.len=0 then goto 411;
    if (line.data[1]=';') or found('LEA $          ') then goto 411;

    if foundstart('OldInt9Address$') then
      sub(' DD $          ',' DW 0,$        ');
    if writeinc then goto 411;

    if found('CODE_SEG$      ') or found('END$           ') then
      goto 911;

    finddel('[0]$           ');

    if not found(',O$            ') then begin { ',O[fF][^ ]*' }
      sub('ES:[$          ','[ES:$          ');
      finddel('40:$           ');
      finddel('Word Ptr $     ');

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

  411:
    writeline(newasm);
  911:
  end; {adjustit}

begin {adjust}
  cseg := false;
  writeln(newasm,'%idefine offset'); writeln(newasm,'%define LEA MOV');
  writeln(newasm,'%define B byte');  writeln(newasm,'%define W word');
  writeln(newasm,'%include "inv-nasm.inc"');
  while not eof(oldasm) do begin readline(oldasm,line); adjustit end
end; {adjust}

begin {main}
  reset(oldasm); rewrite(newasm); rewrite(incasm);
  adjust
end.
/* === isonasm.pas ends === */

/* === isonasm.bat begins === */
@echo off
if not exist %0 %0.bat %1
for %%a in (isonasm.pas invaders.asm) do if not exist %%a goto end
if "%NASM%"=="" set NASM=nasm16
if "%NASMENV%"=="" set NASMENV=-O3
::#--- isoedlin.tmp begins ---
:: 1,$r{$classic-pascal},{$l-,d-}
:: sprogram
:: .
:: program isonasm(input,output);
:: 1,$seof(
:: .,.roldasm,input
:: .,.roldasm,input
:: 1,$s:text
:: d
:: 1,$sreset
:: d
:: 1,$r(incasm,(prr
:: 1,$r(newasm,(prr
:: 1,$r(newasm,(prr
:: 1,$scseg:boolean
:: .
:: var line:linetype; cseg:boolean; lineno:integer;
:: 1,$sbegin {adjustit}
:: .
:: begin {adjustit} inc(lineno);
:: .+1i
:: if (lineno mod #)=0 then writeln(' line: ',lineno:4);
:: .
:: 1,$sbegin {adjust}
:: .,$scseg :=
:: .
:: cseg := false; lineno := 0;
:: e isopas.tmp
::#--- isoedlin.tmp ends ---
set E1=isoget.tmp
echo 1,$sends --->%E1%
echo 1,.r:: ,>>%E1%
echo 1,$sbegins --->>%E1%
echo 1,.d>>%E1%
echo 1,$sends --->>%E1%
echo .,$d>>%E1%
set N1=300
if not "%1"=="" set N1=%1
echo 1,$r#,%N1%>>%E1%
set N1=
echo e isoedlin.tmp>>%E1%
set E1=
echo on
edlin %0 <isoget.tmp >NUL
edlin isonasm.pas <isoedlin.tmp >NUL
pcom --gpc-rts -n prr:isorunme.tmp <isopas.tmp
REM ... 21 seconds (less than 1 minute)!! ...
REM ... 2.2 Ghz(x2) laptop (2010), running FreeDOS ...
%TIMEIT% pint --gpc-rts -n prd:isorunme.tmp -n prr:isoasm.tmp <invaders.asm
find "%%define s_" <isoasm.tmp >inv-nasm.inc
find /v "%%define s_" <isoasm.tmp >inv-nasm.asm
%NASM% inv-nasm.asm -o inv-nasm.com
@echo off
echo inv-nasm.com    FFF22EF9
crc32 inv-nasm.com
del iso*.tmp >NUL
:end
if "%NASM%"=="nasm16" set NASM=
if "%NASMENV%"=="-O3" set NASMENV=
/* === isonasm.bat ends === */

/* === tpnasm.dif begins === */
--- isonasm.pas 2022-04-13 20:03:04 +0000
+++ tpnasm.pas  2022-04-13 20:03:22 +0000
@@ -1,2 +1,3 @@
-{$classic-pascal}
+{language=turbo}{ansic=1}
+{$ifdef FPC}{$mode tp}{$endif}
 {public domain, nenies proprajho, free for any use}
@@ -41,3 +42,3 @@
       if len > 0 then
-        writeln(fileout,data:len)
+        writeln(fileout,copy(data,1,len))
       else
@@ -165,3 +166,3 @@
       for i := 1 to p-1 do tmp[i] := line.data[i];
-      writeln(incasm,'%define s_',tmp:p-1,' ',line.data[p2+1]);
+      writeln(incasm,'%define s_',copy(tmp,1,p-1),' ',line.data[p2+1]);
       writeinc := true
@@ -329,4 +330,6 @@
 begin {main}
+  assign(oldasm,'INVADERS.ASM'); assign(newasm,'inv-nasm.asm'); assign(incasm,'inv-nasm.inc');
   reset(oldasm); rewrite(newasm); rewrite(incasm);
   adjust
+  ;close(oldasm); close(newasm); close(incasm)
 end.
/* === tpnasm.dif ends === */

/* === vaxnasm.dif begins === */
--- isonasm.pas 2022-04-13 20:03:04 +0000
+++ vaxnasm.pas 2022-04-13 20:08:18 +0000
@@ -1,2 +1,2 @@
-{$classic-pascal}
+{language=vax}{ansic=1}
 {public domain, nenies proprajho, free for any use}
@@ -329,3 +329,3 @@
 begin {main}
-  reset(oldasm); rewrite(newasm); rewrite(incasm);
+  reset(oldasm,'INVADERS.ASM'); rewrite(newasm,'inv-nasm.asm'); rewrite(incasm,'inv-nasm.inc');
   adjust
/* === vaxnasm.dif ends === */

/* === conform.dif begins === */
--- isonasm.pas 2022-04-13 20:03:04 +0000
+++ conform.pas 2022-04-13 20:18:44 +0000
@@ -1,2 +1,2 @@
-{$classic-pascal}
+{language=vax}{ansic=1} {conformant arrays: GPC, P5C, P2C}
 {public domain, nenies proprajho, free for any use}
@@ -31,4 +31,3 @@
   type  str=packed array [1..maxstr] of char;
-        tmpstr=packed array [1..20] of char;
-  var   p,p2:integer; tmp:tmpstr;
+  var   p,p2:integer; tmp:packed array [1..20] of char;
 
@@ -46,3 +45,3 @@
 
-  function lenstr(s:str):integer;
+  function lenstr(s:packed array [lo..hi:integer] of char):integer;
   var i:integer;
@@ -50,3 +49,3 @@
     lenstr := 0; i := 0;
-    repeat inc(i) until (s[i]='$') or (i=maxstr);
+    repeat inc(i) until (s[i]='$') or (i=hi);
     if s[i]='$' then lenstr := i-1
@@ -54,3 +53,3 @@
 
-  procedure ins(s:str; n:integer);
+  procedure ins(s:packed array [lo..hi:integer] of char; n:integer);
   var i,slen:integer;
@@ -63,10 +62,2 @@
 
-  procedure instmp(s:tmpstr; n,slen:integer);
-  var i:integer;
-  begin
-    for i := line.len downto n do line.data[i+slen] := line.data[i];
-    for i := 1 to slen do line.data[n+i-1] := s[i];
-    line.len := line.len + slen
-  end; {instmp}
-
   procedure del(ofs,num:integer);
@@ -195,6 +186,6 @@
           for i := p to p2 do tmp[i-p+1] := line.data[i];
-          ins(']$             ',p2+1);
-          ins('[$             ',p);
-          instmp(tmp,p,p2-p+1);
-          ins('s_$            ',p)
+          ins(']$',p2+1);
+          ins('[$',p);
+          tmp[p2-p+1+1] := '$'; ins(tmp,p);
+          ins('s_$',p)
         end
@@ -217,6 +208,6 @@
           for i := p to p2 do tmp[i-p+1] := line.data[i];
-          ins(']$             ',findchar(','));
-          ins('[$             ',p);
-          instmp(tmp,p,p2-p+1);
-          ins('s_$            ',p)
+          ins(']$',findchar(','));
+          ins('[$',p);
+          tmp[p2-p+1+1] := '$'; ins(tmp,p);
+          ins('s_$',p)
       end
@@ -240,6 +231,6 @@
           for i := p to p2 do tmp[i-p+1] := line.data[i];
-          ins(']$             ',p2+1);
-          ins('[$             ',p);
-          instmp(tmp,p,p2-p+1);
-          ins('s_$            ',p)
+          ins(']$',p2+1);
+          ins('[$',p);
+          tmp[p2-p+1+1] := '$'; ins(tmp,p);
+          ins('s_$',p)
       end
@@ -255,4 +246,4 @@
       dec(p);
-      instmp(tmp,p,p2-p);
-      ins('s_$            ',p);
+      tmp[p2-p+1] := '$'; ins(tmp,p);
+      ins('s_$',p);
     end
@@ -286,3 +277,3 @@
         if foundchar('[') then if data[p+1] <> '0' then
-          ins('cs:$           ',p+1);
+          ins('cs:$',p+1);
 
@@ -329,3 +320,3 @@
 begin {main}
-  reset(oldasm); rewrite(newasm); rewrite(incasm);
+  reset(oldasm,'INVADERS.ASM'); rewrite(newasm,'inv-nasm.asm'); rewrite(incasm,'inv-nasm.inc');
   adjust
/* === conform.dif 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 */
