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

/* === inviso.pas begins === */
{$classic-pascal}
{$R+,S+}

program inviso(input,output,oldasm,newasm);

const maxlines=2276; maxlinelen=74;
      maxbytenames=60; maxbytenamelen=19;
type  line=record
        len:integer;
        data:packed array [1..maxlinelen] of char
      end;
      bytename=record
        bytelen:integer;
        bytedata:packed array [1..maxbytenamelen] of char
      end;
var   src:array [1..maxlines] of line;
      bytenames:array [1..maxbytenames] of bytename;
      oldasm,newasm:text;
      linesread:integer;
      cseg:boolean; jumpnum:integer;

function founddata(var l:line):char;
  var defdata:packed array[1..4] of char; i,j:integer; done:boolean;
begin
  founddata := ' '; i := 1; done := false;

  if l.len > 0 then
  with l do begin
    while (i < len) and (not done) do
      if data[i]=' ' then done := true
      else i := i+1;

    while data[i]=' ' do i := i+1; i := i-1;

    for j := 1 to 4 do
      if i+j-1 <= len then defdata[j] := data[i+j-1]
      else defdata := '    ';

    if (defdata=' DB ') or (defdata=' DW ') or (defdata=' DD ') then
      founddata := defdata[3]
  end
end; {founddata}

procedure load;
  const buffermax=131;
  type buffer = record
         len:integer;
         data:packed array [1..buffermax] of char
       end;
  var bytenum,j,n:integer; buf:buffer;

  procedure getbytenames(var l:line);
  begin
    with l do
      if len > 0 then
        if data[1] <> ';' then
          if data[1] in ['A'..'Z'] then
            if founddata(l)='B' then begin
              n := 1; bytenum := bytenum+1;
              with bytenames[bytenum] do begin
                bytedata := '                   ';
                repeat
                  bytedata[n] := data[n];
                  n := n+1
                until data[n]=' ';
                bytelen := n-1
              end
            end
  end; {getbytenames}

  procedure tidy(var l:buffer);

    procedure nocomments;
      var p:integer; done:boolean;
    begin
      with l do begin
        p := 1;

        done := false;
        while (data[p] <> ';') and (not done) do
          if p < len then p := p+1
          else done := true;

        if data[p] = ';' then begin
          p := p-1;
          if p > 0 then
            while data[p] = ' ' do
              if p > 0 then p := p-1;
          len := p
        end
      end
    end; {nocomments}

    procedure notabs;
      const tab = 9;
      var n:integer;
    begin
      with l do
        for n := 1 to len do
          if data[n] = chr(tab) then
            data[n] := ' '
    end; {notabs}

    procedure noblanks;
      var p:integer;

      procedure skip;
      begin
        with l do repeat p := p+1 until (data[p]=' ') or (p = len)
      end; {skip}

      procedure snip(j:integer);
        var n:integer;
      begin
        with l do begin
          for n := j to len-1 do data[n] := data[n+1];
          data[len] := ' '; len := len-1
        end
      end; {snip}

      procedure shorten;
      begin
        with l do
        if p+2 <= len then
          while (data[p]=' ') and (data[p+1]=' ') and (data[p+2]=' ') do
            snip(p)
      end; {shorten}

    begin
      with l do begin
        p := 1; if data[p] in ['A'..'Z'] then skip; shorten;
        p := p + 2; skip; shorten;

        if len > 2 then
          if (data[1]=' ') and (data[2]=' ') then
            snip(1)
      end
    end; {noblanks}

  begin
    nocomments; notabs; if l.len > 0 then noblanks
  end; {tidy}

begin
  linesread := 0; bytenum := 0;

  with buf do
  while not eof(oldasm) do begin
    linesread := linesread+1;

    len := 0;
    while not eoln(oldasm) do begin
      len := len+1;
      read(oldasm,data[len])
    end;
    readln(oldasm);

    if len > 0 then tidy(buf);

    if len = 0 then
      linesread := linesread-1
    else begin
      src[linesread].len := len;
      for j := 1 to len do
        src[linesread].data[j] := data[j];
      getbytenames(src[linesread])
    end
  end
end; {load}

procedure doall(procedure doit(var myline:line));
  var num:integer;
begin
  for num := 1 to linesread do doit(src[num])
end; {doall}

procedure show(var l:line);
begin
  with l do if len > 0 then writeln(newasm,data:len)
end; {show}

procedure adjust(var l:line);
  var p,p2:integer; asmlabel,insn,op1,op2:line;

  procedure addline(var addme,tothis:line);
    var m,n:integer;
  begin
    if (addme.len > 0) and (tothis.len+addme.len <= maxlinelen) then begin
      m := 1;
      for n := tothis.len+1 to tothis.len+addme.len do begin
        tothis.data[n] := addme.data[m];
        m := m+1
      end;
      tothis.len := tothis.len + addme.len
    end
  end; {addline}

  procedure getinsn;
    var i:integer;
  begin
    insn.len := 0; asmlabel.len := 0;
    with l do begin
      if len > 0 then begin
        if data[len]=':' then
          addline(l,asmlabel)
        else begin
          p := 0;
          repeat p := p+1 until (p = len) or (data[p] <> ' ');
          p2 := p;
          repeat p2 := p2+1 until (p2 = len) or (data[p2]=' ');
          insn.len := p2-p;
          for i := 0 to insn.len-1 do insn.data[i+1] := data[p+i];
          if insn.data[insn.len]=':' then begin
            addline(insn,asmlabel);
            repeat p2 := p2+1 until (p2 = len) or (data[p2] <> ' ');
            p := p2;
            repeat p2 := p2+1 until (p2 = len) or (data[p2]=' ');
            if data[p2]=' ' then p2 := p2-1;
            insn.len := p2-p+1;
            for i := 0 to insn.len-1 do insn.data[i+1] := data[p+i]
          end
        end
      end
    end
  end; {getinsn}

  function incdec(l:line; n:integer):boolean;
    var str:packed array[1..3] of char; i:integer;
  begin
    str := '   ';
    if l.len > 2 then
      for i := 1 to 3 do str[i] := l.data[n+i-1];
    incdec := (str='INC') or (str='DEC')
  end; {incdec}

  procedure getop1;
    var i:integer;
  begin
    op1.len := 0;
    with l do begin
      if len > 0 then begin
        p := len;
        while (p > 1) and (data[p] <> ',') do p := p-1;

        if data[p]=',' then begin
          p2 := p-1;
          repeat p := p-1 until (p = 1) or (data[p]=' ');
          p := p+1;
          op1.len := p2-p+1;
          for i := 0 to op1.len-1 do op1.data[i+1] := data[p+i];
          with op1 do for i := len+1 to maxlinelen do data[i] := ' '
        end
        else begin
          p := 0;
          repeat p := p+1 until (p = len) or (data[p] <> ' ');
          p2 := p;
          repeat p2 := p2+1 until (p2 = len) or (data[p2]=' ');

          if data[p2-1]=':' then begin
            repeat p2 := p2+1 until data[p2] <> ' ';
            p := p2;
            repeat p2 := p2+1 until (p2 = len) or (data[p2]=' ');
            if p2 <> len then p2 := p2-1
          end;

          if incdec(l,p) then begin
            repeat p := p+1 until data[p]=' ';
            repeat p := p+1 until data[p] <> ' ';
            p2 := p;
            repeat p2 := p2+1 until (p2 = len) or (data[p2]=' ');
            for i := p to p2 do op1.data[i-p+1] := l.data[i];
            op1.len := p2-p+1
          end
        end
      end;

      if founddata(l) <> ' ' then op1.len := 0;

      with op1 do
        if len > 3 then
          if data[len]=']' then
            if (data[len-2]='[') and (data[len-1] in ['0'..'9']) then begin
              data[len-2] := '+'; len := len-1
            end
    end
  end; {getop1}

  procedure fixwordptr(var l:line; w:integer);
    const lenwordptr=9;
    var n:integer; wordptr:packed array [1..lenwordptr] of char;
  begin if l.len-w+1 >= lenwordptr then begin
    for n := 1 to lenwordptr do wordptr[n] := l.data[w+n-1];
    if wordptr='Word Ptr ' then begin
      for n := w+lenwordptr to l.len do l.data[n-lenwordptr] := l.data[n];
      l.len := l.len - lenwordptr
    end end
  end; {fixwordptr}

  procedure getop2;
    var i:integer; done:boolean;
  begin
    op2.len := 0;
    with l do begin
      if len > 0 then begin
        p := len; done := false;
        while (p > 1) and (not done) do begin
          if data[p]=',' then begin
            p2 := p+1;
            op2.len := len-p2+1;
            for i := 0 to op2.len-1 do op2.data[i+1] := data[p2+i];
            with op2 do for i := len+1 to maxlinelen do data[i] := ' ';
            done := true
          end;
          if not done then p := p-1
        end
      end;

      if founddata(l) <> ' ' then op2.len := 0;

      with op2 do
        if len > 3 then begin
          if data[len]=']' then
            if (data[len-2]='[') and (data[len-1] in ['0'..'9']) then begin
              data[len-2] := '+'; len := len-1
            end;
          fixwordptr(op2,1)
        end
    end
  end; {getop2}

  procedure fixtemp(var op:line; var tmp:bytename);
    var z:integer;
  begin
    with op,tmp do begin
      bytedata := '                   ';
      for z := 1 to len do bytedata[z] := data[z];
      bytelen := len;

      if bytedata[bytelen-1]='+' then begin
        bytedata[bytelen-1] := ' '; bytedata[bytelen] := ' ';
        bytelen := bytelen - 2
      end;

      if bytelen > 4 then
        if (bytedata[bytelen]=']') and (bytedata[bytelen-3]='+') and
           (bytedata[bytelen-2]='B') and (bytedata[bytelen-1]='X') then begin
              for z := 1 to 4 do bytedata[bytelen-z+1] := ' ';
              bytelen := bytelen - 4;
              for z := 2 to bytelen do bytedata[z-1] := bytedata[z];
              bytedata[bytelen] := ' ';
              bytelen := bytelen-1
        end
    end
  end; {fixtemp}

  procedure sizeptr(k:char; var brak:line; opdata1:char);
    var b,w:packed array [1..8] of char; n:integer;
  begin
    b := 'byte ptr'; w := 'word ptr';
    with brak do begin
      len := 8;
      if k='b' then for n := 1 to 8 do data[n] := b[n]
      else if k='w' then for n := 1 to 8 do data[n] := w[n];

      if opdata1 <> '[' then begin
        len := len+1; data[9] := '['
      end
    end
  end; {sizeptr}

  function fixop1:boolean;
    var i:integer; temp:bytename; bracket:line; comma,done:boolean;

    procedure skiplabel;
    begin
      with l do
      if data[p+1] in ['A'..'Z'] then begin
        repeat p := p+1 until data[p]=':';
        p := p+1
      end
    end; {skiplabel}

  begin
    fixop1 := false; comma := true;

    with insn do
      if len = 3 then
        if incdec(insn,1) then
          comma := false;

    if op1.len > 2 then
    if (op1.data[1] in ['A'..'Z','[']) and (op1.data[3] <> ':') then begin

      i := 1; done := false;
      while (i <= maxbytenames) and (not done) do begin
        fixtemp(op1,temp);

        if bytenames[i].bytelen = temp.bytelen then
        if bytenames[i].bytedata = temp.bytedata then begin

          p := 0;
          with l do begin
            if comma then begin
              repeat p := p+1 until (p = len) or (data[p]=',');
              if data[p]=',' then begin
                p := 0;
                skiplabel
              end
            end;

            skiplabel;
            repeat p := p+1 until (data[p] <> ' ');
            repeat p := p+1 until (data[p] =  ' ');
            repeat p := p+1 until (data[p] <> ' ');
            len := p-1;
            sizeptr('b',bracket,op1.data[1]);

            with bracket do begin
              addline(op1,bracket);

              if op1.data[op1.len] <> ']' then begin
                len := len+1; data[len] := ']'
              end;

              if comma then begin len := len+1; data[len] := ',' end
            end;

            addline(bracket,l);
            addline(op2,l);

            done := true; fixop1 := done
          end
        end;
        i := i+1
      end;

      if not done then begin
        with l do begin
          p := 0; p2 := len;
          repeat p := p+1 until (data[p] <> ' ');
          repeat p := p+1 until (data[p] =  ' ');
          if p > 1 then if data[p-1]=':' then begin
            repeat p := p+1 until (data[p] <> ' ');
            repeat p := p+1 until (data[p] =  ' ')
          end;
          repeat p := p+1 until (data[p] <> ' ');
          fixwordptr(l,p)
        end;

        p := 0;
        with l do begin
          repeat p := p+1 until (p = len) or (data[p]=',');
          repeat p := p-1 until (p = 1) or (data[p]=' ');
          len := p
        end;

        with bracket do begin
          sizeptr('w',bracket,op1.data[1]);
          addline(op1,bracket);

          if op1.data[op1.len] <> ']' then begin
            len := len+1; data[len] := ']'
          end;

          addline(bracket,l);

          if comma then begin l.len := l.len+1; l.data[l.len] := ',' end;

          addline(op2,l);
          fixop1 := true
        end
      end
    end
  end; {fixop1}

  procedure fixop2;
    var i:integer; temp:bytename; bracket:line; done:boolean;
  begin
    if op2.len > 2 then
    if (op2.data[1] in ['A'..'Z','[']) and (op2.data[3] <> ':') then begin

      i := 1; done := false;
      while (i <= maxbytenames) and (not done) do begin
        fixtemp(op2,temp);

        if bytenames[i].bytelen = temp.bytelen then
        if bytenames[i].bytedata = temp.bytedata then begin

          p := 0;
          with l do begin
            repeat p := p+1 until (p = len) or (data[p]=',');
            if (data[p]=',') and (data[p+1] in ['A'..'Z','[']) then begin
              len := p;
              sizeptr('b',bracket,op2.data[1]);
              addline(bracket,l);
              addline(op2,l);

              if op2.data[op2.len] <> ']' then begin
                len := len+1; data[len] := ']'
              end;

              done := true
            end
          end
        end;
        i := i+1
      end;

      if not done then begin
        p := 0;
        with l do begin
          repeat p := p+1 until (p = len) or (data[p]=',');
          len := p
        end;

        sizeptr('w',bracket,op2.data[1]);
        addline(bracket,l);
        addline(op2,l);

        if l.data[l.len] <> ']' then begin
          l.len := l.len+1;
          l.data[l.len] := ']'
        end
      end
    end
  end; {fixop2}

  function lea:boolean;
    var s:packed array [1..3] of char; n:integer;
  begin
    lea := false;
    with insn do
      if len > 2 then begin
        for n := 1 to 3 do s[n] := data[n];
        if s='LEA' then
          lea := true
      end
  end; {lea}

  function offset:boolean;
    var s:packed array [1..6] of char; n:integer;
  begin
    offset := false;
    with op2 do
      if len > 2 then
        if data[1]='O' then begin
          for n := 1 to 6 do
            if data[n] in ['a'..'z'] then s[n] := chr(ord(data[n])-ord(' '))
            else s[n] := data[n];
          if s='OFFSET' then
            offset := true
        end
  end; {offset}

  procedure nop40seg;
    var s:packed array [1..2] of char; n,p:integer;
  begin
    with l do
    if len > 0 then begin
      p := 1; repeat p := p+1 until (p=len) or (data[p]=':');
      if (data[p]=':') and (p > 2) then begin
        s[1] := data[p-2]; s[2] := data[p-1];
        if s='40' then begin
          s := 'DS'; p := p-2;
          for n := 1 to 2 do data[p+n-1] := s[n]
        end
      end
    end
  end; {nop40seg}

  procedure fixlea;
  var tmp:line; n:integer;
      mov:packed array [1..3] of char; ofs:packed array [1..7] of char;
  begin
    p := 1; while l.data[p] <> 'L' do p := p+1;
    mov := 'MOV'; for n := 1 to 3 do l.data[p+n-1] := mov[n];
    while l.data[p] <> ',' do p := p+1; p := p+1;
    for n := p to l.len do tmp.data[n-p+1] := l.data[n];
    tmp.len := l.len-p+1;
    ofs := 'OFFSET '; for n := 1 to 7 do l.data[p+n-1] := ofs[n];
    l.len := p-1+7;
    addline(tmp,l)
  end; {fixlea}

  procedure fixproc;
  var i:integer; s:packed array [1..4] of char;
  begin
    with l do
    if len >= 4 then begin
      for i := 3 downto 0 do s[4-i] := data[len-i];
      if s='ENDP' then len := 0
      else if (s='NEAR') or (s=' FAR') then begin
        i := 1; while data[i] <> ' ' do i := i+1; data[i] := ':'; len := i
      end
    end
  end; {fixproc}

  procedure a86fixes; {works out of the box with JWasm,TASM,WatASM,A86}

    procedure dontassume;
    var assume:packed array [1..6] of char; n:integer;
    begin
      if (l.len > 0) and (insn.len >= 6) then begin
        for n := 1 to 6 do assume[n] := insn.data[n];
        if assume='Assume' then l.len := 0
      end
    end; {dontassume}

    procedure delbrakzero;
    var ending:packed array [1..3] of char; n:integer;
    begin
      if l.len > 3 then begin
        for n := 1 to 3 do ending[n] := l.data[l.len-3+n];
        if ending='[0]' then l.len := l.len-3
      end
    end; {delbrakzero}

    procedure shorten;
    var jmp:packed array [1..3] of char; n:integer;
      short:packed array [1..6] of char;
    begin
      if insn.len=3 then begin
        for n := 1 to 3 do jmp[n] := insn.data[n];
        if jmp='JMP' then begin
          short := 'SHORT ';
          jumpnum := jumpnum+1;
          if not (jumpnum in
            [3..6,12,14,17,19..21,23,24,30,36,39,42,45,47..70,89]) then begin
              for n := l.len+6 downto 7 do l.data[n] := l.data[n-6];
              for n := 7 to 12 do l.data[n] := short[n-6]; l.len := l.len+6
          end
        end
      end
    end; {shorten}

    procedure insertseg;
    var mov:packed array [1..3] of char; i,n:integer;
      csegon:packed array [1..13] of char;
      cs,csegoff:packed array [1..4] of char;
    begin
      if insn.len=13 then begin
        for n := 1 to 13 do csegon[n] := insn.data[n];
        if csegon='RemoveNewInt9' then cseg := true
      end;
      if cseg and (insn.len=3) then begin
        for n := 1 to 3 do mov[n] := insn.data[n];
        if mov='MOV' then begin cs := ' cs:';
          i := 0; repeat i:=i+1 until (l.data[i]='[') or (i=l.len);
          if (i < l.len) then
          if (l.data[i]='[') and (l.data[i+1] <> '0') then begin
            for n := l.len+4 downto i+4 do l.data[n] := l.data[n-4];
            for n := 1 to 4 do l.data[i+n-1] := cs[n]; l.len := l.len+4
          end
        end
      end;
      if l.len=4 then begin
        for n := 1 to 4 do csegoff[n] := l.data[n];
        if csegoff=' CLC' then cseg := false
      end
    end; {insertseg}

  begin dontassume; delbrakzero; shorten; insertseg
  end; {a86fixes}

begin
  getinsn; getop1; getop2; nop40seg;

  if not (lea or offset) then
    if not fixop1 then fixop2;

  if lea then fixlea; fixproc; a86fixes
end; {adjust}

begin cseg := false; jumpnum := 0;
  reset(oldasm); load;
  doall(adjust);
  rewrite(newasm); doall(show)
end.
/* === inviso.pas ends === */

/* === inviso.bat begins === */
@echo off
if not exist %0 %0.bat %1
for %%a in (inviso.pas invaders.asm) do if not exist %%a goto end
::#--- invedlin.tmp begins ---
:: 1,$r{$classic-pascal},{$l-,d-}
:: 1,$s{$R+,S+}
:: d
:: 1,$sprogram
:: .
:: program inviso(input,output);
:: 1,$roldasm,input
:: 1,$rnewasm,prr
:: 1,$sreset
:: .
:: writeln('reading'); load; writeln('done');
:: 1,$srewrite
:: .
:: doall(show)
:: 1,$sbegin cseg
:: .+1i
:: num := 0;
:: .
:: 1,$s:text
:: .
:: num:integer;
:: 1,$s; nop40seg;
:: .i
:: num := num+1;
:: .
:: 1,$rend; {adjust},;if(num mod #)=0 then writeln('line ',num:4)end;
:: e invpas.tmp
::#--- invedlin.tmp ends ---
set E1=invget.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 invedlin.tmp>>%E1%
set E1=
echo on
edlin %0 <invget.tmp >NUL
edlin inviso.pas <invedlin.tmp >NUL
pcom --gpc-rts -n prr:invrunme.tmp <invpas.tmp
REM ... 21 seconds (less than 1 minute)!! ...
REM ... 2.2 Ghz(x2) laptop (2010), running FreeDOS ...
%TIMEIT% pint --gpc-rts -n prd:invrunme.tmp -n prr:inv.asm <invaders.asm
a86 +S inv.asm inv-a86 >NUL
@echo off
echo inv-a86.com     CDFE86FA
crc32 inv-a86.com
del inv*.tmp >NUL
:end
/* === inviso.bat ends === */

/* === stdinput.dif begins === */
--- inviso.pas 2022-04-08 11:01:32 +0000
+++ inviso.p   2022-04-08 11:05:24 +0000
@@ -1,5 +1,2 @@
-{$classic-pascal}
-{$R+,S+}
-
-program inviso(input,output,oldasm,newasm);
+program inviso(input,output{,oldasm,newasm});
 
@@ -17,3 +14,3 @@
       bytenames:array [1..maxbytenames] of bytename;
-      oldasm,newasm:text;
+      {oldasm,newasm:text;}
       linesread:integer;
@@ -147,3 +144,3 @@
   with buf do
-  while not eof(oldasm) do begin
+  while not eof{(oldasm)} do begin
     linesread := linesread+1;
@@ -151,7 +148,7 @@
     len := 0;
-    while not eoln(oldasm) do begin
+    while not eoln{(oldasm)} do begin
       len := len+1;
-      read(oldasm,data[len])
+      read({oldasm,}data[len])
     end;
-    readln(oldasm);
+    readln{(oldasm)};
 
@@ -178,3 +175,3 @@
 begin
-  with l do if len > 0 then writeln(newasm,data:len)
+  with l do if len > 0 then writeln({newasm,}data:len)
 end; {show}
@@ -674,5 +671,5 @@
 begin cseg := false; jumpnum := 0;
-  reset(oldasm); load;
+  {reset(oldasm);} load;
   doall(adjust);
-  rewrite(newasm); doall(show)
+  {rewrite(newasm);} doall(show)
 end.
/* === stdinput.dif ends === */

/* === invfpc.dif begins === */
--- inviso.pas 2022-04-08 11:01:32 +0000
+++ invfpc.pas 2022-04-08 11:06:50 +0000
@@ -1,5 +1,5 @@
-{$classic-pascal}
-{$R+,S+}
+{$ifdef FPC}{$mode tp}{$endif}
+{$ifdef NODEBUG}{$R-,S-}{$else}{$R+,S+}{$endif}
 
-program inviso(input,output,oldasm,newasm);
+program invfpc;
 
@@ -15,2 +15,3 @@
       end;
+      doitproc=procedure (var myline:line);
 var   src:array [1..maxlines] of line;
@@ -170,3 +171,3 @@
 
-procedure doall(procedure doit(var myline:line));
+procedure doall(doit:doitproc);
   var num:integer;
@@ -178,3 +179,3 @@
 begin
-  with l do if len > 0 then writeln(newasm,data:len)
+  with l do if len > 0 then writeln(newasm,copy(data,1,len))
 end; {show}
@@ -674,5 +675,7 @@
 begin cseg := false; jumpnum := 0;
-  reset(oldasm); load;
+  if paramcount < 2 then halt;
+  assign(oldasm,paramstr(1)); assign(newasm,paramstr(2));
+  reset(oldasm); load; close(oldasm);
   doall(adjust);
-  rewrite(newasm); doall(show)
+  rewrite(newasm); doall(show); close(newasm)
 end.
/* === invfpc.dif ends === */

/* === invtp.dif begins === */
--- inviso.pas 2022-04-08 11:01:32 +0000
+++ invtp.pas  2022-04-08 11:06:42 +0000
@@ -1,5 +1,6 @@
-{$classic-pascal}
-{$R+,S+}
+{$ifdef FPC}{$mode tp}{$endif}
+{$ifdef MSDOS}{$M 4096,0,655360}{$endif}
+{$ifdef NODEBUG}{$R-,S-}{$else}{$R+,S+}{$endif}
 
-program inviso(input,output,oldasm,newasm);
+program invtp;
 
@@ -15,3 +16,4 @@
       end;
-var   src:array [1..maxlines] of line;
+      doitproc = procedure (var myline:line); {Far}
+var   src:array [1..maxlines] of ^line;
       bytenames:array [1..maxbytenames] of bytename;
@@ -162,6 +164,7 @@
     else begin
-      src[linesread].len := len;
+      new(src[linesread]);
+      src[linesread]^.len := len;
       for j := 1 to len do
-        src[linesread].data[j] := data[j];
-      getbytenames(src[linesread])
+        src[linesread]^.data[j] := data[j];
+      getbytenames(src[linesread]^)
     end
@@ -170,11 +173,12 @@
 
-procedure doall(procedure doit(var myline:line));
+procedure doall(doit:doitproc);
   var num:integer;
 begin
-  for num := 1 to linesread do doit(src[num])
+  for num := 1 to linesread do doit(src[num]^)
 end; {doall}
 
+{$ifdef VER55}{$F+}{$endif}
 procedure show(var l:line);
 begin
-  with l do if len > 0 then writeln(newasm,data:len)
+  with l do if len > 0 then writeln(newasm,copy(data,1,len))
 end; {show}
@@ -672,7 +676,14 @@
 end; {adjust}
+{$ifdef VER55}{$F-}{$endif}
 
+{$ifdef DEALLOC}var no:integer;{$endif}
 begin cseg := false; jumpnum := 0;
-  reset(oldasm); load;
+  {$ifdef MEMAVAIL}writeln('; memavail = ',memavail);{$endif} {595408}
+  if paramcount < 2 then halt;
+  assign(oldasm,paramstr(1)); assign(newasm,paramstr(2));
+  reset(oldasm); load; close(oldasm);
   doall(adjust);
-  rewrite(newasm); doall(show)
+  rewrite(newasm); doall(show); close(newasm);
+  {$ifdef DEALLOC}for no := 1 to linesread do dispose(src[no]);{$endif}
+  {$ifdef MEMAVAIL}writeln('; memavail = ',memavail);{$endif} {422432}
 end.
/* === invtp.dif ends === */

/* === invvax.dif begins === */
--- inviso.pas 2022-04-08 11:01:32 +0000
+++ invvax.pas 2022-04-15 00:42:28 +0000
@@ -1,5 +1,3 @@
-{$classic-pascal}
-{$R+,S+}
-
-program inviso(input,output,oldasm,newasm);
+{language=vax}{ansic=1}
+program invvax(input,output,oldasm,newasm);
 
@@ -674,5 +672,5 @@
 begin cseg := false; jumpnum := 0;
-  reset(oldasm); load;
+  reset(oldasm,'INVADERS.ASM'); load;
   doall(adjust);
-  rewrite(newasm); doall(show)
+  rewrite(newasm,'inv.asm'); doall(show)
 end.
/* === invvax.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 */
