スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

F#で入門 コンパイラ、インタプリタ編 一行計算機 MASM(16ビット系)

 今回は 1+2 などの一行計算式を読み込み、その結果を計算するMASMアセンブラ用のコードを吐き出すソフトを作成してみたいと思います。
まずは完成したソフトの実行画面をのっけておきます。
1016-1.jpg
上の画面で、「構文木化」ボタンを押し、「コンパイル」ボタンを押すと下の様にコード部分が表示されます。
1016-2.jpg
「連結してSave」ボタンを押すと、上の例では内容が次のようなファイルが出来上がります。
(今回はtest04.asmという名前でSaveしています。)
 CODE     SEGMENT
    ASSUME cs:CODE,ds:DATA,ss:STK
START:
    mov ax,DATA
    mov ds,ax
    ;---------------------------------------codeここから
    mov ax,1
    push ax
    mov ax,3
    push ax
    pop bx
    pop ax
    add ax,bx
    push ax
    pop ax
    call PUT_AX
    ;---------------------------------------codeここまで
    mov ah,4CH
    int 21H
;-------AXを[16進法4桁+改行]表示する-----
PUT_AX:
    push ax
    push bx
    push cx
    push dx
    mov cx,4
    mov bx,16
LOOP1:
    mul bx
    push ax  ;Hex文字表示
    and dl,0FH
    add dl,'0'
    cmp dl,'9'
    jle SKIP1
    add dl,07H
SKIP1:
    mov ah,02H
    int 21H
    pop ax
    loop    LOOP1
    mov ah,02H
    mov dl,0DH
    int 21H
    mov dl,0AH
    int 21H
    pop dx
    pop cx
    pop bx
    pop ax
    ret
CODE    ENDS
DATA SEGMENT
    ;-------------------------------------------dataここから
    ;-------------------------------------------dataここまで
DATA    ENDS
STK      SEGMENT STACK
    DB    100H DUP(?)
STK     ENDS
    END    START
    
VM版よりひと手間かかる部分は、スタックに数値を積んだり、おろしたりする命令がレジスタ経由になる部分です。
では上のファイルtest04.asmをアセンブル処理します。(リンク処理も同時に行われます。)
C:\awork>ml test04.asm
Microsoft (R) Macro Assembler Version 6.14.8444
Copyright (C) Microsoft Corp 1981-1997.  All rights reserved.
 Assembling: test04.asm
Microsoft (R) Segmented Executable Linker  Version 5.60.339 Dec  5 1994
Copyright (C) Microsoft Corp 1984-1993.  All rights reserved.
Object Modules [.obj]: test04.obj
Run File [test04.exe]: "test04.exe"
List File [nul.map]: NUL
Libraries [.lib]:
Definitions File [nul.def]:
ではexeファイルができましたので実行してみます。
C:\awork>test04
0004
コードは以下の通りです。
 open System   
open System.Text.RegularExpressions
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//文法定義のエラー
exception MyGramExcp of string
let STR_EPS ="EPSILON"
//引数分の空白文字を作る補助関数
let spaceStr(i) = 
    let sb = new System.Text.StringBuilder()
    let rec addSpace count =
        if count = i then sb.ToString()
        else
            sb.Append(" ") |> ignore
            addSpace (count + 1)
    addSpace 0 
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
type Token(kind:string,img:string,row:int,col:int) =
    member this.Kind = kind
    member this.Img = img
    member this.Row = row
    member this.Col = col
    override this.ToString() =
        sprintf "[%s %s (%d,%d)] " kind img row col
//一行をトークン化したときの結果用の型
type TokenizeOneLineResult =
    |TOLSuccess of list<Token>
    |TOLFail of int*int //トークン化失敗したときの行と列
    member this.IsSuccess () =
        match this with
        |TOLSuccess(_) -> true
        | _ -> false
//具象構文木
type embodyST =
    |EPS_Leaf of Token //tokenは存在しないので、εの直後のtokenを与える
    |Leaf of Token 
    |Node of (int* string * list<embodyST>) //intは構文規則番号,stringは "(1, "Program", ["DeclStmts"; "PrintStmts"])"等
    //表示用
    member this.dispStr (inc :int)  = //inc = インシデント
            match this with
            |EPS_Leaf (token)
                -> spaceStr(inc) +  "ε" + (sprintf "(%d,%d)の前" token.Row token.Col ) + "\r\n"
            |Leaf(token)
                -> spaceStr(inc) +  token.ToString() + "\r\n" 
            |Node(index,str,lst) 
                -> spaceStr(inc) + (sprintf "(%d)" index) + str + "\r\n" 
                   + List.fold (fun state (ele:embodyST) -> state + (ele.dispStr (inc + 4)) ) "" lst 
type LL1TokenizeAndParse (inDefLst:list<string*string>, inStrLst:list<string>) =
    let initStrLst = "0:Z = Program EOF" :: inStrLst
    let initDefLst =  ("EOF","EOF"):: inDefLst
    let makeTokenizeRules (inDefLst:list<string*string>) =
        inDefLst
            |> List.map(fun (name,rgText) ->(name,(new Regex ( @"^(?<sPart>\s*)(?<parts>" + rgText + @")"))))
    let tokenizeTopPart (textPart:string) (trl:list<string*Regex>) (row:int) (col:int) =
        trl
          |>List.fold (fun (curToken:Token,curLongestLength:int) (name,rg) ->
                            let wholeMatch = rg.Match(textPart)
                            let partMatch = wholeMatch.Groups.["parts"]  //必要な部分
                            let sPartMatch = wholeMatch.Groups.["sPart"] //先頭の空白部分
                            if wholeMatch.Value.Length > curLongestLength then //最長マッチ
                                (new Token(name,partMatch.Value,row, col + sPartMatch.Value.Length),wholeMatch.Value.Length )
                            else
                                (curToken,curLongestLength)
                      )
                      (new Token("","",0,0),0)
    let tokenizeOneLine (inDefLst:list<string*string>) (inRow:int) (inOneLineStr:string) =
        let trs = makeTokenizeRules inDefLst
        let rec tokenizeOneLineSub (curCol:int) (remainStr:string) res =
            if remainStr.Trim().Length = 0 then
                TOLSuccess(List.rev res)
            else
               let (slicedToken,length) = tokenizeTopPart remainStr trs inRow curCol
               if length = 0 then
                    let topBlankNum = remainStr.Length - remainStr.TrimStart().Length
                    TOLFail(inRow,curCol+topBlankNum)
               else
                  tokenizeOneLineSub (curCol + length) (remainStr.Substring(length)) (slicedToken::res)       
        tokenizeOneLineSub 1 inOneLineStr []
    let tokenizer  (source:list<string>) =
        let oneLineTokenizer = tokenizeOneLine initDefLst
        let isTOLSuccess (x:TokenizeOneLineResult) =
            match x with
            |TOLSuccess(_) -> true
            |_             -> false
        let sucLst,failLst =
            source
            |>List.map (fun str -> str.TrimEnd())
            |>List.mapi (fun i str -> oneLineTokenizer (i+1) str )
            |>List.partition (fun tr -> tr.IsSuccess () )
        if failLst.Length > 0 then 
            failwith (sprintf "%A" failLst)
        else 
            sucLst
              |>List.map (fun tolr -> match tolr with
                                         |TOLSuccess(tol) -> tol
                                         | _ -> failwith "error" //これは起こらない
                         )
              |>List.fold (fun s lst -> s @ lst) []
        
    let splitOneLineGram (inStr:string)=
        let (lhdIndex,rhd) = 
            match inStr.Split([|':'|]) with
            [|mlhd;mrhd|]  ->  (mlhd.Trim(),mrhd)
            | _             ->  raise <| MyGramExcp(inStr) 
        let (lhd,rhd2) =
            match rhd.Split([|'='|]) with
            |[|mlhd;mrhd|]  ->  (mlhd.Trim(),mrhd)
            | _             ->  raise <| MyGramExcp(inStr) 
        let rhdElems = 
            rhd2.Split([|' '|])
                |> List.ofArray
                |> List.map (fun s -> s.Trim())
                |> List.filter (fun s -> s <> "")
        (System.Int32.Parse(lhdIndex),lhd,rhdElems)
    let getNTN_TN__Sets (inStrLst:list<string>) =
        let (sumUpLhdSet,sumUpRhdSet) =
            inStrLst
                |> List.map splitOneLineGram
                |> List.fold (fun (acclh,accrh)  (_,lhd,rhdLst) -> (lhd :: acclh,rhdLst @ accrh)) ([],[])
                |> (fun (hdLst,rhLst) -> (Set.ofList hdLst, Set.ofList rhLst))
        (sumUpLhdSet,sumUpRhdSet - sumUpLhdSet - (Set.ofList [STR_EPS]))
    let (ntnSet,tnSet) =  getNTN_TN__Sets initStrLst  
    let isNullableToken ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)(inTokenName:string) =
        if inTokenName = STR_EPS then 
             true
        elif Set.contains inTokenName in_tn then
             false
        else
            in_ntnNullableMap.[inTokenName]
    let isNullableTokenLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)(inTokenNameLst:list<string>) =
          List.forall (isNullableToken (in_ntn,in_tn) in_ntnNullableMap )inTokenNameLst //リスト中のすべてのtokenがnullableか
          
    let isNullableTokenLstLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)(inTokenNameLstLst:list<list<string>>) =
          List.exists (isNullableTokenLst (in_ntn,in_tn) in_ntnNullableMap ) inTokenNameLstLst//リスト中のどれかのtokenリストがnullableか
    let grams = initStrLst
                    |> List.map splitOneLineGram
                    |> List.map (fun (_,lh,rhEles) -> (lh,rhEles)) //[("Program",["DeclStmts";"PrintStmts"]);("DeclStmts",["VAR";"SEMI"])]
 
    let getNTN_NullableMap (inStrLst:list<string>) =
    
   
        let rec getNTN_NullableMapSub (inOldNullableMap:Map<string,bool>) (count:int) = 
            let nextNullableMap =
                ntnSet
                    |> Set.fold (fun stateMap ele ->
                                    let targetGramsLstLst =
                                        grams
                                            |>List.filter (fun (ntnName,_) -> ntnName = ele)
                                            |>List.map (fun (_,lst) -> lst)
                                    let thisEleNullable =
                                        isNullableTokenLstLst(ntnSet,tnSet) inOldNullableMap targetGramsLstLst
                                    Map.add ele thisEleNullable stateMap
                                 )
                                 Map.empty
            if count > 10000 then
                failwith "count error"
            elif nextNullableMap = inOldNullableMap then
                nextNullableMap
            else
                getNTN_NullableMapSub nextNullableMap (count + 1)
    
        let initNullableMap =
                    ntnSet
                        |> Set.map (fun ele -> (ele,false))
                        |> Map.ofSeq
    
        getNTN_NullableMapSub initNullableMap 0
    let ntnNullableMap = getNTN_NullableMap initStrLst
    let getFirstSetOfToken ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnFirstSetMap:Map<string,Set<string>>)(inTokenName:string) =
        if inTokenName = STR_EPS then 
             Set.empty
        elif Set.contains inTokenName in_tn then
             Set.ofList ([inTokenName])
        else
            in_ntnFirstSetMap.[inTokenName]
    let getFirstSetOfTokenLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)
                               (in_firstSetMap:Map<string,Set<string>>) (inTokenNameLst:list<string>) =
          let isNullableTokenPartApply = isNullableToken (in_ntn,in_tn) in_ntnNullableMap   
      
          let rec getFirstSetOfTokenLstSub (tokenLst:list<string>)  =
            match tokenLst with
            |[] -> Set.empty
            |hd::tl when isNullableTokenPartApply hd -> (getFirstSetOfToken (in_ntn,in_tn) in_firstSetMap hd) + (getFirstSetOfTokenLstSub tl)
            |hd::tl                                  -> (getFirstSetOfToken (in_ntn,in_tn) in_firstSetMap hd)
          getFirstSetOfTokenLstSub inTokenNameLst
    let getFirstSetOfTokenLstLst ((in_ntn,in_tn):Set<string>*Set<string>) (in_ntnNullableMap:Map<string,bool>)
                              (in_firstSetMap:Map<string,Set<string>>) (inTokenNameLstLst:list<list<string>>) =  
        let getFirstSetOfTokenLstPartApply = getFirstSetOfTokenLst (in_ntn,in_tn) in_ntnNullableMap in_firstSetMap
    
        List.fold (fun acc ele -> acc + (getFirstSetOfTokenLstPartApply ele)) Set.empty inTokenNameLstLst
    let getNTN_FirstMap  (inStrLst:list<string>) =
    
        let FisrtSetOfTokenLstLstPA = getFirstSetOfTokenLstLst (ntnSet,tnSet) ntnNullableMap
    
        let rec getNTN_FirstMapSub (inOldFirstMap:Map<string,Set<string>>) (count:int) = 
            let nextFirstMap =
                ntnSet
                    |> Set.fold (fun stateMap ele ->
                                    let targetGramsLstLst =
                                        grams
                                            |>List.filter (fun (ntnName,_) -> ntnName = ele)
                                            |>List.map (fun (_,lst) -> lst)
                                    let thisEleFisrtSet =
                                         FisrtSetOfTokenLstLstPA inOldFirstMap targetGramsLstLst
                                    Map.add ele thisEleFisrtSet stateMap
                                 )
                                 Map.empty
            if count > 10000 then
                failwith "count error"
            elif nextFirstMap = inOldFirstMap then
                nextFirstMap
            else
                getNTN_FirstMapSub nextFirstMap (count + 1)
    
        let initFirstMap =
                    ntnSet
                        |> Set.map (fun ele -> (ele,Set.empty))
                        |> Map.ofSeq
    
        getNTN_FirstMapSub initFirstMap 0
    let ntnFirstMap = getNTN_FirstMap initStrLst
    
    let getAfterTokens (inStr:string) ((lhdStr,rhStrLst):string*list<string>) =
        let rec getAfterTokensSub strLst res =
            match strLst with
            |hd::tl when hd = inStr -> getAfterTokensSub tl ((tl,lhdStr)::res)
            |hd::tl                 -> getAfterTokensSub tl res
            | [] -> res
        getAfterTokensSub rhStrLst []
    
    let getNTN_FollowMap  (inStrLst:list<string>) =
        let isNullableTokensLstPA (tokenLst:list<string>) = isNullableTokenLst (ntnSet,tnSet) ntnNullableMap tokenLst
        let getFirstSetOfTokenLstPA (tokenLst:list<string>) = getFirstSetOfTokenLst (ntnSet,tnSet) ntnNullableMap  ntnFirstMap tokenLst
 
        let rec getNTN_FollowMapSub (inOldFollowMap:Map<string,Set<string>>) (count:int) = 
           let getFollowSet (afterTokens:list<string>,ntnName:string) =
                    if isNullableTokensLstPA afterTokens then
                        (getFirstSetOfTokenLstPA afterTokens) + (inOldFollowMap.[ntnName])
                    else
                        (getFirstSetOfTokenLstPA afterTokens)                
           let nextFollowMap =
                ntnSet
                    |> Set.fold (fun stateMap ele ->
                                    let includeEleGrams =
                                        grams
                                          |> List.fold (fun state2 (ntnName2,tokenLst)
                                                            -> state2 @ (getAfterTokens ele (ntnName2,tokenLst)))
                                                        []
                                                    
                                    let followSet =
                                        includeEleGrams
                                          |> List.fold (fun (state3:Set<string>) (afterTokens,ntnName) ->
                                                        state3 + (getFollowSet (afterTokens,ntnName)))
                                                        Set.empty
                                    Map.add ele followSet stateMap
                                 )
                                 Map.empty
           if count > 10000 then
                failwith "count error"
           elif nextFollowMap = inOldFollowMap then
                nextFollowMap
           else
                getNTN_FollowMapSub nextFollowMap (count + 1)
        let initFollowMap =
                    ntnSet
                        |> Set.map (fun ele -> (ele,Set.empty))
                        |> Map.ofSeq
    
        getNTN_FollowMapSub initFollowMap 0
    
    let ntnFollowMap = getNTN_FollowMap initStrLst
    let gramsWithIndex = initStrLst
                            |> List.map splitOneLineGram
                            |> List.map (fun (index,lh,rhEles) -> (index,(lh,rhEles))) 
    let getNTN_DirectorMap  (inStrLst:list<string>) =
        let isNullableTokensLstPA (tokenLst:list<string>) = isNullableTokenLst (ntnSet,tnSet) ntnNullableMap tokenLst
        let getFirstSetOfTokenLstPA (tokenLst:list<string>) = getFirstSetOfTokenLst (ntnSet,tnSet) ntnNullableMap  ntnFirstMap tokenLst
    
        let getNTN_DirectorSet (inHh:string,inRhEles:list<string>) =
            if isNullableTokensLstPA inRhEles then
                (getFirstSetOfTokenLstPA inRhEles) + ntnFollowMap.[inHh]
            else
                (getFirstSetOfTokenLstPA inRhEles)
        gramsWithIndex
            |> List.map (fun (index,(lh,rhEles)) -> (index, getNTN_DirectorSet (lh,rhEles)))
            |> Map.ofList             
    let directorMap = getNTN_DirectorMap initStrLst
    let getOneToOneParsingRelation (inStrLst:list<string>) =
        let relationBetweenIndexAndNTN_namdAndDirecSetList
            = [ for (index,(lh,rhEles)) in gramsWithIndex do
                    for direcEle in directorMap.[index] do
                        yield (index,lh,direcEle) ]
        let ParsingRelation
            = relationBetweenIndexAndNTN_namdAndDirecSetList
                |> List.fold (fun (stateMap:Map<string*string,Set<int>>)  (index,lh,direcEle)  ->      
                                        let tf = Map.tryFind (lh,direcEle) stateMap
                                        match tf with
                                        |Some(oldSet) -> Map.add (lh,direcEle) (oldSet + (Set.ofList [index])) stateMap
                                        |None         -> Map.add (lh,direcEle) (Set.ofList [index]) stateMap
                             )
                             Map.empty              
        
        let OneToOneParsingRelation
            = ParsingRelation
                |> Map.map (fun (ntnName,direcEle) intSet -> 
                                    if Set.count intSet > 1 then raise (MyGramExcp "衝突しているのでLL(1)解析できません")
                                    else
                                       match (List.ofSeq intSet) with
                                       | [] -> failwith "neverOccurable Error" // 起こらない
                                       | h::[] -> h
                                       | _ ->  failwith "neverOccurable Error" // 起こらない
                           )         
        OneToOneParsingRelation
    
    let getIndexGRmap (inStrLst:list<string>) =
        inStrLst
            |> List.map splitOneLineGram 
            |> List.map (fun (index,_,gramLst) -> (index,gramLst))
            |> Map.ofList
    let rec makeEmbodyST ((tntSet:Set<string>),(ntSet:Set<string>)) 
                         (prMap:Map<(string * string),int>) (iGmap:Map<int,string list>)
                         ((remainToken:list<Token>),(remainGRM:list<string>),(acc:list<embodyST>)) =
        match remainToken,remainGRM with
        |[],_ -> ([],[],acc)
        //一つの構文要素終了時
        |remt,[]    -> (remt,[],acc) 
        //εの場合
        |hdt::tlt,hdg::tlg  when hdg = STR_EPS 
                    -> makeEmbodyST (tntSet,ntSet) prMap iGmap (remainToken,tlg,acc @ [EPS_Leaf(hdt)]) 
        //終端記号
        |hdt::tlt,hdg::tlg  when hdt.Kind = hdg
                    -> makeEmbodyST (tntSet,ntSet) prMap iGmap  (tlt,tlg,acc @ [Leaf(hdt)])
        //非終端記号
        |hdt::tlt,hdg::tlg  
                   -> let foundPRIndex = Map.tryFind (hdg,hdt.Kind) prMap
                      match foundPRIndex with
                      |Some(i) -> let shouldUseGram = iGmap.[i]
                                  let (remT,remG,underNodes) = makeEmbodyST (tntSet,ntSet) prMap iGmap (remainToken,shouldUseGram,[])
                                  //上の行でremGは[]として返ってくる
                                  makeEmbodyST (tntSet,ntSet) prMap iGmap (remT,tlg, acc @ [Node(i,hdg,underNodes)])
                              
                      |None    -> raise (MyGramExcp (sprintf "%sで文法エラー" (hdt.ToString())))
    member this.GetTokens (sourceLst:list<string>) =  
        tokenizer sourceLst  
    member this.GetEBASTtree (sourceLst:list<string>) =  
        let forTokenizedLst =  sourceLst @ ["EOF"]
        let tokens = tokenizer forTokenizedLst
        let relMap = getOneToOneParsingRelation initStrLst
        let indexGRmap = getIndexGRmap initStrLst
        let (_,_,madeTree) = makeEmbodyST (ntnSet,tnSet) relMap indexGRmap (tokens,["Z"],[])
        List.head madeTree
///////////////////////////////////////////////////////////////////////////////////////////////////////////
let appendSB (in_sb:System.Text.StringBuilder) (strLst:list<string>) =
     List.fold(fun (sb:System.Text.StringBuilder) (ele:string) ->
                        sb.Append("    ").Append(ele).Append("\r\n"))
                         
              in_sb
              strLst
let makeCodes (in_eb:embodyST) =
    let t_s = "    " //tab Space
    let cdSB = new System.Text.StringBuilder()
    let dtSB = new System.Text.StringBuilder()   
    
    let cdPartSB = appendSB cdSB
    let dtPartSB = appendSB dtSB
   
    let rec eVal3  (eb:embodyST)  =
        match eb with
        //0: Z = Program EOF
        |Node(0,_,pro::_)     
            ->  eVal3 pro 
                cdPartSB ["pop ax"] |> ignore
        //1:Program = Expression
        |Node(1,_,expNd::_) 
            -> eVal3 expNd
        //2:Expression = Expression1 Term Expression2
        //3:UnaryOp = PLUS
        //4:UnaryOp = MINUS
        //5:Expression1 = EPSILON
        //6:Expression1 = UnaryOp
        |Node(2,_,exp1Nd::termNd::exp2Nd::_) 
            -> eVal3 termNd  
               match exp1Nd with
                   |Node(5,_,_) -> () 
                   |Node(6,_,Node(3,_,_)::_)  -> ()
                   |Node(6,_,Node(4,_,_)::_)  ->  cdPartSB ["mov bx,-1";
                                                            "pop ax";"imul bx";"push ax"] |> ignore
                                                 
                                                          
                   |_ -> failwith "never occruable error" 
               eVal3 exp2Nd  
        //7:Expression2 = EPSILON
        |Node(7,_,EPS_Leaf(_)::_) 
            -> () 
        //8:AddOp = PLUS
        //9:AddOp = MINUS
        //10:Expression2 = AddOp Expression3 Term Expression2
        //11:Expression3 = EPSILON
        //12:Expression3 = UnaryOp
        |Node(10,_,addOpNd::exp3Nd::termNd::exp2Nd::_) 
            ->eVal3 termNd 
              match exp3Nd with 
                   |Node(11,_,_) -> () 
                   |Node(12,_,Node(3,_,_)::_)  -> ()
                   |Node(12,_,Node(4,_,_)::_)  ->  cdPartSB ["mov bx,-1";
                                                             "pop ax";"imul bx";"push ax"] |> ignore
                   |_ -> failwith "never occruable error" 
              match addOpNd with
                |Node(8,_,_)  -> cdPartSB ["pop bx";"pop ax";"add ax,bx";"push ax"] |> ignore
                |Node(9,_,_)  -> cdPartSB ["pop bx";"pop ax";"sub ax,bx";"push ax"] |> ignore
                |_ -> failwith "never occruable error" 
              eVal3 exp2Nd  
        //13:Term = Factor Term1
        |Node(13,_,factorNd::term1Nd::_) 
            ->eVal3 factorNd
              eVal3 term1Nd 
        //14:Term1 = EPSILON
        |Node(14,_,_) 
            -> ()
        //15:MulOp = MUL
        //16:MulOp = DIV
        //17:Term1 = MulOp Factor Term1
        |Node(17,_,mulOpNd::factorNd::term1Nd::_) 
            ->eVal3 factorNd
              match mulOpNd with
                |Node(15,_,_)  -> cdPartSB ["pop bx";"pop ax";"imul bx";"push ax"] |> ignore
                |Node(16,_,_)  -> cdPartSB ["pop bx";"cwd";"pop ax";"idiv bx";"push ax"] |> ignore
                |_ -> failwith "never occruable error" 
              eVal3 term1Nd
        //18:Factor = NUM
        |Node(18,_,Leaf(tk)::_)
            -> let num = System.Int32.Parse(tk.Img)
               cdPartSB [(sprintf "mov ax,%d" num);"push ax" ] |> ignore 
        //19:Factor = LPAR Expression RPAR
        |Node(19,_,_::expNode::_::_) 
            -> eVal3 expNode
        |_ -> failwith "never occruable error" 
    eVal3 in_eb
    (cdSB.ToString(),dtSB.ToString())
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
open System.Windows.Forms   
open System.Drawing  
let tnR = [("PLUS","\+");
           ("MINUS","\-");
           ("MUL","\*");
           ("DIV","\/");
           ("LPAR","\(");
           ("RPAR","\)");
           ("NUM","\d+")
           ]
let grammersStrLst =
   ["1:Program = Expression";
    "2:Expression = Expression1 Term Expression2";
    "3:UnaryOp = PLUS";
    "4:UnaryOp = MINUS";
    "5:Expression1 = EPSILON";
    "6:Expression1 = UnaryOp";
    "7:Expression2 = EPSILON";
    "8:AddOp = PLUS";
    "9:AddOp = MINUS";
    "10:Expression2 = AddOp Expression3 Term Expression2";
    "11:Expression3 = EPSILON";
    "12:Expression3 = UnaryOp";
    "13:Term = Factor Term1";
    "14:Term1 = EPSILON";
    "15:MulOp = MUL";
    "16:MulOp = DIV";
    "17:Term1 = MulOp Factor Term1";
    "18:Factor = NUM";
    "19:Factor = LPAR Expression RPAR"
      ]
let tp = new LL1TokenizeAndParse (tnR,grammersStrLst)
let f2c x = x :> System.Windows.Forms.Control 
let label5= new Label(AutoSize = true,Location = new Point(15, 18),Name = "label5",Size = new Size(33, 12),TabIndex = 31,Text = "ソース")
let source_tb= new TextBox(Location = new Point(66, 13),Multiline = true,Name = "source_tb",ScrollBars = ScrollBars.Both,Size = new Size(916, 32),TabIndex = 30)
let makeTree_btn= new Button(Location = new Point(146, 56),Name = "makeTree_btn",Size = new Size(164, 23),TabIndex = 53,Text = "構文木化",UseVisualStyleBackColor = true)
let ebTree_tl= new TextBox(Location = new Point(55, 85),Multiline = true,Name = "ebTree_tl",ScrollBars = ScrollBars.Both,Size = new Size(394, 564),TabIndex = 52)
let compile_btn= new Button(Location = new Point(486, 58),Name = "compile_btn",Size = new Size(164, 23),TabIndex = 55,Text = "コンパイル",UseVisualStyleBackColor = true)
let groupBox1= new GroupBox(Location = new Point(486, 85),Name = "groupBox1",Size = new Size(513, 667),TabIndex = 54,TabStop = false,Text = "MSAM コード")
let label6= new Label(AutoSize = true,Location = new Point(30, 573),Name = "label6",Size = new Size(83, 12),TabIndex = 9,Text = "source_E_Block")
let srcE_tb= new TextBox(Location = new Point(26, 589),Multiline = true,Name = "srcE_tb",ScrollBars = ScrollBars.Both,Size = new Size(470, 63),TabIndex = 8)
let label4= new Label(AutoSize = true,Location = new Point(30, 434),Name = "label4",Size = new Size(138, 12),TabIndex = 7,Text = "source_D_Block(data部分)")
let srcD_tb= new TextBox(Location = new Point(26, 450),Multiline = true,Name = "srcD_tb",ScrollBars = ScrollBars.Both,Size = new Size(470, 114),TabIndex = 6)
let label3= new Label(AutoSize = true,Location = new Point(30, 344),Name = "label3",Size = new Size(84, 12),TabIndex = 5,Text = "source_C_Block")
let srcC_tb= new TextBox(Location = new Point(26, 360),Multiline = true,Name = "srcC_tb",ScrollBars = ScrollBars.Both,Size = new Size(470, 63),TabIndex = 4)
let label2= new Label(AutoSize = true,Location = new Point(30, 90),Name = "label2",Size = new Size(145, 12),TabIndex = 3,Text = "source_B_Block(コード部分)")
let srcB_tb= new TextBox(Location = new Point(26, 106),Multiline = true,Name = "srcB_tb",ScrollBars = ScrollBars.Both,Size = new Size(470, 224),TabIndex = 2)
let label1= new Label(AutoSize = true,Location = new Point(30, 17),Name = "label1",Size = new Size(84, 12),TabIndex = 1,Text = "source_A_Block")
let srcA_tb= new TextBox(Location = new Point(26, 33),Multiline = true,Name = "srcA_tb",ScrollBars = ScrollBars.Both,Size = new Size(470, 49),TabIndex = 0)
let ConSave_btn= new Button(Location = new Point(818, 58),Name = "ConSave_btn",Size = new Size(164, 23),TabIndex = 56,Text = "連結してSave",UseVisualStyleBackColor = true)
let label7= new Label(AutoSize = true,Location = new Point(59, 658),Name = "label7",Size = new Size(32, 12),TabIndex = 58,Text = "エラー")
let error_tb= new TextBox(Location = new Point(55, 675),Multiline = true,Name = "error_tb",ScrollBars = ScrollBars.Both,Size = new Size(394, 62),TabIndex = 57)
let mainForm= new Form(AutoScaleDimensions = new SizeF(6.0f, 12.0f),AutoScaleMode = AutoScaleMode.Font,ClientSize = new Size(998, 764),Name = "mainForm",Text = "IntExpressionVerMASM")
[ f2c label6; f2c srcE_tb; f2c label4; f2c srcD_tb; f2c label3; f2c srcC_tb; f2c label2; f2c srcB_tb; f2c label1; f2c srcA_tb] |> List.iter(fun cnt -> groupBox1.Controls.Add cnt)
[ f2c label7; f2c error_tb; f2c ConSave_btn; f2c compile_btn; f2c groupBox1; f2c makeTree_btn; f2c ebTree_tl; f2c label5; f2c source_tb] |> List.iter(fun cnt -> mainForm.Controls.Add cnt)
let srcATxtArr =
    [|" CODE     SEGMENT";
    "    ASSUME cs:CODE,ds:DATA,ss:STK";
    "START:";
    "    mov ax,DATA";
    "    mov ds,ax";
    "    ;---------------------------------------codeここから"|]   
let srcCTxtArr =
   [| "    call PUT_AX";
    "";
    "    ;---------------------------------------codeここまで";
    "    mov ah,4CH";
    "    int 21H";
    "";
    ";-------AXを[16進法4桁+改行]表示する-----";
    "PUT_AX:";
    "    push ax";
    "    push bx";
    "    push cx";
    "    push dx";
    "    mov cx,4";
    "    mov bx,16";
    "LOOP1:";
    "    mul bx";
    "    push ax  ;Hex文字表示";
    "    and dl,0FH";
    "    add dl,'0'";
    "    cmp dl,'9'";
    "    jle SKIP1";
    "    add dl,07H";
    "SKIP1:";
    "    mov ah,02H";
    "    int 21H";
    "    pop ax";
    "    loop    LOOP1";
    "    mov ah,02H";
    "    mov dl,0DH";
    "    int 21H";
    "    mov dl,0AH";
    "    int 21H";
    "    pop dx";
    "    pop cx";
    "    pop bx";
    "    pop ax";
    "    ret";
    "CODE    ENDS";
    "";
    "DATA SEGMENT";
    "    ;-------------------------------------------dataここから";|]
let srcETxtArr =
  [|"    ;-------------------------------------------dataここまで";
    "DATA    ENDS";
    "";
    "STK      SEGMENT STACK";
    "    DB    100H DUP(?)";
    "STK     ENDS";
    "    END    START"|]
srcA_tb.Text <- String.Join("\r\n",srcATxtArr)
srcC_tb.Text <- String.Join("\r\n",srcCTxtArr)
srcE_tb.Text <- String.Join("\r\n",srcETxtArr)
makeTree_btn.Click.Add
    (fun _ -> 
        error_tb.Text <- ""
        try
            let sourceTextLst = source_tb.Text.Replace("\r\n", "\n").Split([|'\n'|]) |> List.ofArray
            let ebTree = tp.GetEBASTtree sourceTextLst
            ebTree_tl.Text <- ebTree.dispStr 4
        with
          | ex -> error_tb.Text <- ex.Message 
    )
compile_btn.Click.Add
    (fun _ ->
        try
            let sourceTextLst = source_tb.Text.Replace("\r\n", "\n").Split([|'\n'|]) |> List.ofArray
            let ebTree = tp.GetEBASTtree sourceTextLst
            let (cdPart,dtPart) = makeCodes ebTree
            srcB_tb.Text <- cdPart
            srcD_tb.Text <- dtPart
        with
          | ex -> error_tb.Text <- ex.Message 
    )
ConSave_btn.Click.Add 
    (fun _ -> error_tb.Text <- ""  
              try 
                let sfd = new SaveFileDialog(Filter = "asmファイル(*.asm)|*.asm|すべてのファイル(*.*)|*.*", 
                                              RestoreDirectory = true) 
                if (sfd.ShowDialog() = DialogResult.OK) then 
                    use sw = new System.IO.StreamWriter(sfd.FileName) 
                    let wholeText = srcA_tb.Text + "\r\n"+ srcB_tb.Text + "\r\n"
                                    + srcC_tb.Text + "\r\n" + srcD_tb.Text + "\r\n"+ srcE_tb.Text
                    sw.Write( wholeText) 
              with 
                | ex -> error_tb.Text <- ex.Message 
                 
    ) 
[<STAThread()>]  
do Application.Run(mainForm)
スポンサーサイト

テーマ : プログラミング
ジャンル : コンピュータ

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

Author:T GYOUTEN
F#と英単語とフリーソフトと読書に興味があります。
ホームページでフリーソフトも公開しています。どぞ御贔屓に。

最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
フリーエリア
フリーエリア
blogram投票ボタン
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QRコード
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。