同范畴类似的东西中，虚拟机开发比操作系统和编译器都有意思：

操作系统能玩的好玩的不多，做完进程管理和内存管理，其他就是脏活累活了，要得到一个成型可用的东西，没有一个团队弄不了，个人玩不转。以前调侃过这个话题：

关于LMOS自主操作系统的发展，大家有什么建议？ – 韦易笑的回答

而编译器方面，优化和代码生成有llvm，用不着自己开发，其他部分基本上是一个固定套路，照着文档照着书，按固定套路来即可。

以 Lua为例，最精巧的部分就是 Lua虚拟机的实现，整个 Lua-5.3 代码中，编译部分只占2000行，剩下两万行全在实现虚拟机。大家津津乐道的各种 lua 奇技淫巧全都在它的虚拟机实现部分中。

Ruby更是如此，整个ruby代码除去库实现外，基本在实现ruby的虚拟机，编译器部分作者都懒得怎么写，直接一个的 .y文件搞定，精力都在ruby虚拟机实现上。

虚拟机难是难在开头的设计，怎样最精巧，怎样没有逻辑漏洞，别写着写着发现前后逻辑矛盾了，设计好以后就要开始架构了，先从最简单的 switch case opcode实现起来，很快你就能得到反馈看到自己的工作成果，接下来给虚拟机实现符号表，object，实现 gc，实现各种容器，优化性能，在内存中翻译成本地指令码，然后实现多线程，再给你的虚拟机实现一门汇编语言，每走一步都很有意思。且虚拟机相关的技术目前还在日新月异的发展着，光一个gc，每年都能看到很多新方法出现，大有需要继续改进迭代的地方。

实现虚拟机需要覆盖很多知识面，虚拟机设计的好，还可以嫁接很多其他语言，让这些新语言来这个虚拟机上运行。

大家夸 v8 都是说它虚拟机运行速度快，内存少，没人说 v8 的编译部分如何如何，以至于很多新语言都以v8虚拟机为运行环境。

同样，每年都有很多人尝试重新实现 lua vm，引入更灵巧的机制或者使用更新的 JIT方法。来pk官方runtime, 以及 luajit，好多人或多或少在某些方面都能并发出很多奇思妙想。

相反，从来没人碰 lua 的编译部分，为啥啊？就那样了，还碰它干嘛，没意思了啊。

2001-2002 期间开发的虚拟机/编译器开源项目代码和资料：

• 关于虚拟机及其编译器的说明
• VmBasic 开发/调试环境的介绍及说明
• 关于其他

所有资料可以通过下面地址下载：

下载可执行源程序下载设计说明书

关于虚拟机及其编译器的说明

记得 3DS/MAX 里面实现了一个类似 BASIC 的脚本，Animator 里面实现了一个类 C 的脚本语言，Autodesk 公司的软件对于脚本支持的很出色，好的脚本引擎在乎平台无关性、高效性和扩充性，一个脚本引擎的需要对一个好程序来说非常迫切，于是半年前我写了一款虚拟机，最近又实现了一个类 Basic 的脚本编译器，特性说明：

1) 高效性和独立于平台：由于虚拟机运行是解释二进制的字节码因此速度明显快于每次运行及时解释的脚本语言，比如 Perl 和 PHP，而虚拟机的核心程序代码也经过数个 C++编译器和平台的测试，可以毫无修改的编译运行于多个操作系统。
2) 充分的开放：通过虚拟机的端口 I/O 技术，要对它进行扩充变得十分容易，VmBeta 指令通过输出/输入的方法向用户自己的程序进行通讯，用户通过处理输出输入消息来达到功能的扩充，使它符合你产品的需要，具体的虚拟机实现和设计说明参考文档　vmbeta.txt 。
3) 可设安全级别：通过可设置安全级别，对程序运行状态进行监控。

通过半年的修改我自己觉得虚拟机够高效开放，就是 vmbasic 编译器写的没有多高的水准：完全没有对生成代码做优化，弄出许多繁琐的中间代码，不过还是明显快于及时解释语言，通过测试速度大概是 DOS 自带的 QBASIC 程序的三倍左右（可以通过目录下的几个算法程序来实验）。

为了检验其效率和扩充性，我将虚拟机程序扩充了一些作图功能写成了 Windows 版本的，然后用 vmbasic 编写了一个空战小游戏，虽然由于一开始我太相信 GDI 而没有选择 DDraw，且编译器要生成 1/2 左右的重复性代码，但是仍可以从游戏中看出效率来（可以用 vmbide.exe 打开 fire.bas 运行），关于编译程序 VmBasic 的更详细说明见 basic.htm

程序说明：压缩档包括虚拟机运行程序 (vmbeta.exe)，VmBasic 调试开发平台 (vmbide.exe)，四个算法例子 (alex1-4.bas)，一个射击游戏例子 (fire.bas) 及其图片，说明帮助文档若干。。。

VmBasic开发/调试环境介绍及说明

右边的图是完整的开发环境左边是语句帮助，中间是代码编写区，下面是编译的错误和过程记录，系统热键说明：

1) F8 编译成 VMS 文件
2) F9 编译并运行程序
3) F1 对 VmBasic 的帮助
4) Shift+F1 帮助 IDE

另外点击运行图表左边的图表可以查看编译出来的虚拟机汇编代码。点击工具目录，可以做一系列设置：虚拟机程序设置，预连接库设置，开发环境设置等，都是简单的东西。

用 VmBasic 编写的射击小游戏：必须 Windows 版的虚拟机程序运行（扩充了 GDI 图形功能）

显示查看虚拟机汇编：

关于其他

半年前在论坛上面看见过一些师兄们关于编译的争论，忽然有所感悟，那时刚好写了虚拟机，于是就决定为它写款语言，本来考虑写类 C 或者类 Pascal 的，但是想着 Basic 用起来简单，而且分析起来似乎也简单，后来我才发现虽然没有 C 的编译难写但由于 Basic 经历了长时间的发展，语法变化很大，总的来说没有同意的规范，模块表示也不明确，就连 IF 语句都有好多种版本，所以一个支持函数/过程的 Basic 编译器我觉得比 Pascal 难写的多。目录 DOS 下有 DOS 环境的编译器和虚拟机，可以用来编译运行非扩展的 vmbasic 程序：alex1-4.bas，可以在 IDE 的工具->设置里面设定虚拟机的运行程序。

这是个引擎的演示版本，毕竟好的东西都不是一个人整出来的，我也会在学校不断的学习，非常欢迎来信讨论相关技术，和游戏/图形程式设计，如果你觉得这套引擎对你有价值，可以写信给我，如果你对相关的东西很感兴趣，也可以写信给我。

成都建设路电子科技大学20013080　林伟

邮编：610000
电话：028-83200790
信箱：skywind3000@163.com

麻雀虽小，五脏具全，对编译原理的代码以 TPASCAL 格式重写，还原最原版的代码 编译版和例子下载：

http://www.skywind.me/maker/pl0-pas.rar

(********************* PL0 编译程序Turbo Pascal代码 *********************)program pl0(fa,fa1,fa2); (* PL0 compile with code generation *) label 99;       (* Turbo Pascal do not support goto between different          blocks so, the 'goto' command in getch are replaced          by procedure exitp !! in another way, 'label 99' do          not work !!                  Lin Wei       2001  *) const norw=13;       (* of reserved words *)       txmax=100;     (* length of identifier table *)       nmax=14;       (* max number of digits in numbers *)       al=10;         (* length of identifiers *)       amax=2047;     (* maximum address *)       levmax=3;      (* max depth of block nesting *)       cxmax=200;     (* size of code array *) type symbol=(nul,ident,number,plus,minus,times,slash,oddsym,              eql,neq,lss,leq,gtr,geq,lparen,rparen,comma,              semicolon,period,becomes,beginsym,endsym,ifsym,              thensym,whilesym,writesym,readsym,dosym,callsym,              constsym,varsym,procsym);      alfa=packed array[1..al] of char;      objects=(constant,variable,procedur);      (* wirth used the word "procedure"and"object" there, which won't work! *)      symset=set of symbol;      fct=(lit,opr,lod,sto,cal,int,jmp,jpc);      instruction=packed record                     f:fct;        (* function code *)                     l:0..levmax;  (* level *)                     a:0..amax;    (* displacement addr *)                  end;               (* lit 0,a load constant a                  opr 0,a execute opr a                  lod 1,a load variable 1,a                  sto 1,a store variable 1,a                  cal 1,a call procedure at level 1                  int 0,a increment t -register by a                  jmp 0,a jump to a                  jpc 0,a jump conditional to a *) var fa:text;     fa1,fa2:text;     listswitch:boolean;    (* true set list object code *)     ch:char;               (* last char read *)     sym:symbol;            (* last symbol read *)     id:alfa;               (* last identifier read *)     num:integer;           (* last number read *)     cc:integer;            (* character count *)     ll:integer;            (* line length *)     kk:integer;     cx:integer;            (* code allocation index *)     line:array[1..81] of char;     a:alfa;     code:array[0..cxmax] of instruction;     word:array[1..norw] of alfa;     wsym:array[1..norw] of symbol;     ssym:array[' '..'^'] of symbol;         (* wirth uses "array[char]" here *)     mnemonic:array[fct] of packed array[1..5] of char;     declbegsys, statbegsys, facbegsys:symset;     table:array[0..txmax] of record             name:alfa;             case kind:objects of               constant:(val:integer);               variable,procedur:(level,adr,size:integer)             (* "size" lacking in original. I think it belongs here *)           end;     fin,fout:text;     fname:string;     err:integer;     endf:boolean; procedure error(n:integer); begin   writeln('****','':cc-1,'!',n:2);   writeln(fa1,'****','':cc-1,'!',n:2);   err:=err+1; end; (* error *) procedure exitp; begin   endf:=true;   close(fin);   writeln;   exit; end; procedure getsym; var i,j,k:integer;   procedure getch;   begin     if cc=ll then begin       if eof(fin) then begin          write('program incomplete');          close(fin);          writeln;          exitp;          (*goto 99;*)       end;       ll:=0;       cc:=0;       write(cx:4,' ');       write(fa1,cx:4,' ');       while not eoln(fin) do begin         ll:=ll+1;         read(fin,ch);         write(ch);         write(fa1,ch);         line[ll]:=ch;       end;       writeln;       ll:=ll+1;       (* read(fin,line[ll]); repleaced by two lines below *)       line[ll]:=' ';       readln(fin);       writeln(fa1);     end;     cc:=cc+1;     ch:=line[cc];   end; (* getch *) begin (* getsym *)   while ch=' ' do getch;   if ch in ['a'..'z'] then begin      k:=0;      repeat        if k<al then begin           k:=k+1;           a[k]:=ch;        end;        getch;      until not(ch in ['a'..'z','0'..'9']);      if k>=kk then kk:=k      else repeat             a[kk]:=' ';             kk:=kk-1;           until kk=k;      id:=a;      i:=1;      j:=norw;      repeat        k:=(i+j) div 2;        if id<=word[k] then j:=k-1;        if id>=word[k] then i:=k+1;      until i>j;      if i-1>j then sym:=wsym[k] else sym:=ident;   end else if ch in ['0'..'9'] then begin (* number *)     k:=0;     num:=0;     sym:=number;     repeat       num:=10*num+(ord(ch)-ord('0'));       k:=k+1;       getch;     until not(ch in['0'..'9']);     if k>nmax then error(30);   end else if ch=':' then begin     getch;     if ch='=' then begin        sym:=becomes;        getch;     end else sym:=nul;   end else if ch='<' then begin     getch;     if ch='=' then begin        sym:=leq;        getch;     end else sym:=lss;   end else if ch='>' then begin     getch;     if ch='=' then begin        sym:=geq;        getch;     end else sym:=gtr;   end else begin     sym:=ssym[ch];     getch;   end; end; (* getsym *) procedure gen(x:fct;y,z:integer); begin   if cx>cxmax then begin      write('program too long');      (*goto 99;*)   end;   with code[cx] do begin        f:=x;        l:=y;        a:=z;   end;   cx:=cx+1; end; (* gen *) procedure test(s1,s2:symset;n:integer); begin   if not(sym in s1) then begin      error(n);      s1:=s1+s2;      while not(sym in s1) do getsym;   end; end; (* test *) procedure block(lev,tx:integer;fsys:symset); var dx:integer;   (* data allocation index *)     tx0:integer;  (* inital table index *)     cx0:integer;  (* inital code index *)     procedure enter(k:objects);     begin (* enter object into table *)       tx:=tx+1;       with table[tx] do begin         name:=id;         kind:=k;         case k of           constant: begin                       if num>amax then begin error(31); num:=0; end;                       val:=num;                     end;           variable: begin                       level:=lev;                       adr:=dx;                       dx:=dx+1;                     end;           procedur: level:=lev;         end;       end;     end; (* enter *)     function position(id:alfa):integer;     var i:integer;     begin (* find identifier in table *)       table[0].name:=id;       i:=tx;       while table[i].name<>id do i:=i-1;       position:=i;     end; (* position *)     procedure constdeclaration;     begin       if sym=ident then begin          getsym;          if sym in [eql,becomes] then begin             if sym=becomes then error(1);             getsym;             if sym=number then begin                enter(constant);                getsym;             end else error(2);          end else error(3);       end else error(4);     end; (* constdeclaration *)     procedure vardeclaration;     begin       if sym=ident then begin          enter(variable);          getsym;       end else error(4);     end; (* vardeclaration *)     procedure listcode;     var i:integer;     begin       if listswitch then begin          for i:=cx0 to cx-1 do              with code[i] do begin                   writeln(i,mnemonic[f]:5,l:3,a:5);                   writeln(fa,i:4,mnemonic[f]:5,l:3,a:5);              end;       end;     end; (* listcode *)     procedure statement(fsys:symset);     var i,cx1,cx2:integer;         procedure expression(fsys:symset);         var addop:symbol;             procedure term(fsys:symset);             var mulop:symbol;                 procedure factor(fsys:symset);                 var i:integer;                 begin                   test(facbegsys,fsys,24);                   while sym in facbegsys do begin                     if sym=ident then begin                        i:=position(id);                        if i=0 then error(11)                        else with table[i] do                          case kind of                            constant:gen(lit,0,val);                            variable:gen(lod,lev-level,adr);                            procedur:error(21);                          end;                        getsym;                     end else if sym=number then begin                         if num>amax then begin                            error(31);                            num:=0;                         end;                         gen(lit,0,num);                         getsym;                     end else if sym=lparen then begin                         getsym;                         expression([rparen]+fsys);                         if sym=rparen then getsym                         else error(22);                     end;                     test(fsys,facbegsys,23);                   end;                 end; (* factor *)             begin (* term *)               factor([times,slash]+fsys);               while sym in [times,slash] do begin                 mulop:=sym;                 getsym;                 factor(fsys+[times,slash]);                 if mulop=times then gen(opr,0,4) else gen(opr,0,5)               end;             end; (* term *)         begin (* expression *)           if sym in [plus,minus] then begin              addop:=sym;              getsym;              term(fsys+[plus,minus]);              if addop=minus then gen(opr,0,1);           end else term(fsys+[plus,minus]);           while sym in [plus,minus] do begin             addop:=sym;             getsym;             term(fsys+[plus,minus]);             if addop=plus then gen(opr,0,2) else gen(opr,0,3);           end;         end; (* expression *)         procedure condition(fsys:symset);         var relop:symbol;         begin           if sym=oddsym then begin              getsym;              expression(fsys);              gen(opr,0,6);           end else begin              expression([eql,neq,lss,leq,gtr,geq]+fsys);              if not(sym in [eql,neq,lss,leq,gtr,geq]) then error(20)              else begin                relop:=sym;                getsym;                expression(fsys);                case relop of                  eql:gen(opr,0,8);                  neq:gen(opr,0,9);                  lss:gen(opr,0,10);                  geq:gen(opr,0,11);                  gtr:gen(opr,0,12);                  leq:gen(opr,0,13);                end;              end;           end;         end; (* condition *)     begin (* statement *)       if sym=ident then begin          i:=position(id);          if i=0 then error(11)          else if table[i].kind<>variable then begin            error(12);            i:=0;          end;          getsym;          if sym=becomes then getsym else error(13);          expression(fsys);          if i<>0 then with table[i] do gen(sto,lev-level,adr);       end else if sym=readsym then begin          getsym;          if sym<>lparen then error(34)          else repeat                 getsym;                 if sym=ident then i:=position(id)                 else i:=0;                 if i=0 then error(35)                 else with table[i] do begin                   gen(opr,0,16);                   gen(sto,lev-level,adr);                 end;                 getsym;          until sym<>comma;          if sym<>rparen then begin             error(33);             while not(sym in fsys) do getsym;          end else getsym;       end else if sym=writesym then begin          getsym;          if sym=lparen then begin             repeat               getsym;               expression([rparen,comma]+fsys);               gen(opr,0,14);             until sym<>comma;             if sym<>rparen then error(33) else getsym;          end;          gen(opr,0,15);       end else if sym=callsym then begin          getsym;          if sym<>ident then error(14)          else begin            i:=position(id);            if i=0 then error(11) else with table[i] do               if kind=procedur then gen(cal,lev-level,adr)               else error(15);            getsym;          end;       end else if sym=ifsym then begin          getsym;          condition([thensym,dosym]+fsys);          if sym=thensym then getsym          else error(16);          cx1:=cx;          gen(jpc,0,0);          statement(fsys);          code[cx1].a:=cx;       end else if sym=beginsym then begin          getsym;          statement([semicolon,endsym]+fsys);          while sym in [semicolon]+statbegsys do begin            if sym=semicolon then getsym            else error(10);            statement([semicolon,endsym]+fsys);          end;          if sym=endsym then getsym else error(17);       end else if sym=whilesym then begin          cx1:=cx;          getsym;          condition([dosym]+fsys);          cx2:=cx;          gen(jpc,0,0);          if sym=dosym then getsym else error(18);          statement(fsys);          gen(jmp,0,cx1);          code[cx2].a:=cx;       end;       test(fsys,[],19);     end; (* statement *) begin (* block *)   dx:=3;   tx0:=tx;   table[tx].adr:=cx;   gen(jmp,0,0);   if lev>levmax then error(32);   repeat     if sym=constsym then begin        getsym;        repeat          constdeclaration;          while sym=comma do begin            getsym;            constdeclaration;          end;          if sym=semicolon then getsym else error(5);        until sym<>ident;     end;     if sym=varsym then begin        getsym;        repeat;          vardeclaration;          while sym=comma do begin            getsym;            vardeclaration;          end;          if sym=semicolon then getsym else error(5);        until sym<>ident;     end;     while sym=procsym do begin       getsym;       if sym=ident then begin          enter(procedur);          getsym;       end else error(4);       if sym=semicolon then getsym else error(5);       block(lev+1,tx,[semicolon]+fsys);       if sym=semicolon then begin          getsym;          test(statbegsys+[ident,procsym],fsys,6);       end else error(5);     end;     test(statbegsys+[ident],declbegsys,7);   until not(sym in declbegsys);   code[table[tx0].adr].a:=cx;   with table[tx0] do begin        adr:=cx;        size:=dx;   end;   cx0:=cx;   gen(int,0,dx);   statement([semicolon,endsym]+fsys);   gen(opr,0,0);   test(fsys,[],8);   listcode; end; (* block *) procedure interpret; const stacksize=500; var p,b,t:integer; (* program base topstack registers *)     i:instruction;     s:array[1..stacksize] of integer; (* datastore *)     function base(l:integer):integer;     var bl:integer;     begin       bl:=b; (* find base 1 level down *)       while l>0 do begin         bl:=s[bl];         l:=l-1;       end;       base:=bl;     end; (* base *) begin   writeln('start pl0');   t:=0; b:=1; p:=0;   s[1]:=0; s[2]:=0; s[3]:=0;   repeat     i:=code[p];     p:=p+1;     with i do case f of       lit: begin t:=t+1; s[t]:=a; end;       opr: case a of (* operator *)              0: begin (* return *)                   t:=b-1;                   p:=s[t+3];                   b:=s[t+2];                 end;              1: s[t]:=-s[t];              2: begin t:=t-1; s[t]:=s[t]+s[t+1]; end;              3: begin t:=t-1; s[t]:=s[t]-s[t+1]; end;              4: begin t:=t-1; s[t]:=s[t]*s[t+1]; end;              5: begin t:=t-1; s[t]:=s[t] div s[t+1]; end;              6: s[t]:=ord(odd(s[t]));              8: begin t:=t-1; s[t]:=ord(s[t]=s[t+1]); end;              9: begin t:=t-1; s[t]:=ord(s[t]<>s[t+1]); end;              10:begin t:=t-1; s[t]:=ord(s[t]<s[t+1]); end;              11:begin t:=t-1; s[t]:=ord(s[t]>=s[t+1]); end;              12:begin t:=t-1; s[t]:=ord(s[t]>s[t+1]); end;              13:begin t:=t-1; s[t]:=ord(s[t]<=s[t+1]); end;              14:begin write(s[t]); write(fa2,s[t]); t:=t-1; end;              15:begin writeln; writeln(fa2); end;              16:begin t:=t+1; write('?'); write(fa2,'?'); readln(s[t]);                 writeln(fa2,s[t]); end;            end;       lod: begin t:=t+1; s[t]:=s[base(l)+a]; end;       sto: begin s[base(l)+a]:=s[t]; (* writeln(s[t]) *) t:=t-1; end;       cal: begin (* generat new block mark *) s[t+1]:=base(l); s[t+2]:=b;            s[t+3]:=p; b:=t+1; p:=a; end;       int: t:=t+a;       jmp: p:=a;       jpc: begin if s[t]=0 then p:=a; t:=t-1; end;     end; (* with, case *)   until p=0;   close(fa2); end; (* interpret *) begin (* main *)   for ch:=' ' to '!' do ssym[ch]:=nul;   (* changed bacause of different character set      note the typos below in the original where      the alfas were not given the correct space *)   word[1]:='begin     ';  word[2]:='call      ';   word[3]:='const     ';  word[4]:='do        ';   word[5]:='end       ';  word[6]:='if        ';   word[7]:='odd       ';  word[8]:='procedure ';   word[9]:='read      ';  word[10]:='then      ';   word[11]:='var       '; word[12]:='while     ';   word[13]:='write     ';   wsym[1]:=beginsym;   wsym[2]:=callsym;   wsym[3]:=constsym;   wsym[4]:=dosym;   wsym[5]:=endsym;     wsym[6]:=ifsym;   wsym[7]:=oddsym;     wsym[8]:=procsym;   wsym[9]:=readsym;    wsym[10]:=thensym;   wsym[11]:=varsym;    wsym[12]:=whilesym;   wsym[13]:=writesym;   ssym['+']:=plus;     ssym['-']:=minus;   ssym['*']:=times;    ssym['/']:=slash;   ssym['(']:=lparen;   ssym[')']:=rparen;   ssym['=']:=eql;      ssym[',']:=comma;   ssym['.']:=period;   ssym['#']:=neq;   ssym[';']:=semicolon;   mnemonic[lit]:='lit  ';  mnemonic[opr]:='opr  ';   mnemonic[lod]:='lod  ';  mnemonic[sto]:='sto  ';   mnemonic[cal]:='cal  ';  mnemonic[int]:='int  ';   mnemonic[jmp]:='jmp  ';  mnemonic[jpc]:='jpc  ';   declbegsys:=[constsym,varsym,procsym];   statbegsys:=[beginsym,callsym,ifsym,whilesym];   facbegsys:=[ident,number,lparen];   (* page(output) *)   endf:=false;   assign(fa1,'PL0.txt');   rewrite(fa1);   write('input file? ');   write(fa1,'input file?');   readln(fname);   writeln(fa1,fname);   (* openf(fin,fname,'r'); ==> *)   assign(fin,fname); reset(fin);   write('list object code ?');   readln(fname);   write(fa1,'list object code ?');   listswitch:=(fname[1]='y');   err:=0;   cc:=0; cx:=0; ll:=0;   ch:=' '; kk:=al;   getsym;   assign(fa,'PL0-1.txt');   assign(fa2,'PL0-2.txt');   rewrite(fa);   rewrite(fa2);   block(0,0,[period]+declbegsys+statbegsys);   close(fa);   close(fa1);   if sym<>period then error(9);   if err=0 then interpret else write('error in pl/0 program'); 99: (* this line is not work in turbo pascal so replace by        procedure exitp: see the memo at the top *)   close(fin);   writeln; end.