(* HANDLE.PAS: Please read the bottom of DRAAK.PAS for Copyright details.  *)

procedure handleCmd(acts: PAct; syns: PSyn);
begin
 iid := 0; while acts^.asmLn[iid] = ' ' do iid := iid+1;
 case acts^.asmLn[iid+1] of
  'i': processFile(strPas(replaceSyn(acts^.asmLn, syns)+2)); {Include File}
  's': strip(acts, syns);       {Strip asmLn}
  'a': abstra(acts, syns);      {abstract var define}
  'v': localVars(acts, syns);   {Local Vars Defined}
  'c': codePrep(acts, syns);    {Code preperations}
  'd': define(acts, syns);      {Type Define}
  '"': stringalize(acts, syns); {Stringalize}
  'e': evaulate(acts, syns);    {Evaluate inner () }
  'E': evalOne(acts, syns);     {Evaluate a single expersion}
 end;
end;

{**************************************************************************}
function abstra(acts: PAct; syns: PSyn): PVar;
var dvar: PVar; actLn, temp1: PChar;
begin
 actLn := replaceSyn(acts^.asmLn, syns); dvar := momVars;
 while dvar^.nextVar <> nil do
  dvar := dvar^.nextVar;
 i := 2;
 new(dvar^.nextVar); dvar := dvar^.nextVar;
 while ((actLn[i] <> ' ') AND (ischar(actLn[i]))) do i := i+1; if (actLn[i] <> ' ') then error(3);
 temp1 := actLn+2; actLn[i] := #0;
 getMem(dvar^.varVal, strLen(temp1)+1); strCopy(dvar^.varVal, temp1);
 actLn[i] := ' '; i := i+1; temp1 := actLn+i;
 while (((actLn[i] <> ' ') OR (actLn[i] <> #0)) AND (ischar(actLn[i]))) do i := i+1;
 if (actLn[i] <> ' ') AND (actLn[i] <> #0) then error(3);
 if ((strComp(temp1, '_byte')=0) OR (strComp(temp1, '_word')=0) OR
  (strComp(temp1, '_dword')=0) OR (strComp(temp1, '_qword')=0)) then
  temp1 := temp1+1;

 actLn[i] := #0; getMem(dvar^.varType, strLen(temp1)+1); strCopy(dvar^.varType, temp1);
 freeMem(actLn, strLen(actLn)+1); dvar^.varDira := nil; dvar^.nextVar := nil;
 abstra := dvar;
end;

{**************************************************************************}
procedure strip(acts: PAct; syns: PSyn);
var i, o, p: word; temp1: PChar;
 dsyns: PSyn;
begin
 while acts^.asmLn[iid] <> '%' do iid := iid+1; iid := iid+1;
 dsyns := syns; for p := 1 to vala(acts^.asmLn+iid) do  dsyns := dsyns^.nextSyntax;
 getMem(temp1, strLen(dsyns^.synVal)+1); o := 0; i := 0;
 while strScan(dsyns^.synVal+i, '"') <> nil do
 begin while dsyns^.synVal[i] <> '"' do
  begin temp1[o] := dsyns^.synVal[i]; o := o+1; i := i+1;
 end; i := i+1; end;
 temp1[o] := #0; i := strLen(dsyns^.synVal);
 freeMem(dsyns^.synVal, i); getMem(dsyns^.synVal, strLen(temp1));
 strCopy(dsyns^.synVal, temp1); freeMem(temp1, i);
end;

{**************************************************************************}
procedure localVars(acts: PAct; syns: PSyn);
var i, ii: word; actLn, temp1, temp2, place: PChar;
 space, preSpace: word; diraVar: PVar; save: char;
 tempDira: PVar;
begin
 diraVar := momVars;
 while diraVar^.nextVar <> nil do
  diraVar := diraVar^.nextVar;
 tempDira := diraVar;
 new(diraVar^.varDira); diraVar := diraVar^.varDira; diraVar^.varVal := nil;
 diraVar^.varType := nil; diraVar^.varDira := nil; diraVar^.nextVar := nil;
 actLn := replaceSyn(acts^.asmLn, syns); i := 2; space := 4;
 while actLn[i] <> '"' do i := i+1; place := actLn+i; actLn[i-1] := #0;
 ii := 2; i := 1; temp1 := actLn+i+1; if strComp(temp1, '') = 0 then
 begin writeln(outCode, '%define .retSpc 0'); exit; end;

 while actLn[i] <> #0 do
 begin
  i := i+1; while actLn[i] = ' ' do i := i+1; temp1 := actLn+i;
  while actLn[i] <> place[ii] do i := i+1; actLn[i] := #0;
  case place[ii-1] of
   't':
   begin
{    temp1 := temp1-1; save := temp1[0]; }{temp1[0] := ' ';}
    preSpace := space+determineSize(temp1);
    getMem(diraVar^.varType, strLen(temp1)+1); strCopy(diraVar^.varType, temp1);
    temp1[0] := save;
   end;
   'n':
   begin
    getMem(temp2, strLen(temp1)+2); strCopy(temp2, temp1);
    getMem(diraVar^.varVal, strLen(temp1)+1); strCopy(diraVar^.varVal, temp1);
   end;
  end;
  actLn[i] := place[ii];
  if place[ii+1] = '"' then
  begin
   ii := 2; {writeLn(outCode, '%define ._', strPas(temp2), ' bp+', stra(space));}
   freeMem(temp2, strLen(temp2)); space := preSpace;
   new(diraVar^.nextVar); diraVar := diraVar^.nextVar; diraVar^.varVal := nil;
   diraVar^.varType := nil; diraVar^.varDira := nil; diraVar^.nextVar := nil;
  end else ii := ii+2;
 end;
 preSpace := space-4; diraVar := tempDira^.varDira;
 while diraVar^.nextVar <> nil do
 begin
  writeLn(outCode, '%define .', strPas(diraVar^.varVal), ' bp+', stra(preSpace));
  preSpace := preSpace-determineSize(diraVar^.varType);
  diraVar := diraVar^.nextVar;
 end;
 writeln(outCode, '%define .retSpc ', stra(space-4));
end;

{**************************************************************************}
procedure codePrep(acts: PAct; syns: PSyn);
var place, temp1, actLn: PChar; i, ii, p: word;
 dsyn: PSyn; dvar: PVar; ending: boolean; save: char;
begin
 actLn := replaceSyn(acts^.asmLn, syns); i := 2; dsyn := syns;
 actLn[2] := #0; for p := 1 to vala(actLn+1) do dsyn := dsyn^.nextSyntax;
 actLn[2] := ' '; dvar := momVars; ending := false;
 while strComp(dsyn^.synVal, dvar^.varVal) <> 0 do
  begin if dvar^.nextVar = nil then error(7); dvar := dvar^.nextVar; end;
 dvar := dvar^.varDira;
 i := strLen(actLn);
 while actLn[i] <> '"' do
  i := i-1;
 i := i-1;
 while actLn[i] <> '"' do
  i := i-1;
 place := actLn+i; actLn[i-1] := #0;
 ii := 2; i := 2; temp1 := actLn+i+1; if strComp(temp1, '') = 0 then exit;
 while actLn[i] <> #0 do
 begin
  i := i+1; while actLn[i]  = ' ' do i := i+1; temp1 := actLn+i;
  while ((actLn[i] <> place[ii]) AND (actLn[i] <> #0)) do i := i+1;
  if actLn[i] = #0 then ending := true else actLn[i] := #0;
  case place[ii-1] of
   'n':
   begin
    if ((strComp(temp1, 'byte')<>0) OR (strComp(temp1, 'word')<>0) OR
     (strComp(temp1, 'dword')<>0) OR (strComp(temp1, 'qword')<>0)) then
    begin
     {temp1 := temp1-1; save := temp1[0]; temp1[0] := '_';}
     dvar := findVar(temp1); {temp1[0] := save;}
     p := determineSize(dvar^.varType);
    end else
    begin
     dvar := findVar(temp1); p := determineSize(dvar^.varType);
    end;
    case p of
     1: writeln(outCode, 'push byte ', strPas(temp1));
     2: writeln(outCode, 'push word ', strPas(temp1));
     4: writeln(outCode, 'push word ', strPas(temp1), #13#10, 'push ds');
     8: writeln(outCode, 'push byte ', strPas(temp1));
    end;
   end;
  end;
  if ending = false then actLn[i] := place[ii];
  if place[ii+2] = #0 then ii := 2 else ii := ii+2;
 end;
end;

{**************************************************************************}
procedure define(acts: PAct; syns: PSyn);
var i, ii: word; actLn: PChar; dtype: PTyp;
begin
 actLn := replaceSyn(acts^.asmLn, syns);
 dtype := momTypes; while dtype^.nextType <> nil do dtype := dtype^.nextType;
 new(dtype^.nextType);
 dtype := dtype^.nextType;
 i := 2;
 while ((actLn[i] <> ' ') AND (ischar(actLn[i]))) do i := i+1; if (actLn[i] <> ' ') then error(3);
 actLn[i] := #0; getMem(dtype^.newType, strLen(actLn+2)+1);
 strCopy(dtype^.newType, actLn+2); actLn[i] := ' '; i := i+1; ii := i;
 while (((actLn[i] <> ' ') OR (actLn[i] <> #0)) AND (ischar(actLn[i]))) do i := i+1;
 if ((strComp(actLn+ii, '_byte')=0) OR (strComp(actLn+ii, '_word')=0) OR
  (strComp(actLn+ii, '_dword')=0) OR (strComp(actLn+ii, '_qword')=0)) then
  ii:= ii+1;
 if (actLn[i] <> ' ') AND (actLn[i] <> #0) then error(3);
 actLn[i] := #0; getMem(dtype^.prevType, strLen(actLn+ii)+1);
 determineSize(actLn+ii);
 strCopy(dtype^.prevType, actLn+ii);
 dtype^.nextType := nil;
end;

{**************************************************************************}
function determineSize(typed: PChar): byte;
var ddefs: PTyp;
 preOut: byte;
begin
 preOut := 0;
 if ((strcomp(typed, '') = 0) OR (typed = nil)) then error(7);
 if strcomp(typed, 'byte') = 0 then preOut := 1;
 if strcomp(typed, 'word') = 0 then preOut := 2;
 if strcomp(typed, 'dword') = 0 then preOut := 4;
 if strcomp(typed, 'qword') = 0 then preOut := 8;
 while preOut = 0 do
 begin
  ddefs := momTypes;
  while ((ddefs <> nil) AND (strcomp(typed, ddefs^.newType) <> 0) ) do
   ddefs := ddefs^.nextType;
  if ddefs <> nil then
  begin
   {Let's see if it's a length type or...}
   preOut := vala(typed);
   {...or if it's a basic type}
   if strcomp(ddefs^.prevType, 'byte') = 0 then preOut := 1;
   if strcomp(ddefs^.prevType, 'word') = 0 then preOut := 2;
   if strcomp(ddefs^.prevType, 'dword') = 0 then preOut := 4;
   if strcomp(ddefs^.prevType, 'qword') = 0 then preOut := 8;
   {if not, go around again}
   typed := ddefs^.prevType;
  end else error(6);
 end;
 determineSize := preOut;
end;

{**************************************************************************}
function findVar(inName: PChar): PVar;
var dvar: PVar;
begin
 dvar := momVars;
 while ((dvar <> nil) AND (strComp(dvar^.varVal, inName) <> 0)) do
  dvar := dvar^.nextVar;
 if dvar = nil then error(7);
 findVar := dvar;
end;

{**************************************************************************}
procedure stringalize(acts: PAct; syns: PSyn);
var i, ii, o: word; temp1, temp2: PChar; dsyn: PSyn; aa1: string;
 dvar: PVar;
begin
 {actLn := replaceSyn(acts^.asmLn, syns); i := 2;}
 i := 0; while acts^.asmLn[i] = ' ' do i := i+1; i := i+3;
 getMem(temp1, 255); o := 0;
 if acts^.asmLn[i] <> '%' then error(8); dsyn := syns;
 for ii := 1 to vala(acts^.asmLn+i+1) do dsyn := dsyn^.nextSyntax; ii := 0;
 while dsyn^.synVal[ii] <> #0 do
 begin
  while ((dsyn^.synVal[ii] <> '"') AND (dsyn^.synVal[ii] <> #0)) do
  begin temp1[o] := dsyn^.synVal[ii]; ii := ii+1; o := o+1; end; if dsyn^.synVal[ii] = #0 then break;
  i := ii; ii := ii+1; while ((dsyn^.synVal[ii] <> '"') AND (dsyn^.synVal[ii] <> #0)) do ii := ii+1;
  if dsyn^.synVal[ii] = #0 then error(9);
  aa1 := '$s' + stra(strNum)+ '$';
  write(outData, '$s', stra(strNum), '$: db ');
  i := i+1; dsyn^.synVal[ii] := #0;
  writeln(outData, '"', strPas(dsyn^.synVal+i), '", "$"');
  dsyn^.synVal[ii] := '"'; ii := ii+1;
  getMem(temp2, length(aa1)); strPCopy(temp2, aa1);
  dvar := momVars;
  while dvar^.nextVar <> nil do
   dvar := dvar^.nextVar;
  new(dvar^.nextVar); dvar := dvar^.nextVar; dvar^.nextVar := nil;
  getMem(dvar^.varVal, strLen(temp2)+1);
  strCopy(dvar^.varVal, temp2);
  getMem(dvar^.varType, 5);
  strPCopy(dvar^.varType, 'dword');
  strCat(temp1, temp2); freeMem(temp2, length(aa1));
  o := o+length(aa1); strNum := strNum+1;
 end;
 freeMem(dsyn^.synVal, strLen(dsyn^.synVal));
 getMem(dsyn^.synVal, strLen(temp1));
 strCopy(dsyn^.synVal, temp1);
 freeMem(temp1, 255);
end;

{**************************************************************************}
procedure evaulate(acts: PAct; syns: PSyn);
var actLn, tmpLn: PChar; i, ii, p, o: word;
 swich, stick, max: byte;
var parseDef, def: PDef; last: PChar;
 currSyn: PSyn; regFlag: PChar;
begin
 getMem(tmpLn, 255); tmpLn[0] := #0; getMem(regFlag, 2);
 regFlag[0] := currReg[0]; regFlag[1] := #0;
 actLn := replaceSyn(acts^.asmLn, syns); i := 2; stick := 0; max := 0;
 for p := 2 to strLen(actLn) do
 begin
  if actLn[p] = '(' then stick := stick +1;
  if actLn[p] = ')' then stick := stick -1;
  if stick > max then max := stick;
 end;
 if stick <> 0 then error(10); i := 2;
 for p := max downto 1 do
 begin
  stick := 0; i := 2; regFlag[0] := 'a';
  while {((stick <> p) AND }(i <> strLen(actLn)) do
  begin
   if actLn[i] = '(' then stick := stick +1;
   if actLn[i] = ')' then stick := stick -1;
   i := i+1;
   if stick = p then
   begin
    ii := i; while actLn[ii] = ' ' do ii := ii+1;
    o := ii; while actLn[o] <> ')' do o := o+1;
    if actLn[o-1] = ' ' then
    begin
     while actLn[o-1] = ' ' do o := o-1; actLn[o] := #0;
     strCat(tmpLn, regFlag);
     strCat(tmpLn, actLn+ii);
     actLn[o] := ' ';
    end else
    begin
     actLn[o] := #0;
     strCat(tmpLn, regFlag);
     strCat(tmpLn, actLn+ii);
     actLn[o] := ')';
    end;
    tmpLn[strLen(tmpLn)+1] := #0; tmpLn[strLen(tmpLn)] := #13;
    for ii := i-1 to o do actLn[ii] := ' '; i := o; stick := stick -1;
    {actLn[i-2] := '_'; actLn[i-1] := 'a'; actLn[i] := 'x';}
    regFlag[0] := 'b';
   end;
  end;
 end;
 parseDef := globalDef;
 while strScan(tmpLn, #13) <> nil do
 begin
  last := strScan(tmpLn, #13);
  last^ := #0;
  new(def);
  if tmpLn[0] = 'a' then currReg := 'ax' else currReg := 'bx';
  currSyn := checkSyntax(tmpLn+1, parseDef, def);
  handleAct(def^.nextDef, currSyn);
  dispose(def);
  destroySyn(currSyn);
  last^ := #13; tmpLn := last+1;

 end;
 currReg := 'ax';
end;

{**************************************************************************}
procedure evalOne(acts:PAct; syns: PSyn);
var actLn: PChar;
 i: word;
begin
 actLn := replaceSyn(acts^.asmLn, syns);
 i := 2; while actLn[i] = ' ' do i := i+1; if actLn[i] = '(' then
  evaulate(acts, syns) else
 begin
  actLn[strLen(actLn)] := #13;
  actLn[strLen(actLn)] := #0;
  processLine(actLn+i);
 end;
end;