formula translation source listing


This is the Delphi-7 source code listing for formula translation.
Click to return to the article on formula translation.

unit xlate;
{   translate math function / equation into sequence of basic operations

    types recognized:
    1. y = ...x...              normal function
    2. x = ...y...              inverse function
    3. x = ...v...; y = ...v... parametric function
    4. ..x..y.. = ..x..y..      intrinsic function

    variables
    x, y, v, a, b, c, pi, e     (a,b,c:preset constants; pi,e:math constants

    functions
    sin,cos,tan,asin,acos,atan,sqrt,log,ln,exp,abs,int

    operators and priorities ....'(' increases priority by 10, ')' decreases
    function      7
    ^             6
    -             5   (unairy -)
    * /           4
    + -           3
    =             2
    ;             1

    multiply (*) insertion between
    )...(
    )...function   or   constant...function
    constant...(   or   )...constant
    variable...(   or   )...variable
    constant...variable   or     variable...constant

    postfixtable  [1..maxpostfix]
    -------------------------------------------
    |constant/  |
    |variable/  |
    |empty      |    operation  |  priority |
    -------------------------------------------

    operation = 0 for end of table

    directortable [1..maxdirtab]
    -------------------------------------------------------
    |operation  |  destination  |  source1   |  source2  |

    operation = 0 for end of table

    constantstable  [ 30..59]   .....[1..29] is scratch
    ct1   | constant1  |
    ct1+1 | constant2  |   etc.

    operatorcodes / functioncodes
    +    1
    -    2
    *    3
    /    4
    ^    5
    -    6   (unairy -)
    =    7
    ;    8
    sin  10  (function table starts at 10)
    cos  11
    tan  12
    asin 13
    acos 14
    atan 15
    sqrt 16
    log  17
    ln   18
    exp  19
    abs  20
    int  21

    registers in REG[ ] : double
     1..29  : scratch registers
    30..59  : constants
    60      : x
    61      : y
    62      : v
    63      : a
    64      : b
    65      : c
    66      : pi  (preset)
    67      : e   (preset)

 30-12-2011 : test eqdrawer type 1,2,3,4
  1-01-2012 : trifolium error, corrected line 699 freereg(r2) (was r1)
  2-01-2012 : version 1

}

interface

uses extctrls,sysutils,graphics,classes,math;

procedure XlateEquation(const s:string;var xcode:byte);//0:OK; <>0 error
function getEqType : byte;
procedure setconstant(a : char; d : double);//set constant 'a','b','c' to d
procedure calculate(var OK : boolean);
procedure setdebugmode(box:TPaintbox; f : boolean);
function getmessage(code : byte) : string;  //get message after translation
procedure setX(d : double);
procedure setY(d : double);
procedure setV(d : double);
function getX : double;
function getY : double;
function getV : double;

implementation

procedure clearbox;forward;
procedure showconstants;forward;
procedure showPFT;forward;
procedure showDRT;forward;

type TPostfix = record
                 reg      : byte;
                 opcode   : byte;
                 priority : byte;
                end;

     TDirector = record
                 opcode : byte;
                 dest : byte;
                 src1 : byte;
                 src2 : byte;
                end;

      Toperator = record
                   a : char;
                   priority : byte;
                  end;

const maxPFT     = 60;
      maxDRT     = 60;
      maxreg     = 29; //registers 1..29 for scratch
      minconstant= 30;
      maxconstant= 59;
      varbias    = 60;
      maxprio    = 200;// 20*(

      functiontable : array[10..21] of string =  //index = code
        ('sin', 'cos', 'tan', 'asin', 'acos',
         'atan', 'sqrt', 'log', 'ln', 'exp',
         'abs', 'int');

      vartable : array[60..67] of string =       //REG[] is index + 60
                  ('x', 'y', 'v', 'a', 'b', 'c', 'pi', 'e');

  opcodetable  : array[1..8] of Toperator =     //index = operation code
                 ((a:'+' ; priority: 3),
                  (a:'-' ; priority: 3),
                  (a:'*' ; priority: 4),
                  (a:'/' ; priority: 4),
                  (a:'^' ; priority: 6),
                  (a:'-' ; priority: 5),   //unairy (-)
                  (a:'=' ; priority: 2),
                  (a:';' ; priority: 1));

   errormessage : array[0..13] of string =
                  ('OK',                             //0
                   'formula too long',               //1
                   'unknown equation type',          //2
                   'unknown character',              //3
                   'too many ..((..',                //4
                   'too many ..))..',                //5
                   'too many operators',             //6 , postfix table full
                   'syntax error',                   //7
                   '..(( .. )).. mismatch',          //8
                   'wrong number:',                  //9
                   'too many constants',             //10
                   'unrecognized string:',           //11
                   'too many intermediate results',  //12
                   'equation too long');             //13

var debugmode : boolean = false; //write info to paintbox if true
    debugbox  : Tpaintbox = nil;

    PFT       : array[1..maxPFT] of TPostFix;
    pfti      : byte;//#entries in PFT
    DRT       : array[1..maxDRT] of Tdirector;
    dix       : byte;//index for DRT during calculations
    valid     : boolean;//during calculations
    DRTtop    : byte; //#entries in DRT
    REG       : array[1..67] of double;
    csi       : byte;

    eqtype    : byte = 0; //1,2,3,4 type of equation
    basetext  : string;
    errorcode : byte = 0;
    extramessage : string; //attached to errorcode string

    dln10     : double;

procedure DetectType;  //find type of equation
type Ts = (tx,ty,teq,tpc,tblank,telse);//x y = ;
var n,p : byte;
    ns : Ts;
    cp : array[tx..tpc,1..255] of byte; //cp: char position
    cc : array[tx..tpc] of byte;           //cc: char count
begin
 for ns := tx to tpc do cc[ns] := 0;
 p := 1;                           //char position minus blanks
 for n := 1 to length(basetext) do //mark positions of x y = ;   skip blanks
  begin                            //p counts char position minus blanks
   case basetext[n] of
    'x' : ns := tx;
    'y' : ns := ty;
    '=' : ns := teq;
    ';' : ns := tpc;
    ' ' : ns := tblank;
    else ns := telse;
   end;//case
   case ns of
    tx,ty,teq,tpc : begin
                      inc(cc[ns]);
                      cp[ns,cc[ns]] := p;
                      inc(p);
                     end;
             telse : inc(p);
   end;//case
  end;//for n

//test for type 1

 if (cc[ty]=1) and (cp[ty,1]=1) and (cc[teq]=1) and (cp[teq,1]=2) and
    (cc[tpc]=0) then begin
                      eqtype := 1;
                      exit;
                     end;
//test for type 2

 if (cc[tx]=1) and (cp[tx,1]=1) and (cc[teq]=1) and (cp[teq,1]=2) and
    (cc[tpc]=0) then begin
                      eqtype := 2;
                      exit;
                     end;
//test for type 3

 if (cc[tx]=1) and (cc[ty]=1) and (cc[tpc]=1) and (cc[teq]=2) then
  begin
   if ((cp[ty,1]=1) and (cp[teq,1]=2) and (cp[tpc,1]+1=cp[tx,1]) and
       (cp[tx,1]+1=cp[teq,2])) or
      ((cp[tx,1]=1) and (cp[teq,1]=2) and (cp[tpc,1]+1=cp[ty,1]) and
       (cp[ty,1]+1=cp[teq,2])) then begin
                                     eqtype := 3;
                                     exit;
                                    end;
  end;

//test for type 4

 if (cc[tpc]=0) and (cc[teq]=1) then eqtype := 4;
end;

procedure makePFT;
//make postfix table , put constants in regs
type Tscan = (scNone,scAlphaScan,scNumScan,scConstant,scVariable,scFunction,
              scOperator,scOpen,scClose);  //type of scan , element found
var i : byte;  //address characters in formula string
    scan : Tscan;
    biasprio : byte;   //priority
    c : char;
    s : string;    //interim string

//---------

 procedure nextpft;
  begin
   if PFTi < maxPFT then inc(pfti)
    else errorcode := 6;
  end;

//----------

  procedure procAlpha;
  //analyse + process alpha string. May be function or variable
  var i : byte;
      vhit : boolean;
      fhit : boolean;
  begin
   i := 60;
   vhit := false;
   fhit := false;
   while (i < 68) and (vhit=false) do
    if vartable[i] = s then
     begin
      vhit := true;
      PFT[pfti].reg := i;
     end else inc(i);
   if vhit then scan := scVariable
    else
     begin
      i := 10;
      while (i < 22) and (fhit = false) do
       if functiontable[i] = s then
        begin
         fhit := true;
         PFT[pfti].opcode := i;
         PFT[pfti].priority := biasprio + 7;
         nextPFT;
        end else inc(i);
      if fhit then scan := scFunction
       else begin
             errorcode := 11;//syntax error;
             extramessage := s;
            end;
     end;//if vhit
  end;

//---------

  procedure procNum;
  //analyse + process numeric string
  var d : double;
  begin
   try
    d := strtofloat(s);
    if csi <= maxconstant then
     begin
      REG[csi] := d;
      PFT[pfti].reg := csi;
      inc(csi);            //point to next register
     end
     else begin
           errorcode := 10;
           extramessage := s;
          end;
    scan := scConstant;
   except
    errorcode := 9;
    extramessage := s;
   end;
  end;

//-----------

  procedure procOperator;
  //analyse operator
  begin
   with PFT[pfti] do
    case c of
     '+' : begin
            opcode := 1;
            priority := 3 + biasprio;
           end;
     '-' : begin
            opcode := 2;
            priority := 3 + biasprio;
           end;
     '*' : begin
            opcode :=3 ;
            priority := 4 + biasprio;
           end;
     '/' : begin
            opcode := 4;
            priority := 4 + biasprio;
           end;
     '^' : begin
            opcode := 5;
            priority := 6 + biasprio;
           end;
     '=' : begin
            opcode := 7;
            priority := 2;
           end;
     ';' : begin
            opcode := 8;
            priority := 1;
           end;
    end;//case
   nextPFT;
   scan := scOperator;
  end;

  procedure procUminus;
  //unairy - operator
  begin
   with PFT[pfti] do
    begin
     opcode := 6;
     priority := 5 + biasprio;
    end;
   nextPFT;
   scan := scOperator;
  end;

  procedure procIsType4;
  //'=' in type 4 equation
  begin
   with PFT[pfti] do
    begin
     opcode := 2;
     priority := 2
    end;
   nextPFT;
  end;

  procedure procopen;
  begin
   if biasprio < 200 then inc(biasprio,10)
    else errorcode := 4;
   scan := scOpen;
  end;

  procedure procClose;
  begin
   if biasprio >= 10 then dec(biasprio,10)
    else errorcode := 5;
   scan := scClose;
  end;

  procedure multInsert;
  begin
   with PFt[pfti] do
    begin
     opcode := 3;
     priority := biasprio + 4;
    end;
   nextPFT;
   scan := scOperator;
  end;

//--------------

begin
 for i := 1 to maxPFT do  //clear PFT
  with PFT[i] do
   begin
    reg := 0;
    opcode := 0;
    priority := 0;
   end;
 scan := scNone;
 biasprio := 0;
 s := '';
 pfti := 1;                //next free PFT entry
 csi := minconstant;       //first entry of constant
 if eqtype = 4 then
  with PFT[pfti] do begin  //insert v=
                     reg := 62; opcode := 7; priority := 1;
                     nextPFT;
                    end;

 for i := 1 to length(basetext) do
  begin
   c := basetext[i];
   case c of
    '(' : begin
           case scan of
            scNumScan : procNum;
            scAlphaScan : procAlpha;
           end;
           case scan of
            scClose,
            scVariable,
            scConstant : multinsert;
           end;//case
           procOpen;
          end;// '('

    ')' : begin
           case scan of
            scOpen,
            scOperator,
            scfunction : errorcode := 7;
            scNumScan  : procNum;
            scAlphaScan: procAlpha;
           end;//case
          procclose;
          end;//')'

    '=' : if biasprio <> 0 then errorcode := 8
           else
            begin
             case scan of
              scNone,
              scOpen,
              scfunction : errorcode := 7;
              scNumScan  : procNum;
              scAlphaScan: procAlpha;

             end;//case
             if (errorcode = 0) then
              if (eqtype = 4) then procIsType4
               else procOperator;
             scan := scNone;
            end;//else

   '-' :  begin
           case scan of
            scNumscan : procNum;
            scAlphascan : procAlpha;
           end;
           case scan of
            scNone,
            scOpen    : procUminus;
            scClose,
            scConstant,
            scVariable : procoperator;
            scOperator,
            scfunction : errorcode := 7;
           end;//case
          end;//'+','-'

    '+',
    '*',
    '/',
    '^' : begin
           case scan of
            scAlphascan : procAlpha;
            scNumScan  : procNum;
           end;
           case scan of
            scNone,     
            scOpen,
            scOperator,
            scfunction : errorcode := 7;//syntax error
           end;//case
           procOperator;
          end;//'= ...^ '

    ' ' : begin
           case scan of
            scNumScan  : procNum;
            scAlphaScan: procalpha;
           end;//case
          end;// ' '

    ';' : if biasprio <> 0 then errorcode := 7
           else
            begin
             case scan of
              scAlphascan : procAlpha;
              scNumScan  : procNum;
             end;
             case scan of
              scNone,
              scOpen,
              scOperator,
              scfunction : errorcode := 7;
             end;//case
             procOperator;
             scan := scNone;
            end;//else

    '0'..'9','.' :
          begin
           if scan = scAlphascan then procAlpha;
           if scan = scVariable then multinsert;
           case scan of
            scNone,
            scOpen,
            scOperator, 
            scClose    : s := c;
            scNumScan  : s := s + c;
            scConstant,
            scfunction : errorcode := 7;
           end;//case
          scan := scNumscan;
         end;//'0'..'9'

    'a'..'z' :
         begin
          if scan = scNumscan then procNum;
          case scan of
           scClose,
           scConstant : multinsert;
          end;
          case scan of
           scNone,
           scOpen,
           scOperator : s := c;
           scAlphaScan: s := s + c;
           scVariable,
           scfunction : errorcode := 7;
          end;//case
          scan := scAlphaScan;
         end;//'a'..'z'

    else begin
          errorcode := 3;
          extramessage := extramessage + c;
          exit;
         end;
   end;//case
  if errorcode <> 0 then exit;
  end;//for i
  
 if (scan = scOperator) or (scan = scFunction) then errorcode := 7
  else if biasprio <> 0 then errorcode := 8;//() mismatch
end;

procedure makeDRT;
//break down PFT and build director table
var i,drti : byte;
    r1,r2 : byte;        //source registers
    regcode : byte;      //|src2 0,1,2 | src1 0,1,2,3| none, 1..29, >=30, xyv
    maxprioline : byte;
    regreserve : longInt;//bit i set means register i is free

 function getfreereg : byte;
 //return free scratch register 1..29
 //set errorcode if no register is free
 var mask : longInt;
     hit : boolean;
 begin
  hit := false;
  result := 1;
  while (hit = false) and (result <= 29) do
   begin
    mask := 1 shl result;
    if mask and regReserve <> 0 then
     begin
      hit := true;
      regreserve := regreserve xor mask;
     end else inc(result);
   end;
  if hit = false then errorcode := 12;//too many intermediate results
 end;

 procedure freeReg(k : byte);
 //free scratch register k [1..29]
 begin
  regReserve := regreserve or (1 shl k);
 end;

 procedure shiftUpPFT(n : byte);
 //shift PFT (n+1) to n, (n+2) to (n=1) ...etc
 var k : byte;
 begin
  if pfti > 1 then for k := n to pfti-1 do PFT[k] := PFT[k+1];
  with PFT[pfti] do
   begin
    opcode := 0;
    priority := 0;
    reg := 0;
   end;
  if pfti > 1 then dec(pfti);
 end;

begin
 regreserve := $3ffffffe; //free regs 1..29
 for i := 1 to maxDRT do
  with DRT[i] do          //clear DRT
   begin
    opcode := 0;
    dest   := 0;
    src1   := 0;
    src2   := 0;
   end;
 drti := 0;

 while (errorcode = 0) and (PFT[1].opcode <> 0) do
  begin
   inc(drti);
   if drti > maxDRT then
    begin
     errorcode := 13;
     exit;
    end;

   i:= 2; maxprioline := 1;
   while (PFT[i].opcode > 0) do    //find line with highest priority
    begin
     if (PFT[i].priority > PFT[maxprioline].priority) then maxprioline := i;
     inc(i);
    end;
   with DRT[drti] do
    begin
     opcode := PFT[maxprioline].opcode;
     r1 := PFT[maxprioline].reg;
     r2 := PFT[maxprioline+1].reg;
     regcode := 0;
     case r1 of
      1..29  : regcode := 1; //scratch register
      30..59,
      63..67 : regcode := 2; //constant
               //detect transfer to x,y,v = regcode 3
      60..62 : if opcode = 7 then regcode := 3 else regcode := 2; //variable
     end;
     case r2 of
       1..29 : regcode := regcode or $10; //scratch register
      30..67 : regcode := regcode or $20; //constant, variable
     end;
     case regcode of
      $00,
      $01,
      $02,
      $03 : errorcode := 7;
      $10,
      $12 : begin
             dest := r2;
             src1 := r1;
             src2 := r2;
            end;
      $11 : begin
             dest := r1;
             src1 := r1;
             src2 := r2;
             freereg(r2);
            end;
      $13 : begin
             dest := r1;
             src1 := 0;
             src2 := r2;
             freereg(r2);
            end;
      $20,
      $22 : begin
             dest := getfreereg;
             src1 := r1;
             src2 := r2;
            end;
      $21 : begin
             dest := r1;
             src1 := r1;
             src2 := r2;
            end;
      $23 : begin
             dest := r1;
             src1 := 0;
             src2 := r2;
            end;
     end;//case regcode

     shiftUpPFT(maxprioline);
     PFT[maxprioline].reg := dest; //set new destination
    end;//with DRT[drti]
  end;//while
 if errorcode = 0 then DRTtop := drti else DRTtop := 0;
end;

//--- calls ---

procedure XlateEquation(const s:string; var xcode:byte);
//build director table
//OK:xcode = 0
label end1;
begin
 if debugmode then clearbox;
 basetext := ansilowercase(s);
 extramessage := '';
 eqtype := 0;
 errorcode := 0;
 if length(basetext) > 250 then
  begin
   errorcode := 1; goto end1;
  end;
 basetext := basetext + ' ';//mark end to process all characters
 detecttype;
 if eqtype = 0 then
  begin
   errorcode := 2; goto end1;
  end;
 makePFT;
 if errorcode <> 0 then goto end1;
 if debugmode then begin
                    showconstants;
                    showPFT;
                   end; 
 makeDRT;
 if debugmode and (errorcode = 0) then showDRT;

end1:

 xcode := errorcode;
 if xcode <> 0 then eqtype := 0
  else extramessage := '(type='+inttostr(eqtype)+')'
end;

function getEqType : byte;
//return equationtype
//0: error; 1,2,3,4: OK
begin
 result := eqType;
end;

procedure setconstant(a : char; d : double);
//set constant 'a','b','c' to d
begin
 case a of
  'a' : REG[63] := d;
  'b' : REG[64] := d;
  'c' : REG[65] := d;
 end;//case
end;

//--- functions to calculate equations

  procedure Func1; //+
  begin
   with DRT[dix] do
    try
     reg[dest] := reg[src1] + reg[src2];
    except
     valid := false;
    end;
  end;

  procedure Func2; //-
  begin
   with DRT[dix] do
    try
     reg[dest] := reg[src1] - reg[src2];
    except
     valid := false;
    end;
  end;

  procedure Func3;//*
  begin
   with DRT[dix] do
    try
     reg[dest] := reg[src1] * reg[src2];
    except
     valid := false;
    end;
  end;

  procedure Func4; // /
  begin
   with DRT[dix] do
    try
     reg[dest] := reg[src1] / reg[src2];
    except
     valid := false;
    end;
  end;

  procedure Func5;    // ^
  var xx, x1, x2 : double;
  begin
   with DRT[dix] do
    try
      x1 := reg[src1]; x2 := reg[src2];
      if (frac(x2) = 0 ) and (x2 >= 0) and (x2 < 10) then
       begin
        xx := 1;
        while x2 > 0 do begin
                         x2 := x2 -1;
                         xx := xx * x1;
                        end;
        reg[dest] := xx;
       end
       else reg[dest] := exp(x2 * ln(x1));
    except
     valid := false;
    end;
  end;

  procedure Func6; // unairy -
  begin
   with DRT[dix] do
    try
     reg[dest] := -reg[src2];
    except
     valid := false;
    end;
  end;

  procedure Func7;//move
  begin
   with DRT[dix] do
    try
     reg[dest] := reg[src2];
    except
     valid := false;
    end;
  end;

  procedure func8;// ; nop
  begin end;

  procedure func9; //  n/u
  begin end;

  procedure Func10; //sin
  begin
   with DRT[dix] do
    try
     reg[dest] := sin(REG[src2]);
    except
     valid := false;
    end;
  end;

  procedure Func11; //cos
  begin
   with DRT[dix] do
    try
     reg[dest] := cos(reg[src2]);
    except
     valid := false;
    end;
  end;

  procedure Func12; //tan
  begin
   with DRT[dix] do
    try
     reg[dest] := tan(reg[src2]);
    except
     valid := false;
    end;
  end;

  procedure Func13; //asin
  var xx : double;
  begin
   with DRT[dix] do
    try
     xx := sqrt(1 - sqr(reg[src2]));
     reg[dest] := arctan(reg[src2] / xx);
    except
     valid := false;
    end;
  end;

  procedure Func14; //acos
  var xx : double;
  begin
   with DRT[dix] do
    try
     xx := sqrt(1 - sqr(reg[src2]));
     reg[dest] := arctan(xx / reg[src2]);
    except
     valid := false;
    end;
  end;

  procedure Func15; //atan
  begin
   with DRT[dix] do
    try
     reg[dest] := arctan(reg[src2]);
    except
     valid := false;
    end;
  end;

  procedure Func16; //sqrt
  begin
   with DRT[dix] do
    try
     reg[dest] := sqrt(reg[src2]);
    except
     valid := false;
    end;
  end;

  procedure Func17; //log
  begin
   with DRT[dix] do
    try
     reg[dest] := ln(reg[src2])*dln10;// = 1/ln(10)
    except
     valid := false;
    end;
  end;

  procedure Func18; //ln
  begin
   with DRT[dix] do
    try
     reg[dest] := ln(reg[src2]);
    except
     valid := false;
    end;
  end;

  procedure Func19; //exp
  begin
   with DRT[dix] do
    try
     reg[dest] := exp(reg[src2]);
    except
     valid := false;
    end;
  end;

  procedure Func20; //abs
  begin
   with DRT[dix] do
    try
     reg[dest] := abs(reg[src2]);
    except
     valid := false;
    end;
  end;

  procedure Func21;//integer part of number
  begin
   with DRT[dix] do
    try
     reg[dest] := round(reg[src2]);
    except
     valid := false;
    end;
  end;

procedure calculate(var OK : boolean);
const Func : array[1..21] of procedure =  //functions listed by opcode
             (func1,func2,func3,func4,func5,func6,func7,func8,
              func9,func10,func11,func12,func13,func14,func15,
              func16,func17,func18,func19,func20,func21);

begin
 dix := 0;         //functions use dix to address DRT
 valid := true;    //functions set valid to false in case of arithmetic error
 while valid and (dix < DRTtop) do
  begin
   inc(dix);
   Func[DRT[dix].opcode];
  end;
 OK := valid;     // OK true if successfull calculation
end;

//--- debug ---

procedure clearbox;
begin
 with debugbox do with canvas do
  begin
   brush.style := bsSolid;
   brush.color := $e0f0f0;
   pen.Width := 1;
   pen.color := $000000;
   font.Name := 'arial';
   font.Color := $000000;
   font.Style := [];
   rectangle(0,0,width-1,height-1);
  end;
end;

procedure showconstants;
var x,y : word;
    i : byte;
begin
 with debugbox do with canvas do
  begin
   x := 5;
   y := 5;
   textout(x,y,'type = '+inttostr(eqtype));
   inc(y,20);
   textout(x,y,'constants');
   inc(y,20);
   i := minconstant;
   while i < csi do        //constants
    begin
     textout(x,y,inttostr(i)+':');
     textout(x+30,y, formatfloat('0.###',REG[i]));
     inc(y,20);
     inc(i);
    end;
  end;
end;

function regname(r: byte) : string;
//give name of register
begin
 case r of
  1..59  : result := '[' + inttostr(r) + ']';
  60..67 : result := vartable[r];
  else result := '';
 end;//case
end;

function opcodeName(c : byte) : string;
//give name of operator or function
begin
 case c of
  1..8   : result := opcodetable[c].a;
  10..21 : result := functiontable[c];
  else result := '';
 end;//case
end;

procedure showPFT;
var i : byte;
    x,y : word;
begin
 x := 150;
 y := 5;
 with debugbox do with canvas do
  begin
   textout(x,y,'postfixtable');
   inc(y,20);
   textout(x,y,'reg');
   textout(x+40,y,'operation');
   textout(x+120,y,'priority');
   for i := 1 to pfti do
    with PFT[i] do
     begin
      inc(y,20);
      textout(x,y,regname(reg));
      textout(x+40,y,opcodename(opcode));
      textout(x+120,y,inttostr(priority));
     end;//with PFT
  end;//with
end;

procedure showDRT;
var i : byte;
    x,y : word;
begin
 x := 400;
 y := 5;
 with debugbox do with canvas do
  begin
   textout(x,y,'director table');
   inc(y,20);
   textout(x,y,'opcode');
   textout(x+60,y,'dest');
   textout(x+100,y,'src1');
   textout(x+140,y,'src2');
   for i := 1 to DRTtop do
    with DRT[i] do
     begin
      inc(y,20);
      textout(x,y,opcodename(opcode));
      textout(x+60,y,regname(dest));
      textout(x+100,y,regname(src1));
      textout(x+140,y,regname(src2));
     end;
  end;//with debugbox
end;

function getmessage(code : byte) : string;
//get message string of code
begin
 result := errormessage[code]+ '  ' + extramessage;
end;

procedure setdebugmode(box:Tpaintbox; f : boolean);
begin
 debugmode := f;
 debugbox := box;
end;

procedure setX(d : double);
begin
 REG[60] := d;
end;

procedure setY(d : double);
begin
 reg[61] := d;
end;

procedure setV(d : double);
begin
 REG[62] := d;
end;

function getX : double;
begin
 result := REG[60];
end;

function getY : double;
begin
 result := REG[61];
end;

function getV : double;
begin
 result := REG[62];
end;

//-------------------

procedure xlatePreset;
//call before any other operation
//preset pi,e; set a,b,c to 0
var i : byte;
begin
 decimalseparator := '.';
 for i := 60 to 65 do REG[i] := 0;//x y v a b c
 REG[66] := pi;
 REG[67] := exp(1);  // = e
 dln10 := 1 / ln(10);
end;

initialization

 xlatePreset;

end.