preprocess.dpr

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

library preprocess;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
{  ShareMem,}
  SysUtils,
  Classes; 

{$R *.res}

var inFs: array of record
    f: TFileStream;
    comment: word;
    str: boolean;
    buffer: array[0..1] of char;
  end;

function init(f: PChar): integer; stdcall;
var i: cardinal;
begin
  i := length(inFs);
  setLength(inFs, i+1);
  inFs[i].f := TFileStream.Create(f, fmOpenRead);
  inFs[i].comment := 0;
  inFs[i].str := false;
  inFs[i].buffer[0] := #0;
  inFs[i].buffer[1] := #0;
  result := i;
end;

function readChar(f: integer): char; stdcall;
var accept: boolean; i: integer;

function consume: char;
begin
  result := inFs[f].buffer[0];
  inFs[f].buffer[0] := inFs[f].buffer[1];
  inFs[f].buffer[1] := #0;
end;

procedure findChar(ch: char);
begin
  while inFs[f].buffer[1] <> ch do
  begin
    i := inFs[f].f.Read(inFs[f].buffer[1], 1);
    if i = 0 then exit;
  end;
end;

begin
  with inFs[f] do
  begin
    accept := false; result := #0;
    while accept = false do
    begin
      i := 1; result := #0;
      if buffer[0] = #0 then
        i := f.Read(buffer[0], 1);
      if i = 0 then exit;
      if buffer[1] = #0 then
        i := f.Read(buffer[1], 1);
      if i = 0 then exit;
      case buffer[0] of
       '{': inc(comment);
       '}': if comment > 0 then dec(comment);
       '(': if buffer[1] = '*' then
        begin
          consume; inc(comment);
        end else accept := true;
        '*': if buffer[1] = ')' then
         begin
           consume; if comment > 0 then dec(comment);
         end else accept := true;
        '/': if buffer[1] = '/' then
         begin
           findChar(#10); consume;
         end else accept := true;
        '''':
         begin
           findChar(''''); consume;
         end;
        else if comment = 0 then accept := true;
      end;
      result := consume;
    end;
//    result := consume;
  end;
end;

{$ifdef A}
var i: cardinal;
  accept: boolean;
  lookahead: boolean; buff: char;
procedure tryaccept;
begin
  if inFs[f].comment > 0 then begin lookahead := false; exit; end;
  if lookahead = true then
  begin
    inFs[f].buffer := result;
    result := buff;
    lookahead := false;
  end else
    inFs[f].buffer := #0;
  accept := true;
end;

begin
  if inFs[f].buffer <> #0 then
  begin
    result := inFs[f].buffer;
    inFs[f].buffer := #0;
    exit;
  end;
  accept := false; lookahead := false; buff := #1;
  while accept = false do
  begin
    i := inFs[f].f.Read(result, 1);
    if i = 0 then
    begin
      result := #0;
      exit;
    end;
    case result of
     '{': if inFs[f].str = true then tryaccept else inc(inFs[f].comment);
     '}': if inFs[f].str = true then tryaccept else if inFs[f].comment > 0
       then dec(inFs[f].comment) else tryaccept;
     '(': if inFs[f].str = true then tryaccept else
       begin lookAhead := true; buff := result; end;
     ')':
      begin
        if (lookahead = true) AND (buff = '*') AND (inFs[f].comment > 0) then
        begin
          dec(inFs[f].comment);
          lookahead := false;
          inFs[f].buffer := #0;
          buff := #0;
          continue;
        end;
        tryaccept;
        lookAhead := false;
      end;
     '*':
      begin
        if (lookahead = true) AND (buff = '(') then
        begin
          inc(inFs[f].comment);
          lookahead := false;
          inFs[f].buffer := #0;
          buff := #0;
          continue;
        end;
        if inFs[f].str = true then tryaccept else
          begin lookAhead := true; buff := result; end;
      end;
     '''':
      begin
        if inFs[f].comment > 0 then continue;
        if lookahead = true then
        begin
         inFs[f].buffer := result;
         result := buff;
         lookahead := false;
        end;
        inFs[f].str := not(inFs[f].str);
        accept := true;
      end;
     #0: continue;
     else
       tryaccept;
    end;
  end;
end;
{$endif}
procedure close(f: integer); stdcall;
begin
  inFs[f].f.Destroy;
end;

exports
  init, readChar, close;

begin
  setLength(inFs, 0);
end.