home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 February / Chip_2000-02_cd.bin / zkuste / Delphi / navody / tt / objvm.exe / SAMPLE / ObjLangF.pas < prev    next >
Pascal/Delphi Source File  |  1998-05-31  |  10KB  |  404 lines
  1. unit ObjLangF;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Compiler,PrseTree,ObjCodeGeneration,Code,NodeStack,IntStack;
  8. const NotCalled=0;
  9.       Called=1;
  10. type
  11.   TObjLang = class(TForm)
  12.     Compiler: TCompiler;
  13.     procedure CompilerOnR1(Sender: TCompiler; b: TBush);
  14.     procedure CompilerOnR5(Sender: TCompiler; b: TBush);
  15.     procedure CompilerOnR8(Sender: TCompiler; b: TBush);
  16.     procedure CompilerOnR10(Sender: TCompiler; b: TBush);
  17.     procedure CompilerOnR11(Sender: TCompiler; b: TBush);
  18.     procedure CompilerOnR12(Sender: TCompiler; b: TBush);
  19.     procedure CompilerOnR13(Sender: TCompiler; b: TBush);
  20.     procedure CompilerOnR15(Sender: TCompiler; b: TBush);
  21.     procedure CompilerOnR17(Sender: TCompiler; b: TBush);
  22.     procedure CompilerOnR18(Sender: TCompiler; b: TBush);
  23.     procedure CompilerOnR20(Sender: TCompiler; b: TBush);
  24.     procedure CompilerOnR21(Sender: TCompiler; b: TBush);
  25.     procedure CompilerOnR22(Sender: TCompiler; b: TBush);
  26.     procedure CompilerOnR23(Sender: TCompiler; b: TBush);
  27.     procedure CompilerOnR24(Sender: TCompiler; b: TBush);
  28.     procedure CompilerOnR25(Sender: TCompiler; b: TBush);
  29.     procedure CompilerOnR27(Sender: TCompiler; b: TBush);
  30.     procedure CompilerOnR28(Sender: TCompiler; b: TBush);
  31.     procedure CompilerOnR30(Sender: TCompiler; b: TBush);
  32.     procedure CompilerOnR31(Sender: TCompiler; b: TBush);
  33.     procedure CompilerOnR32(Sender: TCompiler; b: TBush);
  34.     procedure CompilerOnR33(Sender: TCompiler; b: TBush);
  35.     procedure CompilerOnR34(Sender: TCompiler; b: TBush);
  36.     procedure CompilerOnR35(Sender: TCompiler; b: TBush);
  37.     procedure CompilerOnR39(Sender: TCompiler; b: TBush);
  38.     procedure CompilerOnR41(Sender: TCompiler; b: TBush);
  39.     procedure CompilerOnR43(Sender: TCompiler; b: TBush);
  40.     procedure CompilerOnR44(Sender: TCompiler; b: TBush);
  41.     procedure CompilerOnR45(Sender: TCompiler; b: TBush);
  42.     procedure CompilerOnR48(Sender: TCompiler; b: TBush);
  43.     procedure CompilerOnR50(Sender: TCompiler; b: TBush);
  44.     procedure CompilerOnR51(Sender: TCompiler; b: TBush);
  45.     procedure CompilerOnR54(Sender: TCompiler; b: TBush);
  46.     procedure CompilerOnR55(Sender: TCompiler; b: TBush);
  47.     procedure CompilerOnR56(Sender: TCompiler; b: TBush);
  48.     procedure CompilerOnR58(Sender: TCompiler; b: TBush);
  49.     procedure CompilerOnR59(Sender: TCompiler; b: TBush);
  50.     procedure CompilerOnR61(Sender: TCompiler; b: TBush);
  51.     procedure CompilerOnR62(Sender: TCompiler; b: TBush);
  52.     procedure CompilerOnR65(Sender: TCompiler; b: TBush);
  53.     procedure CompilerOnR64(Sender: TCompiler; b: TBush);
  54.     procedure CompilerOnR70(Sender: TCompiler; b: TBush);
  55.     procedure CompilerOnR71(Sender: TCompiler; b: TBush);
  56.     procedure CompilerOnR74(Sender: TCompiler; b: TBush);
  57.     procedure CompilerOnR75(Sender: TCompiler; b: TBush);
  58.     procedure CompilerOnR76(Sender: TCompiler; b: TBush);
  59.     procedure CompilerOnR77(Sender: TCompiler; b: TBush);
  60.     procedure CompilerOnR78(Sender: TCompiler; b: TBush);
  61.   private
  62.     { Private declarations }
  63.     g:TObjCodeGeneration;
  64.    public
  65.     { Public declarations }
  66.     function Gen:TObjCodeGeneration;
  67.     function CompileTo(s:TStrings;c:TCode):boolean;
  68.   end;
  69.  
  70. var
  71.   ObjLang: TObjLang;
  72. function Compile(s:TStrings):TCode;
  73. implementation
  74. {$R *.DFM}
  75. function Compile(s:TStrings):TCode;
  76.          Var f:TObjLang;
  77.          begin
  78.            f:=TObjLang.Create(nil);
  79.              Result:=TCode.Create(nil);
  80.              Result.Size:=length(s.Text)*2+8000;
  81.            f.CompileTo(s,Result);
  82.            f.Free;
  83.          end;
  84. function  TObjLang.CompileTo;
  85.           begin
  86.             g:=TObjCodeGeneration.Create(c);
  87.             try
  88.               Compiler.BeginCompile;
  89.               Compiler.AcceptStrings(0,s);
  90.             finally
  91.               Compiler.EndCompile;
  92.               g.Free;
  93.             end;
  94.             Result:=not Compiler.WasErrors;
  95.           end;
  96. function  TObjLang.Gen;
  97.           begin
  98.           end;
  99.  
  100.  
  101. procedure TObjLang.CompilerOnR1(Sender: TCompiler; b: TBush);
  102. begin
  103.   Compiler.CompileNode(b[0]);
  104. end;
  105.  
  106. procedure TObjLang.CompilerOnR5(Sender: TCompiler; b: TBush);
  107. begin
  108.   g.cRoot;
  109.   Compiler.CompileNode(b[0]);
  110. end;
  111.  
  112. procedure TObjLang.CompilerOnR8(Sender: TCompiler; b: TBush);
  113. begin
  114.   if g.Stack.Pop=NotCalled then
  115.   begin
  116.   end
  117.   else
  118.   begin
  119.     g.cEval;
  120.   end;
  121.   Compiler.CompileNode(b[1]);
  122. end;
  123.  
  124. procedure TObjLang.CompilerOnR10(Sender: TCompiler; b: TBush);
  125. begin
  126.   g.Stack.Push(NotCalled);
  127. end;
  128.  
  129. procedure TObjLang.CompilerOnR11(Sender: TCompiler; b: TBush);
  130. begin
  131.   g.cToR;
  132.   Compiler.CompileNode(b[0]);
  133.   g.cFromR;
  134.   g.Stack.Push(Called);
  135. end;
  136.  
  137. procedure TObjLang.CompilerOnR12(Sender: TCompiler; b: TBush);
  138. begin
  139.   g.cStr(StrConstOf(b[0]));
  140.   g.cGetElem;
  141. end;
  142.  
  143. procedure TObjLang.CompilerOnR13(Sender: TCompiler; b: TBush);
  144. begin
  145.   g.cStr(NodeToStr(b[0]));
  146.   g.cGetElem;
  147. end;
  148.  
  149. procedure TObjLang.CompilerOnR15(Sender: TCompiler; b: TBush);
  150. begin
  151.   g.NodeStack.Push(b[0]);
  152.   Compiler.CompileNode(b[1]);
  153. end;
  154.  
  155. procedure TObjLang.CompilerOnR17(Sender: TCompiler; b: TBush);
  156. begin
  157.   Compiler.CompileNode(g.NodeStack.Pop);
  158.   if g.Stack.Pop=NotCalled then
  159.   begin
  160.     g.cToR;
  161.     g.cInt(0);
  162.     g.cFromR;
  163.   end;
  164.   g.cExec;
  165. end;
  166.  
  167. procedure TObjLang.CompilerOnR18(Sender: TCompiler; b: TBush);
  168. begin
  169.   Compiler.CompileNode(b[1]);
  170.   Compiler.CompileNode(g.NodeStack.Pop);
  171.   if g.Stack.Pop=Called then
  172.   begin
  173.     g.cEval;
  174.   end;
  175.   g.cSet;
  176. end;
  177.  
  178. procedure TObjLang.CompilerOnR20(Sender: TCompiler; b: TBush);
  179. begin
  180.   CompilerOnR23(Sender,b);
  181. end;
  182.  
  183. procedure TObjLang.CompilerOnR21(Sender: TCompiler; b: TBush);
  184. begin
  185.   CompilerOnR24(Sender,b);
  186. end;
  187.  
  188. procedure TObjLang.CompilerOnR22(Sender: TCompiler; b: TBush);
  189. begin
  190.   CompilerOnR25(Sender,b);
  191. end;
  192.  
  193. procedure TObjLang.CompilerOnR23(Sender: TCompiler; b: TBush);
  194. begin
  195.   Compiler.CompileNode(b[1]);
  196.   g.cIF;
  197.   Compiler.CompileNode(b[3]);
  198.   Compiler.CompileNode(b[4]);
  199. end;
  200.  
  201. procedure TObjLang.CompilerOnR24(Sender: TCompiler; b: TBush);
  202. begin
  203.   g.cTHEN;
  204. end;
  205.  
  206. procedure TObjLang.CompilerOnR25(Sender: TCompiler; b: TBush);
  207. begin
  208.   g.cELSE;
  209.   Compiler.CompileNode(b[1]);
  210.   g.cTHEN;
  211. end;
  212.  
  213. procedure TObjLang.CompilerOnR27(Sender: TCompiler; b: TBush);
  214. begin
  215.   Compiler.CompileNode(b[1]);
  216.   Compiler.CompileNode(b[0]);
  217. end;
  218.  
  219. procedure TObjLang.CompilerOnR28(Sender: TCompiler; b: TBush);
  220. begin
  221.   Compiler.CompileNode(b[2]);
  222.   Compiler.CompileNode(b[1]);
  223.   g.cNot;
  224. end;
  225.  
  226. procedure TObjLang.CompilerOnR30(Sender: TCompiler; b: TBush);
  227. begin
  228.   g.cEQU;
  229. end;
  230.  
  231. procedure TObjLang.CompilerOnR31(Sender: TCompiler; b: TBush);
  232. begin
  233.   g.cNE;
  234. end;
  235.  
  236. procedure TObjLang.CompilerOnR32(Sender: TCompiler; b: TBush);
  237. begin
  238.   g.cL;
  239. end;
  240.  
  241. procedure TObjLang.CompilerOnR33(Sender: TCompiler; b: TBush);
  242. begin
  243.   g.cG;
  244. end;
  245.  
  246. procedure TObjLang.CompilerOnR34(Sender: TCompiler; b: TBush);
  247. begin
  248.   g.cLE;
  249. end;
  250.  
  251. procedure TObjLang.CompilerOnR35(Sender: TCompiler; b: TBush);
  252. begin
  253.   g.cGE;
  254. end;
  255.  
  256. procedure TObjLang.CompilerOnR39(Sender: TCompiler; b: TBush);
  257. begin
  258.   Compiler.CompileNode(b[1]);
  259.   g.cNegate;
  260. end;
  261.  
  262. procedure TObjLang.CompilerOnR41(Sender: TCompiler; b: TBush);
  263. begin
  264.   Compiler.CompileNode(b[1]);
  265.   Compiler.CompileNode(b[0]);
  266. end;
  267.  
  268. procedure TObjLang.CompilerOnR43(Sender: TCompiler; b: TBush);
  269. begin
  270.   g.cAdd;
  271. end;
  272.  
  273. procedure TObjLang.CompilerOnR44(Sender: TCompiler; b: TBush);
  274. begin
  275.   g.cSub;
  276. end;
  277.  
  278. procedure TObjLang.CompilerOnR45(Sender: TCompiler; b: TBush);
  279. begin
  280.   g.cOr;
  281. end;
  282.  
  283. procedure TObjLang.CompilerOnR48(Sender: TCompiler; b: TBush);
  284. begin
  285.   Compiler.CompileNode(b[1]);
  286.   Compiler.CompileNode(b[0]);
  287. end;
  288.  
  289. procedure TObjLang.CompilerOnR50(Sender: TCompiler; b: TBush);
  290. begin
  291.   g.cMul;
  292. end;
  293.  
  294. procedure TObjLang.CompilerOnR51(Sender: TCompiler; b: TBush);
  295. begin
  296.   g.cDiv;
  297. end;
  298.  
  299. procedure TObjLang.CompilerOnR54(Sender: TCompiler; b: TBush);
  300. begin
  301.   g.cAnd;
  302. end;
  303.  
  304. procedure TObjLang.CompilerOnR55(Sender: TCompiler; b: TBush);
  305. Var N:extended;
  306.     C:Integer;
  307. begin
  308.   Val(NodeToStr(b[0]),N,c);
  309.   g.cFloat(N);
  310. end;
  311.  
  312. procedure TObjLang.CompilerOnR56(Sender: TCompiler; b: TBush);
  313. begin
  314.   Compiler.COmpileNode(b[0]);
  315.   if g.Stack.Pop=Called then
  316.   begin
  317.     g.cEval
  318.   end
  319.   else
  320.   begin
  321.     g.cGet;
  322.   end;
  323. end;
  324.  
  325. procedure TObjLang.CompilerOnR58(Sender: TCompiler; b: TBush);
  326. begin
  327.   CompilerOnR59(Sender,b);
  328. end;
  329.  
  330. procedure TObjLang.CompilerOnR59(Sender: TCompiler; b: TBush);
  331. begin
  332.   Compiler.CompileNode(b[1]);
  333.   g.cNot;
  334. end;
  335.  
  336. procedure TObjLang.CompilerOnR61(Sender: TCompiler; b: TBush);
  337. begin
  338.   g.cBEGIN;
  339.     Compiler.CompileNode(b[1]);
  340.   g.cWHILE;
  341.     Compiler.CompileNode(b[3]);
  342.   g.cREPEAT;
  343. end;
  344.  
  345. procedure TObjLang.CompilerOnR62(Sender: TCompiler; b: TBush);
  346. begin
  347.   CompilerOnR61(Sender,b);
  348. end;
  349.  
  350. procedure TObjLang.CompilerOnR65(Sender: TCompiler; b: TBush);
  351. begin
  352.     Compiler.CompileNode(b[1]);
  353.   g.cTIMES;
  354.     Compiler.CompileNode(b[3]);
  355.   g.cLOOP;
  356.  
  357. end;
  358.  
  359. procedure TObjLang.CompilerOnR64(Sender: TCompiler; b: TBush);
  360. begin
  361.   CompilerOnR65(Sender,b);
  362. end;
  363.  
  364. procedure TObjLang.CompilerOnR70(Sender: TCompiler; b: TBush);
  365. begin
  366.   g.Stack.Push(0);
  367.   Compiler.CompileNode(b[1]);
  368.   g.cInt(g.Stack.Pop);
  369. end;
  370.  
  371. procedure TObjLang.CompilerOnR71(Sender: TCompiler; b: TBush);
  372. begin
  373.   Compiler.CompileNode(b[0]);
  374.   g.Stack.Push(g.Stack.Pop+1);
  375.   Compiler.CompileNode(b[1]);
  376. end;
  377.  
  378. procedure TObjLang.CompilerOnR74(Sender: TCompiler; b: TBush);
  379. begin
  380.   g.cStr(StrConstOf(b[0]));
  381. end;
  382.  
  383. procedure TObjLang.CompilerOnR75(Sender: TCompiler; b: TBush);
  384. begin
  385.   g.cBool(true);
  386. end;
  387.  
  388. procedure TObjLang.CompilerOnR76(Sender: TCompiler; b: TBush);
  389. begin
  390.   g.cBool(false);
  391. end;
  392.  
  393. procedure TObjLang.CompilerOnR77(Sender: TCompiler; b: TBush);
  394. begin
  395.   g.cBool(true);
  396. end;
  397.  
  398. procedure TObjLang.CompilerOnR78(Sender: TCompiler; b: TBush);
  399. begin
  400.   g.cBool(false);
  401. end;
  402.  
  403. end.
  404.