#!/usr/bin/perl

# quicky by DI aka Magnus
# http://www.campaigncreations.com
# ver .54 last modified: 3/27/00

# 3/27/00 - doh. forgot that conditional jumps are short by default.
#           fixed now, so now large,large actions should still work.
#           elminated the stuff that got assembled at the end, its
#           all inline now
#
# 3/26/00 - oops. Fixed some inconsistency with the ACT_VAR
#           and other var sizing
#
# 3/25/00 - added a for and while loop, and 'action' action.
#           note: none of this has been tested yet. ;)
#           fixed a non-recognizable-0 bug.
#
# 3/24/00 - fixed a bug which caused some of the unit struct vars
#           not to work (or only to work on the marine)
#
# 3/18/00 - added unit struct vars, act var, and some other actions
#
# 3/17/00 - release.

# don't laff, I didn't plan any of it out ok. :)~
# licensed under the GNU GPL: http://www.gnu.org/copyleft/gpl.html
# feel free to redistro and modify so long as you read that

##########################################################################
# 'Constants' MESSY ASSEMBLY STUFF
##########################################################################

# wrapper to fx all units, move ACT_VAR into BP for safe keeping
$ASM_WRAPPER_TOP = qq|
BITS 32
PUSH EDI
PUSH AX
PUSH BP
MOV EDI,0x68D310
MOV AX,0x0
MOV BP,CX
StartWrapper:
|;

# unit number goes in edi
$ASM_WRAPPER_END = qq|
ADD EDI,0x4
INC AX
CMP dword [EDI],0x0
JE ExitWrapper
CMP AX,0xC
JE ExitWrapper
JMP StartWrapper
ExitWrapper:
POP BP
POP AX
POP EDI 
RET
|;

# { } Special Form Statements
@BLOCK_STATEMENTS = ('if','for','while');
# Actions are translated directly into ASM Code, parameters ## are replaced by arguments
# Two args max. type arg1,type arg2| - a ref is a [ ] reference to an address value
# * means size = size of the second arg, else 8, 16, or 32; a val is a value in a register.
# If a ref then the first arg must be a ref; only 1 ref allowed, only 1 val allowed.
%ACTIONS          = (
                      'add'      => "ref,val*|ADD #0,#1\n",
                      'subtract' => "ref,val*|SUB #0,#1\n",
					  'set'      => "ref,val32|MOV EAX,0x00000001\nSHL EAX,#1\nOR #0,EAX\n", # only works with switches!
					  'clear'    => "ref,val32|MOV EAX,0x00000001\nSHL EAX,#1\nNOT EAX\nAND #0,EAX\n",
					  'toggle'   => "ref,val32|MOV EAX,0x00000001\nSHL EAX,#1\nXOR #0,EAX\n",
					  'order'    => "val08|MOV CL,#0\nMOV DL,CL\nAND ECX,0x000000FF\nPUSH ECX\nMOV EAX,0x004B5CB0\nCALL EAX\n",
					  'assign'   => "ref,val*|MOV #0,#1\n",
					);
# IMPORTANT! Registers are off limits if they are used as the Prox Reg, Ref Reg, or 
# Referenced in Code from the Wrapper or used as the ACT_VAR.

# Predicates should take args #0, #1 and finish with a jump to #LOC if true
%PREDICATES       = ( 
                      'eq'       => "ref,val*|CMP #0,#1\nJE #LOC\n",
					  'ne'       => "ref,val*|CMP #0,#1\nJNE #LOC\n",
					  'gt'       => "ref,val*|CMP #0,#1\nJA #LOC\n",
					  'lt'       => "ref,val*|CMP #0,#1\nJB #LOC\n",
					  'gte'      => "ref,val*|CMP #0,#1\nJAE #LOC\n",
					  'lte'      => "ref,val*|CMP #0,#1\nJBE #LOC\n",
                    );

# Register used as a proxy to store immediates
$PROX_REG_32 = 'EBX';
$PROX_REG_16 = 'BX';
$PROX_REG_08 = 'BL';
# Secondary offset referencing Register offset
$REF_REG_32  = 'ESI';
$REF_REG_16  = 'SI';
# Various other ASM/Memory Settings
$ACT_VAR     = 'BP';         # Save the ACT_VAR (CX) in here [currently disabled]
$SEL_UNIT    = 'EDI';        # Normally EDI wuld be 0x0068D310, but we're iterating through all units so we'll "assume" the wrapper works
$SWITCHES    = '0x0050D9A8'; # Base to swicthes (triggers)
# Sub Shortcuts
sub GetOffset { # Moves Offset into $REF_REG_32
   my($base,$offset) = @_;
   my($prelimCode)   = "MOV $REF_REG_32,[$base]\nADD $REF_REG_32,$offset\n";
   return $prelimCode;
}
sub GetOffsetValue { # Moves Value at Offset into $PROX_REG_##
   my($offset,$size) = @_;
   my($prelimCode);
   if ($size eq 'byte')
   { $prelimCode   = "MOV $PROX_REG_08,[$offset]\nAND $PROX_REG_32,0x000000FF\n"; }
   elsif ($size eq 'word')
   { $prelimCode   = "MOV $PROX_REG_16,[$offset]\nAND $PROX_REG_32,0x0000FFFF\n"; }
   elsif ($size eq 'dword')
   { $prelimCode   = "MOV $PROX_REG_32,[$offset]\n"; }
   else { &Error("GetOffsetValue unrecognized size: $size"); }
   return $prelimCode;
}
sub GetProxReg {
   my($size) = shift;
   if ($size eq 'byte') { return $PROX_REG_08; }
   if ($size eq 'word') { return $PROX_REG_16; }
   if ($size eq 'dword'){ return $PROX_REG_32; } 
   
   &Error("GetProxReg unrecognized size: $size"); # can't get here!
}
sub RefOffsetValue { # size [ ] reference of passed in offset
   my($offset,$size) = @_;
   my($prelimCode)   = "$size [$offset]";
   return $prelimCode;
}
# Size of Var | Code to get offset to Variable into $REF_REG_32
%VARS        = (
			     'HITPOINTS'   => "word|".&GetOffset($SEL_UNIT,'0x09'),
				 'SHIELDS'     => "word|".&GetOffset($SEL_UNIT,'0x61'),
				 'ENERGY'      => "byte|".&GetOffset($SEL_UNIT,'0xA3'),
				 'KILL_COUNT'  => "byte|".&GetOffset($SEL_UNIT,'0x8F'),
				 'UNIT_NUM'    => "byte|".&GetOffset($SEL_UNIT,'0x64'),
				 'TEAM_COLOR'  => "byte|".&GetOffset($SEL_UNIT,'0x0C').&GetOffset($REF_REG_32,'0x0A'),
				 'SWITCH'      => "dword|".&GetOffset($SWITCHES,'0x00'),
			   );

# VARS for the UNIT_STRUCT
for ($i=0;$i<=227;$i++)
{
   my($i4x) = sprintf "%X",(4*$i);
   my($i2x) = sprintf "%X",(2*$i);
   my($i1x) = sprintf "%X",   $i;
   $VARS{"MAX_HP_$i"}    = "word|MOV $REF_REG_32,0x006ABD39\nADD $REF_REG_32,0x$i4x\n"; # its shifted 8 bits
   $VARS{"MAX_SH_$i"}    = "word|MOV $REF_REG_32,0x006ADB78\nADD $REF_REG_32,0x$i2x\n";
   $VARS{"SH_ENABLE_$i"} = "byte|MOV $REF_REG_32,0x006ABB68\nADD $REF_REG_32,0x$i1x\n";
   $VARS{"G_WEAPON_$i"}  = "byte|MOV $REF_REG_32,0x006AE418\nADD $REF_REG_32,0x$i1x\n";
   $VARS{"A_WEAPON_$i"}  = "byte|MOV $REF_REG_32,0x006ADA90\nADD $REF_REG_32,0x$i1x\n";
   $VARS{"SIGHT_$i"}     = "byte|MOV $REF_REG_32,0x006B0188\nADD $REF_REG_32,0x$i1x\n";
   $VARS{"ARMOR_$i"}     = "byte|MOV $REF_REG_32,0x006AE500\nADD $REF_REG_32,0x$i1x\n";
   $VARS{"MINERALS_$i"}  = "word|MOV $REF_REG_32,0x006ACC68\nADD $REF_REG_32,0x$i2x\n";
   $VARS{"GAS_$i"}       = "word|MOV $REF_REG_32,0x006AEFA8\nADD $REF_REG_32,0x$i2x\n";
   $VARS{"TIME_$i"}      = "word|MOV $REF_REG_32,0x006AD8C8\nADD $REF_REG_32,0x$i2x\n";
}
			   
$LABEL_NUM = 0;  # initialize label numbers

##########################################################################
# MAIN
##########################################################################

$userInput = &GetUserInput(); # get UserInput and kill whitespace
$userInput =~ s/\s//g;

&AsmOut($ASM_WRAPPER_TOP); # initialize the ASM

@statementBlocks = split(/\{|\}/,$userInput); # seperate IFs and other Curley statements

foreach $part (@statementBlocks) 
{
  if (&BlockStatement($part)) # if an IF or other Curley block
  {
     $part =~ m/^(\w+)\(([\w,\[\]]*)\)(.*)/ or $part =~ m/^(\w+)$/;
	 my($tag,$args,$statementBlock) = ($1,$2,$3);
	 &AsmOut(&AssembleSpecialForm($tag,$args,$statementBlock));
  }
  else # not block statement, regular action
  {
     my(@statements);
     @statements = split(/;/,$part);
	 &AsmOut(&AssembleStatements(@statements));
  }
}

&AsmOut($ASM_WRAPPER_END);  # finish and RET

exit; # we're done.

##########################################################################
# SUBROUTINES
##########################################################################

sub AssembleSpecialForm {
  my($tag,$args,$statementBlock) = @_;
  if    ($tag eq 'if')     { return &AssembleIf($args,$statementBlock); }
  elsif ($tag eq 'for')    { return &AssembleFor($args,$statementBlock); }
  elsif ($tag eq 'while')  { return &AssembleWhile($args,$statementBlock); }
  else                     { &Error("No such special form Block: $tag ($args)"); }
}

sub AssembleFor {
  my($numIterations,$statementBlock) = @_;
  my($forAction) = "MOV ECX,#0\n";
  my($forParams) = 'val32';
  my($asmString) = '';
  $asmString .= "\nPUSHAD\n";
  &AssembleVariables(\$asmString,$forAction,$forParams,$numIterations);
  
  $asmString  .= "ForTopLabel$LABEL_NUM:\nCMP ECX,0x00000000\nJE ForEndLabel$LABEL_NUM\n";
  my(@actions) = split(/;/,$statementBlock);
  $asmString  .= &AssembleStatements(@actions);
  $asmString  .= "SUB ECX,0x00000001\nJMP ForTopLabel$LABEL_NUM\nForEndLabel$LABEL_NUM:\nPOPAD\n";
  $LABEL_NUM++;
  
  return $asmString;
}

sub AssembleWhile {
  my($pred,$statementBlock) = @_;
  my(@statements) = split(/;/,$statementBlock);
  my($asmString) = '';
  my($label) = "GotoLabel$LABEL_NUM"; # init JMP
  $asmString .= "\nPUSHAD\n";         # set up stack
  $asmString .= "ReturnLabel$LABEL_NUM:\n";       # top of loop
  $asmString .= &AssemblePredicate($pred,$label); # check condition
  $asmString .= "JMP EndLabel$LABEL_NUM\n";       # else jump to end
  $asmString .= "$label:\n";                      # conditional jmps here
  $asmString .= &AssembleStatements(@statements); # actions follow
  $asmString .= "JMP ReturnLabel$LABEL_NUM\n";    # return to top to check cmp
  $asmString .= "EndLabel$LABEL_NUM:\n";          # where flow returns
  $asmString .= "POPAD\n";
  $LABEL_NUM++; # increment so future labels will be different
  return $asmString;
}

sub AssembleIf {
  my($pred,$statementBlock) = @_;
  my(@statements) = split(/;/,$statementBlock);
  my($asmString) = '';
  my($label)  = "GotoLabel$LABEL_NUM"; # init label for JMP
  $asmString .= "\nPUSHAD\n";          # set up stack
  $asmString .= &AssemblePredicate($pred,$label); # conditional jmp?
  $asmString .= "JMP EndLabel$LABEL_NUM\n";       # else flow to bottom
  $asmString .= "$label:\n";                      # condition jmps to here
  $asmString .= &AssembleStatements(@statements); # actions follow
  $asmString .= "EndLabel$LABEL_NUM:\n";          # and where flow returns
  $asmString .= "POPAD\n";             # clean up regs
  $LABEL_NUM++; # increment so future labels will be different
  return $asmString;
}

sub AssemblePredicate {
   my($pred,$label) = @_;
   my($asmString) = '';
   my($tag,@args);
   $pred =~ m/^(\w+)\[([\w,]*)\]/ or $pred =~ m/^(\w+)$/;
            $tag  = $1;
			@args = split(/,/,$2);
	my($predBlock) = $PREDICATES{$tag}; # get asm equivalent Block
	unless($predBlock) { &Error("Undefined PREDICATE: $tag (@args)"); }
	my($params,$predCode) = split(/\|/,$predBlock); # Seperate param types from code
	&AssembleVariables(\$asmString,$predCode,$params,@args);
	$asmString  =~ s/#LOC/$label/;
	return $asmString;
}

sub AssembleSGAction {
  my($asmStringRef,@args) = @_;
  unless (@args) { &Error("Invalid number of arguments to ACTION 'action'.") }
  unless ($args[1]) { $args[1] = 0; }
  my($action) = "MOV CX,#0\nAND ECX,0x0000FFFF\n";
  my($params) = 'val16';
  &AssembleVariables($asmStringRef,$action,$params,$args[1]);
  $args[0] = '0x'.(sprintf "%X",$args[0]);
  $$asmStringRef .= "MOV EAX,$args[0]\nCALL EAX\n";
  return $asmString;
}

sub AssembleStatements { # This is horrendously messy. So sue me. :P
   my(@statements) = @_;
   my($asmString) = '';
   foreach $statement (@statements)
   {
      my($tag,@args);
	  $asmString .= "\nPUSHAD\n"; # store old stuff
      $statement =~ m/^(\w+)\(([\w,]*)\)/ or $statement =~ m/^(\w+)$/;
	                $tag = $1;
                    @args = split(/,/,$2);
	  if ($tag eq 'action') { &AssembleSGAction(\$asmString,@args); } # kludge! So what? :P
	  else
	  {
	     my($actionBlock) = $ACTIONS{$tag}; # get asm equivalent Block
	     unless($actionBlock) { &Error("Undefined ACTION: $tag (@args)"); }
	     my($params,$action) = split(/\|/,$actionBlock); # Seperate param types from code
	  
	     &AssembleVariables(\$asmString,$action,$params,@args);
      }
	  $asmString .= "POPAD\n"; # restore state
   }
   
   return $asmString;
}

sub AssembleVariables {
      my($asmStringRef,$action,$params,@args) = @_;
	  my(@params) = split(/,/,$params);
	  if (@args != @params) { &Error("Invalid Number of arguments (@args)") }
	  
	  ## Getting val type for arg1 if it exists ##
	  my($regImmediate) = 0;
	  if ($args[1] && !($args[1] =~ m/^\d*$/) && ($args[1] ne 'ACT_VAR')) # get immediate variable
	  {
	     unless($VARS{$args[1]}) { &Error("Unrecognized Variable Identifier: $args[1]"); }
	     my($size,$code) = split(/\|/,$VARS{$args[1]});
	     $$asmStringRef .= $code;                              # now offset to value in REF
		 $$asmStringRef .= &GetOffsetValue($REF_REG_32,$size); # now immediate value in PROXY
		 $regImmediate   = 1;
	  }
	  elsif ($args[1] eq 'ACT_VAR') # Action Variable is special; saved in $ACT_VAR, move to $PROX_REG
	  {
	     $$asmStringRef .= "MOV $PROX_REG_16,$ACT_VAR\nAND $PROX_REG_32,0x0000FFFF\n";
	  }
	  elsif ($args[1]) # its a number
	  {  
	     $args[1]    = sprintf "%X",$args[1]; # Convert dec to Hex
	     $args[1]    = '0x'.$args[1]; 
	  }
	  
	  ## Depending on val or ref type, get arg0 if it exists ##
	  if ($args[0] && $params[0] eq 'ref') # its a ref type
	  {
	     unless($VARS{$args[0]} or $args[0] eq 'ACT_VAR') { &Error("Unrecognized Variable Identifier: $args[0]"); }
		 my($size);
		 if ($args[0] eq 'ACT_VAR')
		 {
		    $args[0] = "$ACT_VAR";
			$size = 'word';
	     }
		 else
		 {
		    ($size,my($code)) = split(/\|/,$VARS{$args[0]});
		    $$asmStringRef .= $code; # offset ref in REF
		    $args[0] = &RefOffsetValue($REF_REG_32,$size);
		 }
		 if ($args[1] && !($args[1] =~ m/^0x/)) # arg1 is a reg, not a number
		 {                                      # assign appropriate size for arg1 reg according to arg0
		    if    ($params[1] eq 'val*')  { $args[1] = &GetProxReg($size); }
		    elsif ($params[1] eq 'val08') { $args[1] = &GetProxReg('byte'); }
		    elsif ($params[1] eq 'val16') { $args[1] = &GetProxReg('word'); }
            elsif ($params[1] eq 'val32') { $args[1] = &GetProxReg('dword'); }
		    else                          { &Error("Invalid Parameter Type: $params[1]"); }
		 }
	  }
	  elsif ($args[0] && !($args[0] =~ m/^\d*$/) && ($args[0] ne 'ACT_VAR')) # get immediate variable
	  {                                                                     # its a val type
	     unless($VARS{$args[0]}) { &Error("Unrecognized Variable Identifier: $args[0]"); }
	     my($size,$code) = split(/\|/,$VARS{$args[0]});
	     $$asmStringRef .= $code;                              # now offset to value in REF
		 $$asmStringRef .= &GetOffsetValue($REF_REG_32,$size); # now immediate value in PROXY
		    if    ($params[0] eq 'val*')  { $args[0] = &GetProxReg($size); }
		    elsif ($params[0] eq 'val08') { $args[0] = &GetProxReg('byte'); }
		    elsif ($params[0] eq 'val16') { $args[0] = &GetProxReg('word'); }
            elsif ($params[0] eq 'val32') { $args[0] = &GetProxReg('dword'); }
		    else                          { &Error("Invalid Parameter Type: $params[0]"); }
	  }
	  elsif ($args[0] eq 'ACT_VAR') # Action Variable is special; saved in $ACT_VAR
	  {
	     $$asmStringRef .= "MOV $PROX_REG_16,$ACT_VAR\nAND $PROX_REG_32,0x0000FFFF\n";
		    if    ($params[0] eq 'val*')  { $args[0] = &GetProxReg($size); }
		    elsif ($params[0] eq 'val08') { $args[0] = &GetProxReg('byte'); }
		    elsif ($params[0] eq 'val16') { $args[0] = &GetProxReg('word'); }
            elsif ($params[0] eq 'val32') { $args[0] = &GetProxReg('dword'); }
		    else                          { &Error("Invalid Parameter Type: $params[0]"); }
	  }
	  elsif (defined $args[0]) # its a number
	  {  
	     $args[0]    = sprintf "%X",$args[0]; # Convert dec to Hex
	     $args[0]    = '0x'.$args[0]; 
	  }
	     
	  for ($i=0;$i<=@params;$i++)
	  {
	     $action =~ s/#$i/$args[$i]/g; # replace ## in code with arguments
	  }
	  
	  $$asmStringRef .= $action;
	  return 0;
}

sub BlockStatement { # predicate
   my($part) = shift;
   my($bool) = 0;
   foreach $tag (@BLOCK_STATEMENTS) # check for block tags, if True, escape
   {
      if ( $part =~ m/^$tag\b/ ) { $bool = 1; last; }
   }
   if ($bool) { return 1; }
   else       { return 0; }
}

##########################################################################
# I/O
##########################################################################

sub GetUserInput {
   &ParseForm();
   print "Content-type: text/html\n\n<pre><b>Copy Code and Assemble (BITS 32 may be specific to NASM):</b>\n\n";
   return $FORM{'input'};
}

sub ParseForm {

   # Get the input
   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

   # Split the name-value pairs
   my(@pairs) = split(/&/, $buffer);

   foreach $pair (@pairs) {
      my($name, $value) = split(/=/, $pair);

      # Un-Webify plus signs and %-encoding
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $value =~ s/<!--(.|\n)*-->//g;

      $FORM{$name} = $value;
   }
}
   
sub AsmOut {
   my($printout) = shift;
   print $printout;
   return 0;
}

sub Error {
   my($error) = shift;
   print "\n<b>ERROR: $error. Compile Aborted.</b>\n";
   exit;
}

__END__
##########################################################################
Ignore this Junk. Its just for testing. :P

sub GetUserInput {
   my($file) = (shift(@ARGV) or 'test.txt');
   open(FILE,$file) or &Error("No input");
   my(@lines) = <FILE>;
   close(FILE);
   return join('',@lines);
}

sub AsmOut {
 print shift;
}

sub Error {
  die shift;
}