cmddrv.pas

Draak is a multi-language, macro compiler, meaning all syntax and code generation is defined in a si

  end;
  tempPoint := dumbParse.point;
  dumbNode := new(PHashAtom);
  dumbNode.next := inMacro.next;
  dumbNode.Macro := PChar(Copy(inMacro.Macro, 0, length(inMacro.macro)));
  p := strToInt(inMacro.Macro[AnsiPos('%', inMacro.Macro)])-1-length(PLocal(local.Peek).returns);
  for i := strToInt(inMacro.Macro[AnsiPos('%', inMacro.Macro)])-1 to length(inNode.children)-1 do
  begin
    dumbParse := inNode.children[i];
    if dumbParse = nil then break;
    if dumbParse.point.name <> tempPoint.name then break;
    dumbNode.next := inMacro.next.next;
    dumbNode.Macro := inMacro.next.Macro;
    while dumbNode <> nil do
    begin
      if giantError = true then exit;
      if (dumbNode.Macro[0] = '!') AND (dumbNode.Macro[1] = 'F') then
        break;
      d := dumbNode.Macro;
      o := AnsiPos('%n', d);
      if o <> 0 then
      begin
        delete(d, o+1, 1);
        insert(intToStr(i+1), d, o+1);
      end;
      o := AnsiPos('$n', d);
      while o <> 0 do
      begin
        delete(d, o+1, 1);
        insert(intToStr(i+1+p), d, o+1);
        o := AnsiPos('$n', d);
      end;
      dumbNode.Macro := PChar(d);
      case dumbNode.Macro[0] of
       '!': cmd(dumbNode, inNode);
       '@': if cmdExec = true then varcmd(dumbNode, inNode);
       '+': if cmdExec = true then outCode.Append(line(dumbNode, inNode));
       '*': if cmdExec = true then outData.Append(line(dumbNode, inNode));
       else
        err.err('Bad macro! ' + dumbNode.macro);
      end;
      dumbNode.Macro := dumbNode.next.Macro;
      dumbNode.next := dumbNode.next.next;
    end;
  end;
  skipAhead := dumbNode;
end;

procedure TMacro.varAdd(s: string; inNode: PParseNode);
var name, typ, context, temp: string;
 dumbNode: PHashAtom; dumbHash: PVarNode;
 current: PLocal;
 dumbContext: TVars;
 i, o: word; a: strArr;
begin
  temp := expand(s);
  split(temp, a); name := a[0]; typ := a[1];
  if length(a) > 2 then context := a[2] else context := 'a';
  if vars.hashLookup(name, 1) <> nil then
  begin
    err.err('Variable '+name+' already defined in current context');
    exit;
  end;
  dumbContext := vars;
  i := AnsiPos(context[1], numbers);
  for o := 1 to i do
    dumbContext := dumbContext.pop;
  dumbContext.addVar(name, typ);
  dumbHash := vars.hashLookup(name);
  if (dumbHash = nil) OR (dumbHash.typePtr = nil) then exit;
  dumbNode := dumbHash.typePtr.Decl;
  current := local.Push(new(PLocal));
  current.lvar := dumbHash.typePtr.local;
  setLength(current.returns, 2);
  current.returns[0] := name;
  current.returns[1] := typ;
  execNode(dumbNode, inNode);
  dumbHash.local := current.lvar;
  local.Pop;
end;


procedure TMacro.varAltAdd(s: string; inNode: PParseNode);
var name, typ, context, temp: string;
 dumbNode: PHashAtom; dumbHash: PVarNode;
 current: PLocal;
 dumbContext: TVars;
 i, o: word; a: strArr;
begin
  temp := expand(s);
  split(temp, a); name := a[0]; typ := a[1];
  if length(a) > 2 then context := a[2] else context := 'a';
  if vars.hashLookup(name, 1) <> nil then
  begin
    err.err('Variable '+name+' already defined in current context');
    exit;
  end;
  dumbContext := vars;
  i := AnsiPos(context[1], numbers);
  for o := 1 to i do
    dumbContext := dumbContext.pop;
  dumbContext.addVar(name, typ);
  dumbHash := vars.hashLookup(name);
  if (dumbHash = nil) OR (dumbHash.typePtr = nil) then exit;
  dumbNode := dumbHash.typePtr.altDecl;
  current := local.Push(new(PLocal));
  current.lvar := dumbHash.typePtr.local;
  setLength(current.returns, 2);
  current.returns[0] := name;
  current.returns[1] := typ;
  execNode(dumbNode, inNode);
  dumbHash.local := current.lvar;
  local.Pop;
end;

procedure TMacro.lhs(inMacro: PHashAtom; inNode: PParseNode);
var s, name: string;
  d: strArr;
  dumbNode, varNode: PVarNode;
  current: PLocal; i: word;
begin
  s := inMacro.Macro+1; s := expand(s);
  split(s, d);
  name := d[1];
  dumbNode := vars.hashLookup(name);
  if dumbNode = nil then
    Raise EDraakNoCompile.Create('No such type/var: '+name+' (LHS)');
  varNode := dumbNode;
  if dumbNode.isvar = true then
    dumbNode := dumbNode.typePtr;
  current := local.Push(new(PLocal));
  setLength(current.returns, 2);
  current.lvar := varNode.local;
  current.returns[0] := name;
  if length(d) > 3 then current.returns[1] := d[2];
  for i := 3 to length(d)-1 do
    current.returns[1] := current.returns[1]+' '+d[i];
  execNode(dumbNode.LHS, inNode);
  varNode.local := current.lvar; {!!!}
  local.Pop;
end;

procedure TMacro.rhs(inMacro: PHashAtom; inNode: PParseNode);
var s, name: string;
  d: strArr;
  dumbNode, varNode: PVarNode;
  current: PLocal; i: word;
begin
  s := inMacro.Macro+1; s := expand(s);
  split(s, d);
  name := d[1];
  dumbNode := vars.hashLookup(name);
  if dumbNode = nil then
    Raise EDraakNoCompile.Create('No such type/var: '+name+' (RHS)');
  varNode := dumbNode;
  if dumbNode.isvar = true then
    dumbNode := dumbNode.typePtr;
  current := local.Push(new(PLocal));
  setLength(current.returns, 2);
  current.lvar := varNode.local;
  current.returns[0] := name;
  if length(d) > 2 then current.returns[1] := d[2];
  for i := 3 to length(d)-1 do
    current.returns[1] := current.returns[1]+' '+d[i];  
  execNode(dumbNode.RHS, inNode);
  varNode.local := current.lvar;
  local.Pop;
end;

procedure TMacro.alt(inMacro: PHashAtom; inNode: PParseNode);
var s, name: string;
  d: strArr;
  dumbNode, varNode: PVarNode;
  current: PLocal; i: word;
begin
  s := inMacro.Macro+1; s := expand(s);
  split(s, d);
  name := d[1];
  dumbNode := vars.hashLookup(name);
  if dumbNode = nil then
    Raise EDraakNoCompile.Create('No such type/var: '+name+' (ALT)');
  varNode := dumbNode;
  if dumbNode.isvar = true then
    dumbNode := dumbNode.typePtr;
  current := local.Push(new(PLocal));
  setLength(current.returns, 2);
  current.lvar := varNode.local;
  current.returns[0] := name;
  if length(d) > 2 then current.returns[1] := d[2];
  for i := 3 to length(d)-1 do
    current.returns[1] := current.returns[1]+' '+d[i];
  for i := 0 to length(dumbNode.ALT)-1 do
  begin
    if i = length(dumbNode.ALT)-1 then
      execNode(dumbNode.ALT[i].next, inNode)
    else if current.returns[1] = dumbNode.ALT[i].Macro then
      begin execNode(dumbNode.ALT[i].next, inNode); break; end;
  end;
//  execNode(dumbNode.ALT, inNode);
  varNode.local := current.lvar;
  local.Pop;
end;

procedure TMacro.extractType(inMacro: PHashAtom; inNode: PParseNode);
var s: string; d: strArr;
  dumbNode: PVarNode;
  ret: string; i: int64;
  r: extended; sn: single; db: double;
begin
  s := expand(inMacro.Macro); split(s, d);
  dumbNode := vars.hashLookup(d[1]); i := 0;
  if dumbNode = nil then
  begin
    {Basic Types}
    if d[1][1] = '$' then ret := d[1]
    else
    {Strings}
    try
      i := StrToInt64(d[1]);
    except
      on EConvertError do
      begin
        try
          r := StrToFloat(d[1]);
          sn := StrToFloat(d[1]); db := StrToFloat(d[1]);
          if r = sn then ret := '$r4'
          else if db = r then ret := '$r8'
          else ret := '$r10';
          saveReturn(ret);
          exit;
        except
          on EConvertError do
            Raise EDraakNoCompile.Create('Incorrect type assertion.');
        end;
      end;
    end;
    case i of
      0..255:              ret := '$u1';
      256..65535:          ret := '$u2';
      65536..2147483647:   ret := '$u4';
      -128..-1:            ret := '$s1';
      -32768..-129:        ret := '$s2';
      -2147483648..-32769: ret := '$s4';
      else ret := '$s8';
    end;
  end else
    if dumbNode.isvar = false then
      ret := dumbNode.baseType
    else
      ret := dumbNode.typePtr.name;
  if length(d) > 2 then
    varHash.add(d[2], ret)
  else
    saveReturn(ret);
end;

procedure TMacro.whileLoop(inMacro: PHashAtom; inNode: PParseNode);
begin
  if whilePlace = nil then
    whilePlace := inMacro
  else
  begin
    compare(inMacro, inNode);
    if PLocal(local.Peek).truth = Equal then
      whilePlace := nil
    else
      skipAhead := whilePlace;
  end;
end;

procedure TMacro.compare(inMacro: PHashAtom; inNode: PParseNode);
var d: strArr;

  procedure n;
  begin
    d[2] := expand(d[2]); d[3] := expand(d[3]);
    if d[2] = d[3] then
      PLocal(local.Peek).truth := Equal
    else
      PLocal(local.Peek).truth := notEqual;
  end;

  procedure v;
  var dumbVar: PVarNode;
  begin
    d[2] := expand(d[2]);
    dumbVar := vars.hashLookup(d[2]);
    if dumbVar = nil then
      PLocal(local.Peek).truth := Nonexists
    else if dumbVar.isvar = true then
      PLocal(local.Peek).truth := Exists
    else
      PLocal(local.Peek).truth := Nonexists
  end;

  procedure bigN;
  var i, o: int64;
  begin
    d[2] := expand(d[2]);
    d[3] := expand(d[3]);
    try
      i := StrToInt64(d[2]);
      o := StrToInt64(d[3]);
    except
      on EConvertError do
      begin
        PLocal(local.Peek).truth := Nonexists;
	      exit;
      end;
    end;
    if i > o then PLocal(local.Peek).truth := greater;
    if i < o then PLocal(local.Peek).truth := less;
    if i = o then PLocal(local.Peek).truth := equal;
  end;

begin
  split(inMacro.Macro, d, 4);
  case d[1][1] of
    'e': partialCompare(inMacro, inNode);
    'E': compareEquiv(inMacro, inNode);
    'n': n;
    'N': bigN;
    'v': v;
   else err.err('Bad compare usage: '+d[1]);
  end;
end;

procedure TMacro.compareEquiv(inMacro: PHashAtom; inNode: PParseNode);
var s1, s2, d: strArr;
 i: word;
begin
  split(inMacro.Macro, d);
  split(expand(d[2]), s1);
  split(expand(d[3]), s2);
  if length(s1) <> length(s2) then
  begin
    PLocal(local.Peek).truth := notEqual;
    exit;
  end;
  if length(s1) = 0 then
  begin
    PLocal(local.Peek).truth := Equal;
    exit;
  end;
  for i := 0 to length(s1)-1 do
  begin
    if vars.isEquiv(s1[i], s2[i]) = false then
    begin
      PLocal(local.Peek).truth := notEqual;
      exit;
    end;
  end;
  PLocal(local.Peek).truth := Equal;
end;

procedure TMacro.partialCompare(inMacro: PHashAtom; inNode: PParseNode);
var s1, s2, d: strArr;
  current: PLocal; i: word;
begin
  split(inMacro.Macro, d);
  split(expand(d[2]), s1);
  split(expand(d[3]), s2);
  current := local.peek;
  setLength(current.returns, length(current.returns)+1);
  if length(s1) = 0 then
  begin
    PLocal(local.Peek).truth := notEqual;
    exit;
  end;