求助一个C语言的解析器

2009-01-04 10:59:02 268 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

C语言实现简单功能的命令行解析器（simple shell）用C语言实现简单的命令行解析器，支持用户输入命令行并运行在其他的进程中。该命令行解析器可以运行在任何Linux或Mac系统。每行命令有osh> 开始，然后由用户输入命令行，例如cat prog.c，该命令将prog.c文件展示于终端上。 osh> cat prog.c 同时也支持&修饰命令行，使命令进入后台运行。本质上就是使命令行在子进程运行于后台，或者子进程和父进程同... 阅读详情

我自己在网上找了一个pascal脚本解析器.
自己花了点时间,改写成解析C的,能编译,可是不能运行.
可能在解析生成VMPcode的时候错误了,自己对比检测了,还是不能找到错误的地方.

不知道高手们是否搞过类似的.
请给点儿源码,小弟参考一下.
拜谢.
我的邮箱:huangjacky@163.com

...全文

51单片机通过计时器实现倒计时 51单片机通过计时器操作两位8段阳极数码管，实现倒计时阅读详情

huangjacky

语言基础/算法/系统设计 16,741 成员 33,233 内容

+ 关注 + 加入社区

切换为时间正序

skertone 2009-03-03

打赏
举报

老是回复内容过长！中间省略 N 字节，收尾...



function TCScript.ExpIsObject(S: String; var ObjName, ObjProp: String): Boolean;

var

  ii: Integer;

begin

  // 如果表达式是 Object.Property 格式的话 需特殊处理

  // 处理方法 1.解析出 Object 名与 Property名

  //          2.产生通知事件，通知界面仿真模块

  //          3.在事件方法中 读/写 Object对像属性值

  Result := False;

  S := Trim(S);

  ii := Pos('.',S);

  if ii > 0 then

  begin

    ObjName := Copy(S,1,ii - 1);

    ObjProp := Copy(S,ii + 1,MAXWORD);

    ii := TokenTableFind(ObjName);

    if ii > 0 then

    Result := FTokenTbl[ii].Typ = ttObject;

  end

end;



procedure TCScript.EventIPMoved(IP: Integer);

begin

  if Assigned(FIPMoved) then

  try

    FIPMoved(Self,IP);

  except

  end;

end;



procedure TCScript.EventSrcSet(Source: String);

begin

  if Assigned(FSrcSet) then

  try

    FSrcSet(Self,Source);

  except

  end;

end;



procedure TCScript.CheckStepByStep;

begin

    if not FPause then

    FPause := FStep;



    while FPause do

    begin

        Application.ProcessMessages;

        Sleep(20);

    end;

end;



procedure TCScript.NextStep;

begin

  FPause := False;

end;



procedure TCScript.GetTokenInfo(const Token: String; var sType,sValue: String);

var

  iIndex: Integer;

begin

  iIndex := TokenTableFind(Token);

  if iIndex >=0 then

  with FTokenTbl[iIndex] do

  begin

    case Kind of

      tkArray:         sType := '数组';

      tkVariable:      sType := '变量';

      tkFunction:      sType := '函数';

      tkConst:         sType := '常量';

      else             sType := '未知';

    end;

    if Kind = tkArray then

    begin

      sValue := PChar(ptr(Address));

    end

    else

    sValue :=  TokenValue(Token);

  end;

end;



function TCScript.CheckBreakTokenList(AToken: String): Boolean;

var

  ii: Integer;

begin

  Result := False;

  if FStep then Exit;

  if  FBreakTokenList.Count > 0 then

  for ii := 0 to FBreakTokenList.Count  -1 do

  if Trim(AToken) <> '' then

  begin

    Result := FBreakTokenList[ii] = Trim(AToken);

    if Result then

    Break;

  end;

end;



procedure TCScript.SetEntryCount(const Value: Integer);

begin

  FEntryCount := Value;



  if FStop then

  FStop := FEntryCount > 0;

end;



procedure TCScript.Stop;

begin

  if EntryCount > 0 then

  FStop := True;



  FStep := False;

  FPause := False;

end;



procedure TCScript.Pause;

begin

  if EntryCount > 0 then

  FPause := True;

end;



{ TCMathProcess }



constructor TCMathProcess.Create;

begin

  FNumbStack := TStrings.Create;

  FOppStack := TStrings.Create;

end;



destructor TCMathProcess.Destroy;

begin

  FOppStack.Free;

  FNumbStack.Free;

end;



function TCMathProcess.Exec: Variant;

begin

end;



procedure TCMathProcess.SplitToken;

const

  ExpList: array[1..8] of String[3] = ('\w+','\(+','\)+','\++','\*+','/+','%+','-+');

var

  ii: Integer;

  PosList: TStrings;

begin

  PosList := TStringList.Create;

  PosList.Capacity := Length(FInput);

  for ii := 0 to PosList.Count - 1 do

  PosList[ii] := '';



  // 串化输入

  for ii := Low(ExpList) to High(ExpList) do

  begin

    with TRegExpr.Create do

    try

      Expression := ExpList[ii];

      Exec(FInput);

      while MatchLen[0] > 0 do

      begin

        PosList[MatchPos[0]] := Match[0];

        ExecNext;

      end;

    finally

      Free;

    end;

  end;



  // 清除空行

  for ii := PosList.Count - 1 downto 0 do

  if Trim(PosList[ii]) = '' then

  PosList.Delete(ii);



  // 四则运算

  while PosList.Count > 1 do

  begin

    if PosList[0][1] in ['+','-','*','/','%'] then

    FOppStack.Add(PosList[0])

    else

    FNumbStack.Add(PosList[0]);



    // ) 优先级最高

    if PosList[0] = ')' then

    begin

       if FOppStack.Count > 0 then

       case FOppStack[0][1] of

         '+':;

         '-':;

         '*':;

         '/':;

         '%':;

       end;

    end;



    PosList.Delete(0);

    if FOppStack.Count > 1 then

  end;



  PosList.Free;

end;



end.

skertone 2009-03-03

打赏
举报





procedure TCScript.TokenTableAdd(AToken: String; AKind: TTokenKind;

  AType: TTokenType; AParam: Integer; Addr: DWORD);

begin

  if Length(FTokenTbl) > 0 then

  SetLength(FTokenTbl,Length(FTokenTbl) + 1)

  else

  SetLength(FTokenTbl,1);



  with FTokenTbl[High(FTokenTbl)] do

  begin

    Name := AToken;

    Kind := AKind;

    Typ := AType;

    Param := AParam;

    Address := Addr;

  end;

end;



procedure TCScript.DoAddDeclareToken(sToken, sValue: String);

     // 拆出变量列表 带 *Str, intA[],格式

      function GetVarList(sInput: String): TStrings;

      var

        iPos: Integer;

      begin

        Result := TStringList.Create;

        iPos := Pos(',',sInput);

        while iPos > 0 do

        begin

          Result.Add(Trim(Copy(sInput,1,iPos-1)));

          sInput := Copy(sInput,iPos + 1,MAXWORD);

          iPos := Pos(',',sInput);

        end;

        if Trim(sInput) <> '' then

        Result.Add(Trim(sInput));

      end;

      // 判断是滞是否 *xx 格式，同时去掉 * 号

      function IsPointerVar(var S: String): Boolean;

      begin

        Result := Pos('*',S) > 0;

        if Result then

        S := Trim(Copy(S,Pos('*',S) + 1,MAXWORD));

      end;

      // 判断是否 A[] 数组格式 去掉 []

      function IsArrayVar(var S: String;var Param: Integer): Boolean;

      var

        sParam: String;

      begin

        Param := 0;

        Result := Pos(']',S) > 0;

        if Result then

        begin

            sParam := Trim(Copy(S,Pos('[',S) + 1,MAXWORD));

            sParam := Trim(Copy(sParam,1,Pos(']',sParam) - 1));

            S := Trim(Copy(S,1,Pos('[',S) - 1));

            if sParam <> '' then

            begin

                  try

                    if Pos('0x',sParam) > 0 then

                    begin

                      Delete(sParam,1,2);

                      Insert('$',sParam,1);

                    end;

                    Param := StrToInt(sParam);

                  except

                  end;

            end

         end;

      end;

var

  ii,iParam,iType,iSize: Integer;

  sl: TStrings;

  sTemp: String;

  p: Pointer;

begin

    // 注意: 这里参数名是物非

    sToken := Trim(sToken);

    sValue := Trim(sValue);

    sl := GetVarList(sValue);

    iType := TypeNameToID(sToken);

    for ii := 0 to sl.Count - 1 do

    begin

          sTemp := sl.Strings[ii];

          if IsPointerVar(sTemp) then

          begin

                // 所有指针都初始化为nil(NULL)

                p := nil;

                TokenTableAdd(sTemp,tkVariable,ttPointer,0,DWORD(p));

          end

          else

          if IsArrayVar(sTemp,iParam) then

          begin

                    if iParam = 0 then

                    begin

                       // 动态数组即空指针

                       p := nil;

                       case iType of

                         _U8,_char:     TokenTableAdd(sTemp,tkArray,ttByte,0,DWORD(p));

                         _U16:          TokenTableAdd(sTemp,tkArray,ttSmallInt,0,DWORD(p));

                         _U32,_int:     TokenTableAdd(sTemp,tkArray,ttInteger,0,DWORD(p));

                       end;

                    end

                    else

                    begin

                       case iType of

                         _U8,_char:     iSize := 1;

                         _U16:          iSize := 2;

                         _U32,_int:     iSize := 4;

                       end;

                       iSize := iSize * iParam;

                       GetMem(p,iSize * iParam);



                       case iType of

                         _U8,_char:     TokenTableAdd(sTemp,tkArray,ttByte,iSize,DWORD(p));

                         _U16:          TokenTableAdd(sTemp,tkArray,ttSmallInt,iSize,DWORD(p));

                         _U32,_int:     TokenTableAdd(sTemp,tkArray,ttInteger,iSize,DWORD(p));

                       end;

                    end;

            end

            else

            if iType > 8 then

            begin

                 TokenTableAdd(sTemp,tkVariable,ttObject,0,DWORD(nil));

            end

            else

            begin

                      case iType of

                         _U8,_char:     iSize := 1;

                         _U16:          iSize := 2;

                         _U32,_int:     iSize := 4;

                         _PU8,_PU16,

                         _PU32:         iSize := 4;

                       end;



                      GetMem(p,iSize);



                      case iType of

                         _U8,_char:     TokenTableAdd(sTemp,tkVariable,ttByte,iSize,DWORD(p));

                         _U16:          TokenTableAdd(sTemp,tkVariable,ttSmallInt,iSize,DWORD(p));

                         _U32,_int:     TokenTableAdd(sTemp,tkVariable,ttInteger,iSize,DWORD(p));

                         _PU8,_PU16,

                         _PU32:         TokenTableAdd(sTemp,tkVariable,ttPointer,iSize,DWORD(p));

                       end;





            end;

    end;

    sl.Free;

end;





function TCScript.TypeNameToID(sType: String): Integer;

var

  ii: Integer;

begin

  Result := 0;

  for  ii := Low(TypeNameList) to High(TypeNameList) do

  if TypeNameList[ii] = sType then

  begin

    Result := ii;

    Break;

  end;

end;



function TCScript.TokenDebugOut: String;

var

  ii: Integer;

  sl: TStrings;

begin

  sl := TStringList.Create;

  for ii := Low(FTokenTbl) to High(FTokenTbl) do

  begin

    with FTokenTbl[ii] do

    begin

      sl.Add(Format('%s= Kind:%d Type:%d Param:%d Addr:%.8x',[Name,Ord(Kind),Ord(Typ),Param,Address]));

    end;

  end;



  for ii := Low(FSystemFuncTbl) to High(FSystemFuncTbl) do

  begin

    with FSystemFuncTbl[ii] do

    begin

      sl.Add(Format('%s= Type:%d Param:%d P1=%d P2=%d P3=%d P4=%d',[Name,Ord(Typ),Param,Ord(ParamType[0]),Ord(ParamType[1]),Ord(ParamType[2]),Ord(ParamType[3])]));

    end;

  end;



  Result := sl.Text;

  sl.Free;

end;



procedure TCScript.TokenTableReSize(iNewSize: Integer);

var

  ii: Integer;

begin

  if Length(FTokenTbl) > iNewSize then

  begin

      for ii := High(FtokenTbl) downto iNewSize  do

      with FtokenTbl[ii] do

      begin

        // 释放占用的内存

        //ShowMessage(Format('%s  T=%d  P=%d %.8x',[Name,Ord(Typ),Param,Address]));

        // 这里Char * 实占用 Param + 1 字节空间 有少少内存泄露 需优化！

        if Param > 0 then

        if Ptr(Address) <> nil then

        FreeMem(Ptr(Address),Param);

      end;



      SetLength(FTokenTbl,iNewSize);

  end;

end;



procedure TCScript.DoAddDeclFuncToken(sToken, sValue: String);

var

  p: Pointer;

begin

  sToken := Trim(sToken);  // 实为函数返回值类型

  sValue := Trim(sValue);  // 实为函数名

  if TokenTableFind(sValue) >= 0 then Exit;



  //if Pos('unsigned',sToken) then;/// 这里没处理这些类型及 P_XXX类型

   case TypeNameToID(sToken) of

    _VOID:          TokenTableAdd(sValue,tkFunction,ttVoid,0,DWORD(nil));

     _U8,_char:     TokenTableAdd(sValue,tkFunction,ttByte,0,DWORD(nil));

     _U16:          TokenTableAdd(sValue,tkFunction,ttSmallInt,0,DWORD(nil));

     _U32,_int:     TokenTableAdd(sValue,tkFunction,ttInteger,0,DWORD(nil));

   else

                    TokenTableAdd(sValue,tkFunction,ttInteger,0,DWORD(nil));

   end;

end;

skertone 2009-03-03

打赏
举报





constructor TCScript.Create;

begin

  FSourceCode := TStringList.Create;

  FGlobeTokenCount := 0;

  FCurrentTokenCount := 0;



  // 装载系统函数表

  LoadSystemFunctionTbl;



  FBreakTokenList := TStringList.Create;

  EntryCount := 0;

end;



destructor TCScript.Destroy;

begin

  FSourceCode.Free;

  FBreakTokenList.Free;

end;





procedure TCScript.DoAddDefineToken(sToken, sValue: String);

var

  p: Pointer;

begin

  sToken := Trim(sToken);

  sValue := Trim(sValue);

  // 字符串常量

  if Pos('"',sValue) > 0 then

  begin

     // 去掉 " "

     Delete(sValue,1,1);

     Delete(sValue,Length(sValue),1);

     GetMem(p,Length(sValue) + 1);   // 这里给常量保留了空间

     StrPCopy(p,sValue);

     TokenTableAdd(sToken,tkConst,ttString,Length(sValue),DWORD(p));

  end

  else

  begin

    if Pos('0X',UpperCase(sValue)) > 0 then

    begin

        // 十六进制整数

        Delete(sValue,1,2);

        Insert('$',sValue,1);

    end;

    GetMem(p,SizeOf(DWORD));

    PDWORD(p)^ := StrToInt(sValue);

    TokenTableAdd(sToken,tkConst,ttDWORD,SizeOf(DWORD),DWORD(p));

  end

end;



procedure TCScript.Execute(Code: String;InLoop: Boolean);

var

  ii,iTblSize: Integer;

  sCode: String;

  regExp: TRegExpr;

  curIP: Integer;

begin

//***********************************************************************

//   执行一段代码块

//   此函数能递归执行

//   执行模式: 1.每取一行用正则表达式进行语义识别

//             2.向语义执行函数下传递整个代码块及IP作为参数

//             3.循环上述操直至IP指向代码段未尾

//***********************************************************************

    iTblSize := CurrentTokenTblSize;



    curIP := 1;



    EntryCount := EntryCount + 1;    // 重入记数



    CleanSourceCode(Code);



     while curIP < Length(Code) do

     begin



          if FStop then

          begin

            EntryCount := EntryCount - 1;

            Break;

          end;



          if FLoopFlag = FLAG_CONTINUE then // continue; 调用

          begin

            if InLoop then                  // 此代码块恰好属循环体第一层，直接从头开始

            ClearLoopFlag;

            Break;                          // continue 不是跳到前面去执行，而是直接完成代码段

          end

          else

          if FLoopFlag = FLAG_BREAK then    // break;调用

          begin

            if InLoop then

            ClearLoopFlag;

            Break;

          end;



          sCode := GetExecuteCode(curIP,Code);



          EventSrcSet(Code);    // 输出清理过后的源码



          EventIPMoved(curIP);            // 输出当前执行位置



          CheckStepByStep;                // 检查是否需单步中断



          regExp := TRegExpr.Create;

          try

             //ShowMessage(TokenDebugOut);



                // 利用语义模式列表来识别相应语义

                for ii := Low(RegExpList) to High(RegExpList) do

                with regExp do

                begin

                  Expression := RegExpList[ii];

                  Exec(sCode);

                  if MatchLen[0] > 0 then

                  begin

                      //do...

                      case ii of

                        EXP_CallFunc:       DoCallFunction(curIP,Code);

                        EXP_DoubleOpp:      DoDoubleOpp(curIP,Code);

                        EXP_While:          DoWhile(curIP,Code);

                        EXP_For:            DoFor(curIP,Code);

                        EXP_Excepression:   DoExpression(curIP,Code);

                        EXP_If:             DoIfElse(curIP,Code);

                        EXP_DoWhile:        DoDoWhile(curIP,Code);

                        EXP_SelfOpp:        DoSelfOpp(curIP,Code);    // 没有执行体

                        EXP_Break:          DoBreak(curIP,Code);

                        EXP_Continue:       DoContinue(curIP,Code);

                        EXP_Return:         ;

                        EXP_DeclVar:        DoDeclLocalVar(curIP,Code);

                      else

                        DoBreak(curIP,Code);   // 防死循环 (暂未加入Debug控制)

                      end;

                  end;

                end;

          finally

            regExp.Free;

          end;

     end;



     EventSrcSet('');

     TokenTableReSize(iTblSize);

end;



procedure TCScript.GetDeclareTable;

begin

  with TRegExpr.Create do

  try

     Expression := '\b(\w+)\s+([\w,\x20\*\[\]]*);';

     InputString := SourceCode.Text;

     Exec;

     while MatchLen[0] > 0 do

     begin

       AddToTakenTbl(Match[1],Match[2]);

       ExecNext;

     end;

  finally

    Free;

  end;

end;





procedure TCScript.GetGlobeDeclTable(Code: TStrings);

var

  ii: Integer;

  sl: TStrings;

begin

  // 以下代码提取全局声明

  sl := TStringList.Create;

  try

        sl.AddStrings(Code);

        CleanSourceCode(sl);                // 先清除注释行

        sl.Text := BoneSourceCode(sl.Text); // 剔除代码



        for ii := sl.Count - 1 downto 0 do

        begin

          // 删除掉空行，暂时不处理 #include..

          if (Trim(sl[ii]) = '') OR (Pos('#include',sl[ii]) > 0) then

          sl.Delete(ii);

        end;



            with TRegExpr.Create do

            try

              // 提取#define xxx xxx

              Expression := REGEXP_Define;

              Exec(sl.Text);

              while MatchLen[0] > 0 do

              begin

                DoAddDefineToken(Match[1],Match[2]);

                ExecNext;

              end;

            finally

              Free;

            end;



            with TRegExpr.Create do

            try

              // 提取变量声明

              Expression := REGEXP_DeclVar;

              Exec(sl.Text);

              while MatchLen[0] > 0 do

              begin

              //  ShowMessage(Match[1] + ' ' + match[2]);  debug

                DoAddDeclareToken(Match[1],Match[2]);

                ExecNext;

              end;

            finally

              Free;

            end;



            with TRegExpr.Create do

            try

              // 提取函数声明

              Expression := REGEXP_DeclFunc;

              Exec(sl.Text);

              while MatchLen[0] > 0 do

              begin

                //ShowMessage(Match[1] + ' ' + match[2]);

                DoAddDeclFuncToken(Match[1],Match[2]);

                ExecNext;

              end;

            finally

              Free;

            end;



  finally

  end;

end;

skertone 2009-03-03

打赏
举报





const

  FLAG_CONTINUE: Integer = -1;

  FLAG_BREAK: Integer    = -2;

  TypeNameList: array[0..16] of String = ('void','U8','U16','U32','int','char','PU8','PU16','PU32',

                                          'Text','Button','Edit','CheckBox','RadioButton','Combo',

                                          'ListBox','Window');



  _VOID =       0;

  _U8   =       1;

  _U16  =       2;

  _U32  =       3;

  _int  =       4;

  _char =       5;

  _PU8  =       6;

  _PU16 =       7;

  _PU32 =       8;



  RegExpList: array[1..12] of String = (

                                      '^\s*(\w+)\(([^;\r\n]*)\)\s*;',

                                      '(\*?[\w]+)(\+\+|--)\s*;',

                                      '\bwhile\s*\(([^;\n\r]+)\)',

                                      '\bfor\s*\(\s*([^;]*)\s*;\s*([^;]*)\s*;\s*([^;\)]*)\s*\)\s*\{?',

                                      '([\*\w\.]+)\s*=\s*([^;=]+);',

                                      '^\s*if\s*\(',

                                      '\bdo\s*\{',

                                      '(\*?[\w]+)\s*([\+-]{1}=)([^;]+);',

                                      '\bbreak\s*;',

                                      '\bcontinue\s*;',

                                      '',

                                      '^\s*(\w+)\s+([^;\(\)\{\}\r=]+)\s*;'

                                      );

  REGEXP_Define =   '#define\s+(\w+)\s+([^\r]+)\s+';

  REGEXP_DeclVar =  '\r\s*(\w+)\s+([^;\(\)\{\}\r=]+)\s*;';

  REGEXP_DeclFunc = '\b(\w+\x20*\w+)\s+(\w+)\(([^;\(\)]*)\)';

    EXP_CallFunc =      1;

    EXP_DoubleOpp =     2;

    EXP_While =         3;

    EXP_For =           4;

    EXP_Excepression =  5;

    EXP_If =            6;

    EXP_DoWhile =       7;

    EXP_SelfOpp =       8;

    EXP_Break   =       9;

    EXP_Continue =      10;

    EXP_Return =        11;

    EXP_DeclVar =       12;

    

    EXP_DeclFunc =      10;

    EXP_Define =        11;





  //EXP_CallFunc =        '\b\w+\([\w,\x20\*&\[\]]*\)\s*;';

  //EXP_DoubleOpp =       '(\*?[\w]+)(\+\+|--)\s*;';

  //EXP_While =           '\bwhile\s*\(([^;\n\r]+)\)(\{|\s+)';

  //EXP_For =             '\bfor\s*\(\s*([^;]*)\s*;\s*([^;]*)\s*;\s*([^;]*)\s*\)(\{|\s+)';

  //EXP_Excepression =    '([\*\w]+)\s*=\s*([^;]+);';

  //EXP_If =              '\bif\s*\(([^;]+)\)\s{1}';

  //EXP_DoWhile =         '\bdo\s*\{';

  //EXP_SelfOpp =         '(\*?[\w]+)\s*([\+-]{1}=)([^;]+);'                              // *name += 123 + ia;





function GetCodeBlock(var sCode,sBlock: String;chLeft,chRight: Char): Integer;



implementation



uses SystemCallU,JBPlatformD;

{ TCScript }

procedure TCScript.AddToTakenTbl(sType,sVars: String);

var

  ii: Integer;

  sl: TStrings;

  wType: Word;

  sTemp: String;

      // 拆出变量列表 带 *Str, intA[],格式

      function GetVarList(sInput: String): TStrings;

      var

        iPos: Integer;

      begin

        Result := TStringList.Create;

        iPos := Pos(',',sInput);

        while iPos > 0 do

        begin

          Result.Add(Trim(Copy(sInput,1,iPos-1)));

          sInput := Copy(sInput,iPos + 1,MAXWORD);

        end;

        if Trim(sInput) <> '' then

        Result.Add(Trim(sInput));

      end;

      // 判断是滞是否 *xx 格式，同时去掉 * 号

      function IsPointerVar(var S: String): Boolean;

      begin

        Result := Pos('*',S) > 0;

        if Result then

        S := Trim(Copy(S,Pos('*',S) + 1,MAXWORD));

      end;

      // 判断是否 A[] 数组格式 去掉 []

      function IsArrayVar(var S: String): Boolean;

      begin

        Result := Pos(']',S) > 0;

        if Result then

        S := Trim(Copy(S,1,Pos('[',S) - 1));

      end;

begin

end;



function TCScript.BoneSourceCode(Code: String): String;

var

  ii,iPos: Integer;

begin

  // 层层将 { .. } 内东东去掉

  Result := Code;

  iPos := Pos('}',Result);

  while iPos > 0 do

  begin

    if Pos('(',Result) > 0 then

    begin

      for ii := iPos downto 1 do

      if Ord(Result[ii]) = Ord('{') then

      begin

        Delete(Result,ii,iPos - ii + 1);

        Break;

      end;

    end

    else

    Delete(Result,iPos,1);

    iPos := Pos('}',Result);

  end;

end;



procedure TCScript.CleanSourceCode(Code: TStrings);

var

  ii,iPos: Integer;

  rgp: TRegExpr;

  sTemp: String;

begin

  Code.BeginUpdate;

  // 去掉多行注释

  sTemp := Code.Text;

  iPos := Pos('/*',sTemp);

  while iPos > 0 do

  begin

    ii := Pos('*/',sTemp);

    if ii > 0 then

    Delete(sTemp,iPos,ii - iPos + 2);

    iPos := Pos('/*',sTemp);

  end;

  Code.Text := sTemp;



  rgp := TRegExpr.Create;

  try

      with Code do

      if Count > 0 then

      for ii := Count - 1 downto 0 do

      begin

         // 去掉注释 全行注释将变成空行，由去空行部分再去掉

         rgp.Expression := '\s*//[^\r]*';

         rgp.Exec(Strings[ii]);

         if rgp.MatchLen[0] > 0 then

         begin

           sTemp := Strings[ii];

           System.Delete(sTemp,rgp.MatchPos[0],MAXWORD);

           Strings[ii] := sTemp;

         end;



         // 去掉空行

         if Trim(Strings[ii]) = '' then

         Delete(ii);

      end;

  finally

    rgp.Free;

  end;

  Code.EndUpdate;

end;

skertone 2009-03-03

打赏
举报





    TCScript = class

    private

        FObjNeed: TEventObjectNeed;

        FSrcSet: TEventSrcSet;

        FIPMoved: TEventIPMoved;



        FEntryCount: Integer;            // 记录Execute 被重入次数

        FPause: Boolean;

        FStep: Boolean;

        FStop: Boolean;

        FLoopBreak: Boolean;

        FLoopFlag: Integer;

        FBreakTokenList: TStrings;



        FGlobeTokenCount: Integer;

        FSystemFuncCount: Integer;

        FCurrentTokenCount: Integer;

        FSourceCode: TStrings;

        Fip: Integer;

        FTokenTbl: array of TTokenNode;

        FSystemFuncTbl: array of TSystemFunc;



        function IsBreak: Boolean;

        procedure ClearLoopFlag;



        function TypeNameToID(sType: String): Integer;

        procedure LoadSystemFunctionTbl;

        procedure ClearStringSpace(var Str: String);

        function GetExecuteCode(var IP: Integer;Code: String): String;



        function GetTokenTypeByName(sType: String): TTokenType;





        procedure AddToTakenTbl(sType,sVars: String);

        procedure GetDeclareTable;//?

        procedure CleanSourceCode(Code: TStrings);   overload;

        procedure CleanSourceCode(var Code: String); overload;

        function BoneSourceCode(Code: String): String;



        procedure TokenTableAdd(AToken: String;AKind: TTokenKind;AType: TTokenType;AParam: Integer;Addr: DWORD);

        function TokenTableFind(AToken: String): Integer;

        procedure TokenFunction(sName,sType,sParam: String);



        function SystemFuncTableFind(sName: String): Integer;



        function GetParamTokenListFromStr(sParam: String): TStrings;



        procedure EventSrcSet(Source: String);

        procedure EventIPMoved(IP: Integer);



        procedure DoAddDefineToken(sToken,sValue: String);

        procedure DoAddDeclareToken(sToken,sValue: String);

        procedure DoAddDeclFuncToken(sToken,sValue: String);



        // 此类精细识别只分析单行字符应 ^xxxx$ 显式标明首尾

        function LeftIsFunction(S: String;var sFunc,sParam: String): Boolean;

        function LeftIsSimple(S: String;var sToken: String): Boolean;

        function LeftIsExpression(S: String;var sExpression: String): Boolean;

        function ExpIsObject(S: String;var ObjName,ObjProp: String): Boolean;



        function GoArithmetic(sExpression: String): Variant;

        function GoCallFunction(sFunc,sParam: String): Variant;

        function GoAssignValue(sValue: String): Variant;

        function GoCondition(sExpression: String): Boolean;



        function RePlaceToken(sexpr: String): String;

        procedure AssignTokenValue(AToken: String;Value: Variant);

        function TokenValue(AToken: String): Variant;

        function TokenValueOfByte(AToken: String): Byte;

        function TokenValueOfWord(AToken: String): Word;

        function TokenValueOfInteger(AToken: String): Integer;

        function TokenValueOfDword(AToken: String): DWORD;

        function TokenValueOfDouble(AToken: String): Double;

        function TokenValueOfPointer(AToken: String): Pointer;



        function GetTokenTblSize: Integer;



        procedure CheckStepByStep;

    procedure SetEntryCount(const Value: Integer);

   protected

        procedure DoExpression(var IP: Integer;sCode: String);

        procedure DoCallFunction(var IP: Integer;sCode: String);

        procedure DoIfElse(var IP: Integer;sCode: String);

        procedure DoWhile(var IP: Integer;sCode: String);

        procedure DoBreak(var IP: Integer;sCode: String);

        procedure DoSelfOpp(var IP: Integer;sCode: String);

        procedure DoContinue(var IP: Integer;sCode: String);

        procedure DoDoubleOpp(var IP: Integer;sCode: String);

        procedure DoDoWhile(var IP: Integer;sCode: String);

        procedure DoFor(var IP: Integer;sCode: String);

        procedure DoDeclLocalVar(var IP: Integer;sCode: String);



        function GetLocalDeclTable(Code: String): Integer;

        function CheckBreakTokenList(AToken: String): Boolean;

        property EntryCount: Integer read FEntryCount write SetEntryCount;

    public

        function GetTokenValue(AToken: String): Variant;

        procedure GetGlobeDeclTable(Code: TStrings);

        procedure TokenTableReSize(iNewSize: Integer);

        constructor Create;

        destructor Destroy;

        procedure Execute(Code: String;InLoop: Boolean=False); overload;

        procedure NextStep;

        procedure Stop;

        procedure Pause;

        procedure GetTokenInfo(const Token: String;var sType,sValue: String);

        property SourceCode: TStrings read FSourceCode;

        property CurrentTokenTblSize: Integer read GetTokenTblSize;

        property OnObjNeed: TEventObjectNeed read FObjNeed write FObjNeed;

        property OnSrcSet: TEventSrcSet read FSrcSet write FSrcSet;

        property OnIPMoved: TEventIPMoved read FIPMoved write FIPMoved;

        property StepByStep: Boolean read FStep write FStep;

        property BreakTokenList: TStrings read FBreakTokenList write FBreakTokenList;



        function TokenDebugOut: String;

    end;

skertone 2009-03-03

打赏
举报

我写过一个简单的C语言解释器，不编译及检查错误，直接解释执行，可单步及查看变量

因为当时语法检测有其它编译工具进行了，该代码只是“模拟”执行而已，连四则运算都懒得做全了

逻辑运算根本就没做。使用了正则表达式模块可以网上找到。





unit CScriptU;

//******************************************************************************

//

//          C 语言解释执行类

//

//******************************************************************************



interface

uses Windows,RegExprNew,Classes,Sysutils,ExprCalcU,Dialogs,Forms,Variants;



const

  NULL = vaNULL;

type

    TEventObjectNeed = procedure(Sender: TObject;ObjName: String;ObjPro: String;var Value: Variant) of Object;

    TEventSrcSet = procedure(Sender: TObject;Code: String) of Object;

    TEventIPMoved = procedure(Sender: TObject;IP: Integer) of Object;



    TTokenKind = (tkUnknow,tkArray,tkVariable,tkFunction,tkConst);

    TTokenType = (ttUnknow,ttByte,ttSmallInt,ttInteger,ttDWORD,ttDouble,ttString,ttPointer,ttVoid,ttObject);

    TTokenNode = record

      Name: String[120];      // 保存符号名

      Kind: TTokenKind;       // 符号代表类型

      Typ:  TTokenType;       // 容纳数据类型

      Param: Integer;         // 占用空间 注：指针占用空间为0

      Address: DWORD;         // 地址

    end;



    TSystemFunc = record                    // 保存系统支持列程名称

      Name: String[120];                    // 函数名

      Typ: TTokenType;                      // 返回值类型

      Param: Integer;                       // 参数个数

      ParamType: array[0..10] of TTokenType;// 参数数据类型 10以上参数不支持:P

    end;



    TParamNode = packed record

      case Integer of

        0:(dValue: DWORD);

        1:(iValue: Integer);

        2:(bValue: Byte);

        3:(wValue: Word);

        4:(pValue: Pointer);

        5:(fValue: Double);

    end;





    TCMathProcess = class

      FInput: String;

      FNumbStack: TStrings;

      FOppStack: TStrings;

    private

      procedure SplitToken;

    public

      constructor Create;

      destructor Destroy;

      function Exec: Variant;

    end;

genispan 2009-03-03

打赏
举报

楼上牛人啊佩服

gyk120 2009-02-16

打赏
举报

能写解析器的都是大牛啊。。。暂时还没达到那地步的某人飘过膜拜

tanqth 2009-02-15

打赏
举报

帮顶一下

求助一个C语言的解析器

相关推荐