/* REXX */

/*
-----------------------------------------------------------------
  unpacker (v0.1h) = 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='sizechec.inc ctype.sed ctype.inc ctype.dbg' ,
  'linenum.inc tidy.inc found.sed del.sed'

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

if host='UNIX' then exclude=allexclude ''
else exclude=allexclude ''

if translate(only)='/ALL' then do ; only='' ; exclude='' ; end

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
  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 outline
  end
  else if pos(footpost,line) \= 0 & only=outfile then exit
return

outline:
  /* line=changeonce('{!TAB!}',line,'9'x) */
  call lineout outfile, line
return

changeonce: procedure
  parse arg before, str, after
  ofs=pos(before,str)
  if ofs \= 0 then do
    str=delstr(str,ofs,length(before))
    str=insert(after,str,ofs-1,length(after))
  end
return str

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

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

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

/* === invfasm.pas begins === */
{$ifdef FPC}{$mode tp}{$endif}{$I+}
{$ifdef DEBUG}{$R+,S+}{$else}{$R-,S-}{$endif}

program invfasm; {public domain, nenies proprajho, free for any use}
var source,target:text; line:string[135]; p,p2:byte;

function found(s:string):boolean;
begin found := pos(s,line) <> 0 end;

procedure Adjust;

{$ifdef TIDY}{$I tidy.inc}{$endif}

  procedure del(l:string);
  begin p := pos(l,line);
    if p <> 0 then delete(line,p,length(l))
  end;

  procedure sub(old,new:string);
  begin p := pos(old,line);
    if p <> 0 then begin
      delete(line,p,length(old));
      insert(new,line,p)
    end
  end;

  procedure fixproc;
  begin p := pos(' PROC ',line);
    if p <> 0 then begin
      repeat dec(p) until line[p] <> ' '; inc(p); line[p] := ':';
      delete(line,p+1,length(line)-p)
    end
  end;

  procedure incdec;
  begin p := pos('INC ',line); if p=0 then p := pos('DEC ',line);
    if p <> 0 then begin
      inc(p,4);
      while line[p]=' ' do inc(p);
      if line[p] <> '[' then begin
        p2 := p;
        repeat inc(p2) until (p2=length(line)) or (line[p2]=' ') or
          (not (line[p2] in ['a'..'z','A'..'Z','0'..'9']));
        if p2 <> length(line) then dec(p2);
        if ((p2-p+1) > length('DX')) then begin
          insert('[',line,p);
          insert(']',line,p2+2)
        end
      end
    end
  end;

  procedure fixop1;
  begin p2 := pos(',',line);
    if (p2 <> 0) and (line[p2-1] <> ']') then begin
      dec(p2); p := p2;
      repeat dec(p) until (line[p]=' ') or
        (not (line[p] in ['a'..'z','A'..'Z','0'..'9','_']));
      inc(p);
      if ((p2-p+1) > length('DX')) and (line[p] <> '[') and
        (line[p] in ['A'..'Z']) then begin
          insert('[',line,p);
          insert(']',line,pos(',',line))
      end
    end
  end;

  procedure fixop2;
  begin p := pos(',',line);
    if (p <> 0) and (line[p] <> '[') then begin
      inc(p); p2 := p;
      while (p2 < length(line)) and (line[p2] <> ' ') and
        (line[p2] in ['a'..'z','A'..'Z','0'..'9','_']) do
          inc(p2);
      if line[p2]=' ' then dec(p2);
      if ((p2-p) > length('DX')) and (line[p] in ['A'..'Z']) then begin
          insert('[',line,p);
          insert(']',line,p2+2)
      end
    end
  end;

label print;

const insertseg:boolean=false;

{$ifdef LINENUM}{$I linenum.inc}begin linenum;{$else}
begin
{$endif}

{$ifdef TIDY}if tidy and (length(line)=0) then exit;{$endif}

  if (line[1]=';') or found('LEA ') or found(' DB ') or found(' DW ') then
    goto print;

  if found('CODE_SEG') or found('END ') or found(' ENDP') then exit;

  del('[0]'); if found(',O') then goto print;
  sub(' DD ',' DW 0,'); sub('ES:[','[ES:'); del('40:'); del('Word Ptr ');

  fixproc;

  p := pos('],',line);
  if (p >= 4) and (line[p-2]='[') and (line[p-1] in ['0'..'9']) then
    sub('[' + line[p-1] + ']','_' + line[p-1]);

  fixop1; fixop2;

  p := pos('_',line);
  if (p <> 0) and (line[p+2]=']') and (line[p+1] in ['0'..'9']) then
    sub('_','+');

  incdec; sub('[]','+'); sub('][','+');

  if found('RemoveNewInt9:') then insertseg := true;
  if insertseg and not found('[0') then sub('[','[cs:');
  if found('CLC') then insertseg := false;

  print:
    writeln(target,line)
end;

{$ifdef SIZECHECK}{$I sizechec.inc}{$endif}

const oldasm='INVADERS.ASM'; newasm='inv-fasm.asm';
{$ifndef FPC}LineEnding={$ifdef UNIX}#10{$else}#13#10{$endif};{$endif}
{$ifdef BUFFER}var inbuf,outbuf:array [1..16*1024] of char;{$endif}

begin {main}
  assign(source,oldasm);
{$ifdef BUFFER}settextbuf(source,inbuf);{$endif}
  reset(source);

{$ifdef SIZECHECK}sizecheckold(oldasm);{$endif}

  assign(target,newasm);
{$ifdef BUFFER}settextbuf(target,outbuf);{$endif}
  rewrite(target);

  writeln(target,'OFFSET equ' + LineEnding + 'Offset equ' + LineEnding +
    'LEA equ MOV'); {VER55 saves ~100 bytes vs. calling writeln 3x}

  while not eof(source) do begin
    readln(source,line);
    Adjust
  end;

  close(target); close(source);

{$ifdef SIZECHECK}sizechecknew(newasm){$endif}
end.
/* === invfasm.pas ends === */

/* === sizechec.inc begins === */
function sizecheck(fname:string; fsize:longint):boolean;
var f:file of byte; s:longint;
begin {$ifndef __GPC__}filemode := 0;{$endif}
  assign(f,fname); reset(f); s := filesize(f); close(f);
  sizecheck := s = fsize
end;

procedure sizecheckold(fname:string);
begin
  if not sizecheck(fname,137621) then begin
    writeln('''',fname,''' size mismatch!'); halt(2)
  end
end;

procedure sizechecknew(fname:string);
begin
  if not sizecheck(fname,133590) then begin
    writeln('''',fname,''' size mismatch!');
    writeln('Assembled .COM should be CRC32 = FFF22EF9 (like in .ZIP)');
    halt(3)
  end
end;
/* === sizechec.inc ends === */

/* === linenum.inc begins === */
procedure linenum;
const lineno:word=0;

{$ifdef VER55}{saves ~400 bytes}
procedure saylineno;
inline(
(* $CC/           { int3        } *)
  $B0/$24/        { mov al,'$'  }
  $CD/$29/        { int 29h     }
  $8B/$16/lineno/ { mov dx,li.. }
  $B9/$04/$04/    { mov cx,404h }
  $D3/$C2/        { rol dx,cl   }
  $88/$D0/        { mov al,dl   }
  $24/$0F/        { and al,15   }
  $3C/$0A/        { cmp al,10   }
  $1C/$69/        { sbb al,69h  }
  $2F/            { das         }
  $CD/$29/        { int 29h     }
  $FE/$CD/        { dec ch      }
  $75/$EF/        { jnz .rol    }
  $B0/13/         { mov al,13   }
  $CD/$29/        { int 29h     }
  $B0/10/         { mov al,10   }
  $CD/$29         { int 29h     }
);
{$endif}

begin inc(lineno); if (lineno and $ff)=0 then
  {$ifdef VER55}saylineno{$else}writeln('lineno=',lineno:4){$endif}
end;
/* === linenum.inc ends === */

/* === ctype.sed begins === */
# avoiding sets saves ~400 bytes for TP 5.5
/procedure Adjust/i\
{$I ctype.inc}
s/\([^( ][^ ]*\) in \(\[.*\]\)/ctype(\1,\2)/
s/ctype(\(.*\),\['0'\.\.'9'\])/isdigit(\1)/
s/ctype(\(.*\),\['A'\.\.'Z'\])/isupper(\1)/
s/ctype(\(.*\),\['a'\.\.'z','A'\.\.'Z','0'\.\.'9'\])/isalnum(\1)/
s/ctype(\(.*\),\['a'\.\.'z','A'\.\.'Z','0'\.\.'9','_'\])/isalnum(\1)or(\1='_')/
/* === ctype.sed ends === */

/* === ctype.inc begins === */
{inlining avoids several useless, slow jumps that are called often}

function isdigit(c:char):boolean;
{$ifdef VER55}
  inline(
  (* $CC/           { int3         } *)
    $3C/ord('0')/   { cmp al,'0'   }
    $F5/            { cmc          }
    $1A/$C9/        { sbb cl,cl    }
    $3C/ord('9')+1/ { cmp al,'9'+1 }
    $1A/$D2/        { sbb dl,dl    }
    $B0/$FF/        { mov al,-1    }
    $22/$C1/        { and al,cl    }
    $22/$C2         { and al,dl    }
  )
{$else}begin isdigit := (c >= '0') and (c <= '9') end
{$endif}
;

function isupper(c:char):boolean;
{$ifdef VER55}
  inline(
  (* $CC/           { int3         } *)
    $3C/ord('A')/   { cmp al,'A'   }
    $F5/            { cmc          }
    $1A/$C9/        { sbb cl,cl    }
    $3C/ord('Z')+1/ { cmp al,'Z'+1 }
    $1A/$D2/        { sbb dl,dl    }
    $B0/$FF/        { mov al,-1    }
    $22/$C1/        { and al,cl    }
    $22/$C2         { and al,dl    }
  )
{$else}begin isupper := (c >= 'A') and (c <= 'Z') end
{$endif}
;

function islower(c:char):boolean;
{$ifdef VER55}
  inline(
  (* $CC/           { int3         } *)
    $3C/ord('a')/   { cmp al,'a'   }
    $F5/            { cmc          }
    $1A/$C9/        { sbb cl,cl    }
    $3C/ord('z')+1/ { cmp al,'z'+1 }
    $1A/$D2/        { sbb dl,dl    }
    $B0/$FF/        { mov al,-1    }
    $22/$C1/        { and al,cl    }
    $22/$C2         { and al,dl    }
  )
{$else}begin islower := (c >= 'a') and (c <= 'z') end
{$endif}
;

function isalnum(c:char):boolean;
begin isalnum := isdigit(c) or isupper(c) or islower(c) end;
/* === ctype.inc ends === */

/* === ctype.dbg begins === */
function isdigit(c:char):boolean;
  function older(k:char):boolean;
  begin older := (k >= '0') and (k <= '9') end;

  function newer(q:char):boolean;
  inline(
  (* $CC/           { int3         } *)
    $3C/ord('0')/   { cmp al,'0'   }
    $F5/            { cmc          }
    $1A/$C9/        { sbb cl,cl    }
    $3C/ord('9')+1/ { cmp al,'9'+1 }
    $1A/$D2/        { sbb dl,dl    }
    $B0/$FF/        { mov al,-1    }
    $22/$C1/        { and al,cl    }
    $22/$C2         { and al,dl    }
  );
begin
  if (older(c) and newer(c)) then isdigit := true
  else begin
    isdigit := false;
    if (c in ['0'..'9']) then writeln('isdigit(',c,') failed!')
  end
end; {isdigit}

function isupper(c:char):boolean;
  function older(k:char):boolean;
  begin older := (k >= 'A') and (k <= 'Z') end;

  function newer(q:char):boolean;
  inline(
  (* $CC/           { int3         } *)
    $3C/ord('A')/   { cmp al,'A'   }
    $F5/            { cmc          }
    $1A/$C9/        { sbb cl,cl    }
    $3C/ord('Z')+1/ { cmp al,'Z'+1 }
    $1A/$D2/        { sbb dl,dl    }
    $B0/$FF/        { mov al,-1    }
    $22/$C1/        { and al,cl    }
    $22/$C2         { and al,dl    }
  );
begin
  if (older(c) and newer(c)) then isupper := true
  else begin
    isupper := false;
    if (c in ['A'..'Z']) then writeln('isupper(',c,') failed!')
  end
end; {isupper}

function islower(c:char):boolean;
  function older(k:char):boolean;
  begin older := (k >= 'a') and (k <= 'z') end;

  function newer(q:char):boolean;
  inline(
  (* $CC/           { int3         } *)
    $3C/ord('a')/   { cmp al,'a'   }
    $F5/            { cmc          }
    $1A/$C9/        { sbb cl,cl    }
    $3C/ord('z')+1/ { cmp al,'z'+1 }
    $1A/$D2/        { sbb dl,dl    }
    $B0/$FF/        { mov al,-1    }
    $22/$C1/        { and al,cl    }
    $22/$C2         { and al,dl    }
  );
begin
  if (older(c) and newer(c)) then islower := true
  else begin
    islower := false;
    if (c in ['a'..'z']) then writeln('islower(',c,') failed!')
  end
end; {islower}

function isalnum(c:char):boolean;
begin isalnum := isdigit(c) or isupper(c) or islower(c) end;
/* === ctype.dbg ends === */

/* === tidy.inc begins === */
{
TODO:
  s/^\([a-zA-Z0-9_][a-zA-Z0-9_]*:\) *\([^ ][^ ]*\)/\1\n\2/
  s,^ *\([^ ][^ ]*\)[ ][ ]*,\1 ,
  s,^ *\([^ ][^ ]*\) \([^ ][^ ]*\)[ ][ ]*,\1 \2 ,
}

function tidy:boolean;{58k vs. 133k output .ASM, saves disk space}

  function wanttidy:boolean;
  const msg='TIDY';
  var s:string[length(msg)+1]; b:byte;
  begin wanttidy := false;
    if paramcount > 0 then begin
      b := length(paramstr(1));
      if (b=4) or (b=5) then begin
        s := paramstr(1);
        if (s[1]='/') or (s[1]='-') then delete(s,1,1);
        for b := 1 to length(msg) do s[b] := upcase(s[b]);
        wanttidy := s = msg
      end
    end
  end;

  procedure notabs;
  var foundtab:byte;
  const tab=#9;
  begin
    repeat
      foundtab := pos(tab,line);
      if foundtab <> 0 then begin
        p := foundtab; p2 := p;
        repeat inc(p2) until line[p2] <> tab; dec(p2);
        delete(line,p,(p2-p)+1); insert(' ',line,p)
      end
    until foundtab=0
  end;

  procedure nocomments;
  begin p := pos(';',line);
    if p <> 0 then begin
      delete(line,p,length(line)-p+1)
    end
  end;

  procedure noedgeblanks;
  begin p := 0;
    while (p <= length(line)) and (line[p+1]=' ') do inc(p);
    if p <> 0 then delete(line,1,p);

    p := length(line); p2 := p;
    if (p <> 0) and (line[p2]=' ') then begin
      repeat dec(p) until line[p] <> ' '; inc(p);
      delete(line,p,(p2-p)+1)
    end
  end;

var istidy:boolean;

begin istidy := wanttidy;
  if istidy then begin
    notabs;
    nocomments;
    noedgeblanks
  end;
  tidy := istidy
end;
/* === tidy.inc ends === */

/* === found.sed begins === */
# inline this useless function
/function found/,/end;/d
s/ found(\([^)]*\))/(pos(\1,line)<>0)/g
s/ not\((pos('[^']*',[^)]*)\)<>0)/\1=0)/
/* === found.sed ends === */

/* === del.sed begins === */
# inline this useless procedure
/procedure del/,/end;/d
s/del(\([^)]*\))/if(pos(\1,line)<>0)then\
delete(line,pos(\1,line),length(\1))/g
/* === del.sed 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 */
