Archive for 3月, 2013

  1. Hello, COM(LLVM) World!

    Posted on 3月 17th, 2013 by cx20

    COM(LLVM)

    COM(Component Object Model)はマイクロソフトの提唱するプログラム部品の仕様である。
    COM を用いて開発された部品であれば言語を問わず利用することができる。
    以下は LLVM Assembler による COM クライアントの例となっている。

    ソースコード

    ; ModuleID = 'hello.c'
    target datalayout = "e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-f80:128:128-v64:64:64-v128:128:128-a0:0:64-f80:32:32-n8:16:32-S32"
    target triple = "i686-w64-mingw32"
     
    %struct._GUID = type { i32, i16, i16, [8 x i8] }
    %struct.IDispatch = type { %struct.IDispatchVtbl* }
    %struct.IDispatchVtbl = type { i32 (%struct.IDispatch*, %struct._GUID*, i8**)*, i32 (%struct.IDispatch*)*, i32 (%struct.IDispatch*)*, i32 (%struct.IDispatch*, i32*)*, i32 (%struct.IDispatch*, i32, i32, %struct.ITypeInfo**)*, i32 (%struct.IDispatch*, %struct._GUID*, i16**, i32, i32, i32*)*, i32 (%struct.IDispatch*, i32, %struct._GUID*, i32, i16, %struct.tagDISPPARAMS*, %struct.tagVARIANT*, %struct.tagEXCEPINFO*, i32*)* }
    %struct.ITypeInfo = type { %struct.ITypeInfoVtbl* }
    %struct.ITypeInfoVtbl = type { i32 (%struct.ITypeInfo*, %struct._GUID*, i8**)*, i32 (%struct.ITypeInfo*)*, i32 (%struct.ITypeInfo*)*, i32 (%struct.ITypeInfo*, %struct.tagTYPEATTR**)*, i32 (%struct.ITypeInfo*, %struct.ITypeComp**)*, i32 (%struct.ITypeInfo*, i32, %struct.tagFUNCDESC**)*, i32 (%struct.ITypeInfo*, i32, %struct.tagVARDESC**)*, i32 (%struct.ITypeInfo*, i32, i16**, i32, i32*)*, i32 (%struct.ITypeInfo*, i32, i32*)*, i32 (%struct.ITypeInfo*, i32, i32*)*, i32 (%struct.ITypeInfo*, i16**, i32, i32*)*, i32 (%struct.ITypeInfo*, i8*, i32, i16, %struct.tagDISPPARAMS*, %struct.tagVARIANT*, %struct.tagEXCEPINFO*, i32*)*, i32 (%struct.ITypeInfo*, i32, i16**, i16**, i32*, i16**)*, i32 (%struct.ITypeInfo*, i32, i32, i16**, i16**, i16*)*, i32 (%struct.ITypeInfo*, i32, %struct.ITypeInfo**)*, i32 (%struct.ITypeInfo*, i32, i32, i8**)*, i32 (%struct.ITypeInfo*, %struct.IUnknown*, %struct._GUID*, i8**)*, i32 (%struct.ITypeInfo*, i32, i16**)*, i32 (%struct.ITypeInfo*, %struct.ITypeLib**, i32*)*, void (%struct.ITypeInfo*, %struct.tagTYPEATTR*)*, void (%struct.ITypeInfo*, %struct.tagFUNCDESC*)*, void (%struct.ITypeInfo*, %struct.tagVARDESC*)* }
    %struct.tagTYPEATTR = type <{ %struct._GUID, i32, i32, i32, i32, i16*, i32, i32, i16, i16, i16, i16, i16, i16, i16, i16, %struct.tagTYPEDESC, %struct.tagIDLDESC }>
    %struct.tagTYPEDESC = type <{ %union.anon, i16, [2 x i8] }>
    %union.anon = type { %struct.tagTYPEDESC* }
    %struct.tagIDLDESC = type { i32, i16 }
    %struct.ITypeComp = type { %struct.ITypeCompVtbl* }
    %struct.ITypeCompVtbl = type { i32 (%struct.ITypeComp*, %struct._GUID*, i8**)*, i32 (%struct.ITypeComp*)*, i32 (%struct.ITypeComp*)*, i32 (%struct.ITypeComp*, i16*, i32, i16, %struct.ITypeInfo**, i32*, %union.tagBINDPTR*)*, i32 (%struct.ITypeComp*, i16*, i32, %struct.ITypeInfo**, %struct.ITypeComp**)* }
    %union.tagBINDPTR = type { %struct.tagFUNCDESC* }
    %struct.tagFUNCDESC = type <{ i32, i32*, %struct.tagELEMDESC*, i32, i32, i32, i16, i16, i16, i16, %struct.tagELEMDESC, i16, [2 x i8] }>
    %struct.tagELEMDESC = type <{ %struct.tagTYPEDESC, %union.anon.0 }>
    %union.anon.0 = type { %struct.tagIDLDESC }
    %struct.tagVARDESC = type <{ i32, i16*, %union.anon.9, %struct.tagELEMDESC, i16, [2 x i8], i32 }>
    %union.anon.9 = type { i32 }
    %struct.tagDISPPARAMS = type { %struct.tagVARIANT*, i32*, i32, i32 }
    %struct.tagVARIANT = type { %union.anon.1 }
    %union.anon.1 = type { %struct.anon }
    %struct.anon = type { i16, i16, i16, i16, %union.anon.2 }
    %union.anon.2 = type { i64 }
    %struct.tagEXCEPINFO = type { i16, i16, i16*, i16*, i16*, i32, i8*, i32 (%struct.tagEXCEPINFO*)*, i32 }
    %struct.IUnknown = type { %struct.IUnknownVtbl* }
    %struct.IUnknownVtbl = type { i32 (%struct.IUnknown*, %struct._GUID*, i8**)*, i32 (%struct.IUnknown*)*, i32 (%struct.IUnknown*)* }
    %struct.ITypeLib = type { %struct.ITypeLibVtbl* }
    %struct.ITypeLibVtbl = type { i32 (%struct.ITypeLib*, %struct._GUID*, i8**)*, i32 (%struct.ITypeLib*)*, i32 (%struct.ITypeLib*)*, i32 (%struct.ITypeLib*)*, i32 (%struct.ITypeLib*, i32, %struct.ITypeInfo**)*, i32 (%struct.ITypeLib*, i32, i32*)*, i32 (%struct.ITypeLib*, %struct._GUID*, %struct.ITypeInfo**)*, i32 (%struct.ITypeLib*, %struct.tagTLIBATTR**)*, i32 (%struct.ITypeLib*, %struct.ITypeComp**)*, i32 (%struct.ITypeLib*, i32, i16**, i16**, i32*, i16**)*, i32 (%struct.ITypeLib*, i16*, i32, i32*)*, i32 (%struct.ITypeLib*, i16*, i32, %struct.ITypeInfo**, i32*, i16*)*, void (%struct.ITypeLib*, %struct.tagTLIBATTR*)* }
    %struct.tagTLIBATTR = type <{ %struct._GUID, i32, i32, i16, i16, i16, [2 x i8] }>
     
    @.str = private unnamed_addr constant [16 x i16] [i16 66, i16 114, i16 111, i16 119, i16 115, i16 101, i16 70, i16 111, i16 114, i16 70, i16 111, i16 108, i16 100, i16 101, i16 114, i16 0], align 2
    @.str1 = private unnamed_addr constant [18 x i16] [i16 83, i16 104, i16 101, i16 108, i16 108, i16 46, i16 65, i16 112, i16 112, i16 108, i16 105, i16 99, i16 97, i16 116, i16 105, i16 111, i16 110, i16 0], align 2
    @IID_IDispatch = external constant %struct._GUID
    @GUID_NULL = external constant %struct._GUID
    @.str2 = private unnamed_addr constant [18 x i16] [i16 72, i16 101, i16 108, i16 108, i16 111, i16 44, i16 32, i16 67, i16 79, i16 77, i16 32, i16 87, i16 111, i16 114, i16 108, i16 100, i16 33, i16 0], align 2
     
    define i32 @main(i32 %argc, i8** nocapture %argv) nounwind {
      %clsid = alloca %struct._GUID, align 4
      %pShell = alloca %struct.IDispatch*, align 4
      %dispid = alloca i32, align 4
      %ptName = alloca i16*, align 4
      %param = alloca %struct.tagDISPPARAMS, align 4
      %varg = alloca [4 x %struct.tagVARIANT], align 8
      %vResult = alloca %struct.tagVARIANT, align 8
      store i16* getelementptr inbounds ([16 x i16]* @.str, i32 0, i32 0), i16** %ptName, align 4, !tbaa !0
      %1 = bitcast %struct.tagDISPPARAMS* %param to i8*
      call void @llvm.memset.p0i8.i32(i8* %1, i8 0, i32 16, i32 4, i1 false)
      %2 = call x86_stdcallcc i32 @CoInitialize(i8* null) nounwind
      %3 = call x86_stdcallcc i32 @CLSIDFromProgID(i16* getelementptr inbounds ([18 x i16]* @.str1, i32 0, i32 0), %struct._GUID* %clsid) nounwind
      %4 = bitcast %struct.IDispatch** %pShell to i8**
      %5 = call x86_stdcallcc i32 @CoCreateInstance(%struct._GUID* %clsid, %struct.IUnknown* null, i32 1, %struct._GUID* @IID_IDispatch, i8** %4) nounwind
      %6 = load %struct.IDispatch** %pShell, align 4, !tbaa !0
      %7 = getelementptr inbounds %struct.IDispatch* %6, i32 0, i32 0
      %8 = load %struct.IDispatchVtbl** %7, align 4, !tbaa !0
      %9 = getelementptr inbounds %struct.IDispatchVtbl* %8, i32 0, i32 5
      %10 = load i32 (%struct.IDispatch*, %struct._GUID*, i16**, i32, i32, i32*)** %9, align 4, !tbaa !0
      %11 = call x86_stdcallcc i32 @GetUserDefaultLCID() nounwind
      %12 = call x86_stdcallcc i32 %10(%struct.IDispatch* %6, %struct._GUID* @GUID_NULL, i16** %ptName, i32 1, i32 %11, i32* %dispid) nounwind
      %13 = getelementptr inbounds [4 x %struct.tagVARIANT]* %varg, i32 0, i32 0
      call x86_stdcallcc void @VariantInit(%struct.tagVARIANT* %13) nounwind
      %14 = getelementptr inbounds [4 x %struct.tagVARIANT]* %varg, i32 0, i32 0, i32 0, i32 0, i32 0
      store i16 3, i16* %14, align 8, !tbaa !3
      %15 = getelementptr inbounds [4 x %struct.tagVARIANT]* %varg, i32 0, i32 0, i32 0, i32 0, i32 4
      %16 = bitcast %union.anon.2* %15 to i32*
      store i32 36, i32* %16, align 8, !tbaa !4
      %17 = getelementptr inbounds [4 x %struct.tagVARIANT]* %varg, i32 0, i32 1
      call x86_stdcallcc void @VariantInit(%struct.tagVARIANT* %17) nounwind
      %18 = getelementptr inbounds %struct.tagVARIANT* %17, i32 0, i32 0, i32 0, i32 0
      store i16 3, i16* %18, align 8, !tbaa !3
      %19 = getelementptr inbounds [4 x %struct.tagVARIANT]* %varg, i32 0, i32 1, i32 0, i32 0, i32 4
      %20 = bitcast %union.anon.2* %19 to i32*
      store i32 0, i32* %20, align 8, !tbaa !4
      %21 = getelementptr inbounds [4 x %struct.tagVARIANT]* %varg, i32 0, i32 2
      call x86_stdcallcc void @VariantInit(%struct.tagVARIANT* %21) nounwind
      %22 = getelementptr inbounds %struct.tagVARIANT* %21, i32 0, i32 0, i32 0, i32 0
      store i16 8, i16* %22, align 8, !tbaa !3
      %23 = call x86_stdcallcc i16* @SysAllocString(i16* getelementptr inbounds ([18 x i16]* @.str2, i32 0, i32 0)) nounwind
      %24 = getelementptr inbounds [4 x %struct.tagVARIANT]* %varg, i32 0, i32 2, i32 0, i32 0, i32 4
      %25 = bitcast %union.anon.2* %24 to i16**
      store i16* %23, i16** %25, align 8, !tbaa !0
      %26 = getelementptr inbounds [4 x %struct.tagVARIANT]* %varg, i32 0, i32 3
      call x86_stdcallcc void @VariantInit(%struct.tagVARIANT* %26) nounwind
      %27 = getelementptr inbounds %struct.tagVARIANT* %26, i32 0, i32 0, i32 0, i32 0
      store i16 3, i16* %27, align 8, !tbaa !3
      %28 = getelementptr inbounds [4 x %struct.tagVARIANT]* %varg, i32 0, i32 3, i32 0, i32 0, i32 4
      %29 = bitcast %union.anon.2* %28 to i32*
      store i32 0, i32* %29, align 8, !tbaa !4
      %30 = getelementptr inbounds %struct.tagDISPPARAMS* %param, i32 0, i32 2
      store i32 4, i32* %30, align 4, !tbaa !5
      %31 = getelementptr inbounds %struct.tagDISPPARAMS* %param, i32 0, i32 0
      store %struct.tagVARIANT* %13, %struct.tagVARIANT** %31, align 4, !tbaa !0
      %32 = load %struct.IDispatch** %pShell, align 4, !tbaa !0
      %33 = getelementptr inbounds %struct.IDispatch* %32, i32 0, i32 0
      %34 = load %struct.IDispatchVtbl** %33, align 4, !tbaa !0
      %35 = getelementptr inbounds %struct.IDispatchVtbl* %34, i32 0, i32 6
      %36 = load i32 (%struct.IDispatch*, i32, %struct._GUID*, i32, i16, %struct.tagDISPPARAMS*, %struct.tagVARIANT*, %struct.tagEXCEPINFO*, i32*)** %35, align 4, !tbaa !0
      %37 = load i32* %dispid, align 4, !tbaa !4
      %38 = call x86_stdcallcc i32 @GetUserDefaultLCID() nounwind
      %39 = call x86_stdcallcc i32 %36(%struct.IDispatch* %32, i32 %37, %struct._GUID* @GUID_NULL, i32 %38, i16 zeroext 1, %struct.tagDISPPARAMS* %param, %struct.tagVARIANT* %vResult, %struct.tagEXCEPINFO* null, i32* null) nounwind
      call x86_stdcallcc void @VariantInit(%struct.tagVARIANT* %13) nounwind
      call x86_stdcallcc void @VariantInit(%struct.tagVARIANT* %17) nounwind
      call x86_stdcallcc void @VariantInit(%struct.tagVARIANT* %21) nounwind
      call x86_stdcallcc void @VariantInit(%struct.tagVARIANT* %26) nounwind
      %40 = getelementptr inbounds %struct.tagVARIANT* %vResult, i32 0, i32 0, i32 0, i32 4
      %41 = bitcast %union.anon.2* %40 to %struct.IDispatch**
      %42 = load %struct.IDispatch** %41, align 8, !tbaa !0
      %43 = icmp eq %struct.IDispatch* %42, null
      br i1 %43, label %50, label %44
     
    ; <label>:44                                      ; preds = %0
      %45 = getelementptr inbounds %struct.IDispatch* %42, i32 0, i32 0
      %46 = load %struct.IDispatchVtbl** %45, align 4, !tbaa !0
      %47 = getelementptr inbounds %struct.IDispatchVtbl* %46, i32 0, i32 2
      %48 = load i32 (%struct.IDispatch*)** %47, align 4, !tbaa !0
      %49 = call x86_stdcallcc i32 %48(%struct.IDispatch* %42) nounwind
      br label %50
     
    ; <label>:50                                      ; preds = %0, %44
      %51 = load %struct.IDispatch** %pShell, align 4, !tbaa !0
      %52 = getelementptr inbounds %struct.IDispatch* %51, i32 0, i32 0
      %53 = load %struct.IDispatchVtbl** %52, align 4, !tbaa !0
      %54 = getelementptr inbounds %struct.IDispatchVtbl* %53, i32 0, i32 2
      %55 = load i32 (%struct.IDispatch*)** %54, align 4, !tbaa !0
      %56 = call x86_stdcallcc i32 %55(%struct.IDispatch* %51) nounwind
      call x86_stdcallcc void @CoUninitialize() nounwind
      ret i32 0
    }
     
    declare void @llvm.memset.p0i8.i32(i8* nocapture, i8, i32, i32, i1) nounwind
     
    declare x86_stdcallcc i32 @CoInitialize(i8*)
     
    declare x86_stdcallcc i32 @CLSIDFromProgID(i16*, %struct._GUID*)
     
    declare x86_stdcallcc i32 @CoCreateInstance(%struct._GUID*, %struct.IUnknown*, i32, %struct._GUID*, i8**)
     
    declare x86_stdcallcc i32 @GetUserDefaultLCID()
     
    declare x86_stdcallcc void @VariantInit(%struct.tagVARIANT*)
     
    declare x86_stdcallcc i16* @SysAllocString(i16*)
     
    declare x86_stdcallcc void @CoUninitialize()
     
    !0 = metadata !{metadata !"any pointer", metadata !1}
    !1 = metadata !{metadata !"omnipotent char", metadata !2}
    !2 = metadata !{metadata !"Simple C/C++ TBAA"}
    !3 = metadata !{metadata !"short", metadata !1}
    !4 = metadata !{metadata !"long", metadata !1}
    !5 = metadata !{metadata !"int", metadata !1}

    上記コードは以下のC言語のソースを clang でアセンブリコード出力(clang -S -O4 hello.c)したものに相当する。

    #include <ole2.h>
     
    int main( int argc, char* argv[] )
    {
        CLSID clsid;
        IDispatch* pShell;
        IDispatch* pFolder;
        DISPID dispid;
        OLECHAR* ptName = L"BrowseForFolder";
        DISPPARAMS param = { NULL, NULL, 0, 0 };
        VARIANT varg[4];
        VARIANT vResult;
     
        CoInitialize( NULL );
     
        CLSIDFromProgID(L"Shell.Application", &clsid );
        CoCreateInstance( &clsid, NULL, CLSCTX_INPROC_SERVER, &IID_IDispatch, (void**)&pShell);
        pShell->lpVtbl->GetIDsOfNames( (void*)pShell, &IID_NULL, &ptName, 1, GetUserDefaultLCID(), &dispid );
     
        VariantInit( &varg[0] );
        varg[0].vt = VT_I4;
        varg[0].lVal = 36L;  /* ssfWINDOWS */
     
        VariantInit( &varg[1] );
        varg[1].vt = VT_I4;
        varg[1].lVal = 0L;
     
        VariantInit( &varg[2] );
        varg[2].vt = VT_BSTR;
        varg[2].bstrVal = SysAllocString(L"Hello, COM World!"); 
     
        VariantInit( &varg[3] );
        varg[3].vt = VT_I4;
        varg[3].lVal = 0L;
     
        param.cArgs = 4;
        param.rgvarg = varg;
     
        pShell->lpVtbl->Invoke( (void*)pShell, dispid, &IID_NULL, GetUserDefaultLCID(), DISPATCH_METHOD, &param, &vResult, NULL, NULL );
     
        VariantInit( &varg[0] );
        VariantInit( &varg[1] );
        VariantInit( &varg[2] );
        VariantInit( &varg[3] );
     
        pFolder = V_DISPATCH( &vResult );
        if ( pFolder != NULL )
        {
            pFolder->lpVtbl->Release( (void*)pFolder );
        }
        pShell->lpVtbl->Release( (void*)pShell );
     
        CoUninitialize();
     
        return 0;
    }

    コンパイル&リンク方法

    C:¥> clang -o hello hello.ll -l ole32  -l oleaut32 -l uuid

    実行結果

    +----------------------------------------+
    |Browse For Folder                    [X]|
    +----------------------------------------+
    | Hello, COM Wolrd!                      |
    |                                        |
    | +------------------------------------+ |
    | |[Windows]                           | |
    | | +[addins]                          | |
    | | +[AppCompat]                       | |
    | | +[AppPatch]                        | |
    | | +[assembly]                        | |
    | |     :                              | |
    | |     :                              | |
    | |     :                              | |
    | +------------------------------------+ |
    | [Make New Folder]    [  OK  ] [Cancel] |
    +----------------------------------------+
  2. Hello, COM(Objective-C) World!

    Posted on 3月 16th, 2013 by cx20

    COM(Objective-C)

    COM(Component Object Model)はマイクロソフトの提唱するプログラム部品の仕様である。
    COM を用いて開発された部品であれば言語を問わず利用することができる。
    以下は MinGW 版 Objective-C による COM クライアントの例となっている。

    ソースコード

    #import <windows.h>
    #import <ole2.h>
    #import <objc/Object.h>
     
    @interface Hello : Object
    - (void) sayHello;
    @end
     
    @implementation Hello
    - (void) sayHello {
        CLSID clsid;
        IDispatch* pShell;
        IDispatch* pFolder;
        DISPID dispid;
        OLECHAR* ptName = L"BrowseForFolder";
        DISPPARAMS param = { NULL, NULL, 0, 0 };
        VARIANT varg[4];
        VARIANT vResult;
     
        CoInitialize( NULL );
     
        CLSIDFromProgID(L"Shell.Application", &clsid );
        CoCreateInstance( &clsid, NULL, CLSCTX_INPROC_SERVER, &IID_IDispatch, (void**)&pShell);
        pShell->lpVtbl->GetIDsOfNames( (void*)pShell, &IID_NULL, &ptName, 1, GetUserDefaultLCID(), &dispid );
     
        VariantInit( &varg[0] );
        varg[0].vt = VT_I4;
        varg[0].lVal = 36L;  /* ssfWINDOWS */
     
        VariantInit( &varg[1] );
        varg[1].vt = VT_I4;
        varg[1].lVal = 0L;
     
        VariantInit( &varg[2] );
        varg[2].vt = VT_BSTR;
        varg[2].bstrVal = SysAllocString(L"Hello, COM World!"); 
     
        VariantInit( &varg[3] );
        varg[3].vt = VT_I4;
        varg[3].lVal = 0L;
     
        param.cArgs = 4;
        param.rgvarg = varg;
     
        pShell->lpVtbl->Invoke( (void*)pShell, dispid, &IID_NULL, GetUserDefaultLCID(), DISPATCH_METHOD, &param, &vResult, NULL, NULL );
     
        VariantInit( &varg[0] );
        VariantInit( &varg[1] );
        VariantInit( &varg[2] );
        VariantInit( &varg[3] );
     
        pFolder = V_DISPATCH( &vResult );
        if ( pFolder != NULL )
        {
            pFolder->lpVtbl->Release( (void*)pFolder );
        }
        pShell->lpVtbl->Release( (void*)pShell );
     
        CoUninitialize();
    }
    @end
     
    int main(int argc, char *argv[]) {
        id obj = [ Hello alloc ];
        [ obj sayHello ];
     
        return 0;
    }

    実行方法

    C:¥> gcc -o hello hello.m -l objc -l ole32  -l oleaut32 -l uuid

    実行結果

    +----------------------------------------+
    |Browse For Folder                    [X]|
    +----------------------------------------+
    | Hello, COM(Objective-C) Wolrd!         |
    |                                        |
    | +------------------------------------+ |
    | |[Windows]                           | |
    | | +[addins]                          | |
    | | +[AppCompat]                       | |
    | | +[AppPatch]                        | |
    | | +[assembly]                        | |
    | |     :                              | |
    | |     :                              | |
    | |     :                              | |
    | +------------------------------------+ |
    | [Make New Folder]    [  OK  ] [Cancel] |
    +----------------------------------------+
  3. Hello, COM(Tcl) World!

    Posted on 3月 15th, 2013 by cx20

    COM(Tcl)

    COM(Component Object Model)はマイクロソフトの提唱するプログラム部品の仕様である。
    COM を用いて開発された部品であれば言語を問わず利用することができる。
    以下は Tcl にて TWAPI ならび tcom を用いた COM クライアントの例となっている。

    ソースコード(Tcl + TWAPI)

    package require twapi
    set shell [twapi::comobj "Shell.Application"]
    set folder [$shell BrowseForFolder  0 "Hello, COM(Tcl) World!" 0 36 ]

    ソースコード(Tcl + tcom)

    package require tcom
    set shell [::tcom::ref createobject "Shell.Application"]
    set folder [$shell BrowseForFolder  0 "Hello, COM(Tcl) World!" 0 36 ]

    実行方法

    C:¥> tclsh hello.tcl

    実行結果

    +----------------------------------------+
    |Browse For Folder                    [X]|
    +----------------------------------------+
    | Hello, COM(Tcl) Wolrd!                 |
    |                                        |
    | +------------------------------------+ |
    | |[Windows]                           | |
    | | +[addins]                          | |
    | | +[AppCompat]                       | |
    | | +[AppPatch]                        | |
    | | +[assembly]                        | |
    | |     :                              | |
    | |     :                              | |
    | |     :                              | |
    | +------------------------------------+ |
    | [Make New Folder]    [  OK  ] [Cancel] |
    +----------------------------------------+
  4. Hello, Win32 API(GAS) World!

    Posted on 3月 14th, 2013 by cx20

    Win32 API(GAS)

    Win32 API は、Windows の機能にアクセスする為の API(Application Programming Interface)である。
    以下は GAS からの呼出し例である。

    ソースコード(GAS)

            .file   "hello.c"
            .def    ___main;        .scl    2;      .type   32;     .endef
            .section .rdata,"dr"
    LC0:
            .ascii "Hello, World!

    上記コードは、下記の C のソースを MinGW版 GCC にてアセンブリコード出力(gcc -S hello.c)したものである。

    ソースコード(C言語)

    #include <windows.h>
     
    int main( int argc, char* argv[] )
    {
        MessageBox( NULL, "Hello, Win32 API World!", "Hello, World!", MB_OK );
        return 0;
    }

    コンパイル方法(MinGW版 gcc)

    C:¥> gcc -c hello.s
    C:¥> gcc -o hello hello.o

    実行結果

    ---------------------------
    Hello, World!
    ---------------------------
    Hello, Win32 API World!
    ---------------------------
    OK   
    ---------------------------
  5. Hello, Win32 API(LLVM) World!

    Posted on 3月 13th, 2013 by cx20

    Win32 API(LLVM)

    Win32 API は、Windows の機能にアクセスする為の API(Application Programming Interface)である。
    以下は LLVM Assembler による呼出し例である。

    ソースコード(LLVM)

    ; ModuleID = 'hello.c'
    target datalayout = "e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-f80:128:128-v64:64:64-v128:128:128-a0:0:64-f80:32:32-n8:16:32-S32"
    target triple = "i686-w64-mingw32"
     
    %struct.HWND__ = type { i32 }
     
    @.str = private unnamed_addr constant [24 x i8] c"Hello, Win32 API World!

    上記コードは、下記の C のソースを clang にてアセンブリコード出力(clang -S -O4 hello.c)したものである。

    ソースコード(C言語)

    #include <windows.h>
     
    int main( int argc, char* argv[] )
    {
        MessageBox( NULL, "Hello, Win32 API World!", "Hello, World!", MB_OK );
        return 0;
    }

    コンパイル方法(MinGW版 clang)

    C:¥> clang -o hello hello.ll

    実行結果

    ---------------------------
    Hello, World!
    ---------------------------
    Hello, Win32 API World!
    ---------------------------
    OK   
    ---------------------------
  6. Hello, Win32 API(Objective-C) World!

    Posted on 3月 12th, 2013 by cx20

    Win32 API(Objective-C)

    Win32 API は、Windows の機能にアクセスする為の API(Application Programming Interface)である。
    以下は MinGW 版 Objective-C による呼出し例である。

    ソースコード

    #import <windows.h>
     
    int main( int argc, char* argv[] )
    {
        MessageBox( NULL, "Hello, Win32 API World!", "Hello, World!", MB_OK );
        return 0;
    }

    コンパイル方法(MinGW Objective-C)

    C:¥> gcc -o hello hello.c -l objc

    実行結果

    ---------------------------
    Hello, World!
    ---------------------------
    Hello, Win32 API World!
    ---------------------------
    OK   
    ---------------------------
  7. Hello, Win32 API(Tcl) World!

    Posted on 3月 11th, 2013 by cx20

    Win32 API(Tcl)

    Win32 API は、Windows の機能にアクセスする為の API(Application Programming Interface)である。
    以下は Tcl にて Ffidl を使用した Win32 API 呼出しの例となっている。

    ソースコード

    load Ffidl06.dll
    ffidl::callout dll_MessageBox {int pointer-utf8 pointer-utf8 int} int [ffidl::symbol user32.dll MessageBoxA]
    dll_MessageBox 0 "Hello, Win32 API World!" "Hello, World!" 0

    実行方法

    C:¥> tclsh Hello.tcl

    実行結果

    ---------------------------
    Hello, World!
    ---------------------------
    Hello, Win32 API World!
    ---------------------------
    OK   
    ---------------------------
  8. Hello, Win32 API(Common Lisp) World!

    Posted on 3月 10th, 2013 by cx20

    Win32 API(Common Lisp)

    Win32 API は、Windows の機能にアクセスする為の API(Application Programming Interface)である。
    以下は Common Lisp にて FFI を使用した Win32 API 呼出しの例となっている。

    ソースコード

    (defpackage "WIN32"
      (:modern t)
      (:use "FFI")
      (:shadowing-import-from "EXPORTING"
        #:defconstant #:defun #:defmacro
        #:def-c-type #:def-c-enum #:def-c-struct #:def-c-var #:def-call-out))
     
    (in-package "WIN32")
     
    (default-foreign-language :stdc-stdcall) ; WINAPI means __stdcall
     
    (def-c-type handle c-pointer)
    (def-c-type dword uint32)
    (def-c-type word uint16)
     
    (default-foreign-library "user32.dll")
     
    (defconstant MB_OK 0)
     
    (def-call-out MessageBoxA (:return-type int)
      (:arguments (parent handle) (text c-string) (caption c-string) (type uint)))
     
    (win32:MessageBoxA nil "Hello, Win32 API World!" "Hello, World!" win32:MB_OK)

    実行方法

    C:¥> clisp Hello.lisp

    実行結果

    ---------------------------
    Hello, World!
    ---------------------------
    Hello, Win32 API World!
    ---------------------------
    OK   
    ---------------------------
  9. Hello, Win32 API(OCaml) World!

    Posted on 3月 9th, 2013 by cx20

    Win32 API(OCaml)

    Win32 API は、Windows の機能にアクセスする為の API(Application Programming Interface)である。
    以下は OCaml による Win32 API 呼出しの例となっている。

    ソースコード(C言語)

    #include <stdio.h>
    #include <windows.h>
    #include <caml/memory.h>
    #include <caml/mlvalues.h>
     
    #define Is_nil(v) ((v) == Val_int(0))
    #define Head(v) (Field((v), 0))
    #define Tail(v) (Field((v), 1))
     
    #define Declare_constants(name) 
        extern DWORD name[]; 
        extern int num_##name
     
    #define Define_constants(name) 
        int num_##name = sizeof(name) / sizeof(DWORD)
     
    #define Constant_val(val, constants) (constants[Int_val(val)])
     
    #define Handle_val(v) (*((HANDLE*)(v)))
    value alloc_handle(HANDLE h);
     
    value val_constant_with_count(DWORD constant, int num_constants, DWORD* constants);
     
    #define Val_constant(constant, constants) 
        (val_constant_with_count((constant), num_##constants, constants))
     
    Declare_constants(standard_control_ids);
     
    DWORD standard_control_ids[] = {
        IDABORT,
        IDCANCEL,
        IDCLOSE,
        IDHELP,
        IDIGNORE,
        IDNO,
        IDOK,
        IDRETRY,
        IDYES
    };
    Define_constants(standard_control_ids);
     
    DWORD message_box_options[] = {
        MB_ABORTRETRYIGNORE,
        MB_APPLMODAL,
        MB_DEFAULT_DESKTOP_ONLY,
        MB_DEFBUTTON1,
        MB_DEFBUTTON2,
        MB_DEFBUTTON3,
        MB_DEFBUTTON4,
        MB_HELP,
        MB_ICONASTERISK,
        MB_ICONERROR,
        MB_ICONEXCLAMATION,
        MB_ICONHAND,
        MB_ICONINFORMATION,
        MB_ICONQUESTION,
        MB_ICONSTOP,
        MB_ICONWARNING,
        MB_OK,
        MB_OKCANCEL,
        MB_RETRYCANCEL,
        MB_RIGHT,
        MB_RTLREADING,
        MB_SETFOREGROUND,
        MB_SYSTEMMODAL,
        MB_TASKMODAL,
        MB_TOPMOST,
        MB_YESNO,
        MB_YESNOCANCEL
    };
     
    value val_constant_with_count(DWORD constant, int num_constants, DWORD* constants)
    {
        int i;
     
        for (i = 0; i < num_constants; ++i)
            if (constants[i] == constant)
                return Val_int(i);
        failwith("Invalid constant");
        return Val_int(0);
    }
     
    CAMLprim value get_null_hwnd(value unit)
    {
        return alloc_handle(NULL);
    }
     
    value alloc_handle(HANDLE h)
    {
        value val;
     
        val = alloc_small(sizeof(HANDLE) / sizeof(value), Abstract_tag);
        Handle_val(val) = h;
        return val;
    }
     
    DWORD flags_val(value list, DWORD* constants)
    {
        int result;
     
        result = 0;
        for (; !Is_nil(list); list = Tail(list))
            result |= Constant_val(Head(list), constants);
        return result;
    }
     
    char* new_string(value v)
    {
        return strdup(String_val(v));
    }
     
    void free_string(char* s)
    {
        free(s);
    }
     
    static value* win32_error_exception = NULL;
     
    void raise_win32_error(DWORD error)
    {
        if (win32_error_exception == NULL)
            win32_error_exception = caml_named_value("win32 error");
        raise_with_arg(*win32_error_exception, Val_int((int)error));
    }
     
    void raise_last_error(void)
    {
        raise_win32_error(GetLastError());
    }
     
    CAMLprim value message_box(value wnd, value text, value caption, value type)
    {
        CAMLparam4(wnd, text, caption, type);
        HWND hwnd;
        char* txt;
        char* capt;
        UINT typ;
        int result;
     
        hwnd = Handle_val(wnd);
        txt = new_string(text);
        capt = new_string(caption);
        typ = flags_val(type, message_box_options);
        enter_blocking_section();
        result = MessageBox(hwnd, txt, capt, typ);
        leave_blocking_section();
        free_string(txt);
        free_string(capt);
        if (result == 0)
            raise_last_error();
        CAMLreturn(Val_constant(result, standard_control_ids));
    }

    ソースコード(OCaml)

    type hwnd
     
    type message_box_option =
        MB_ABORTRETRYIGNORE
      | MB_APPLMODAL
      | MB_DEFAULT_DESKTOP_ONLY
      | MB_DEFBUTTON1
      | MB_DEFBUTTON2
      | MB_DEFBUTTON3
      | MB_DEFBUTTON4
      | MB_HELP
      | MB_ICONASTERISK
      | MB_ICONERROR
      | MB_ICONEXCLAMATION
      | MB_ICONHAND
      | MB_ICONINFORMATION
      | MB_ICONQUESTION
      | MB_ICONSTOP
      | MB_ICONWARNING
      | MB_OK
      | MB_OKCANCEL
      | MB_RETRYCANCEL
      | MB_RIGHT
      | MB_RTLREADING
      | MB_SETFOREGROUND
      | MB_SYSTEMMODAL
      | MB_TASKMODAL
      | MB_TOPMOST
      | MB_YESNO
      | MB_YESNOCANCEL
     
    type standard_control_id =
        IDABORT
      | IDCANCEL
      | IDCLOSE
      | IDHELP
      | IDIGNORE
      | IDNO
      | IDOK
      | IDRETRY
      | IDYES
     
    external get_null_hwnd : unit -> hwnd = "get_null_hwnd"
    let null_hwnd = get_null_hwnd ()
     
    external message_box :
        wnd:hwnd ->
        text:string ->
        caption:string ->
        options:message_box_option list ->
        standard_control_id = "message_box"
     
    let () =
      ignore ( message_box ~wnd:null_hwnd ~text:"Hello, Win32 API World!" ~caption:"Hello, World!" ~options:[MB_OK] );

    実行方法

    C:¥> ocamlopt -o hello.exe hello.ml hello_stubs.c

    実行結果

    ---------------------------
    Hello, World!
    ---------------------------
    Hello, Win32 API World!
    ---------------------------
    OK   
    ---------------------------
  10. Hello, Win32 API(Scheme) World!

    Posted on 3月 8th, 2013 by cx20

    Win32 API(Scheme)

    Win32 API は、Windows の機能にアクセスする為の API(Application Programming Interface)である。
    以下は Scheme 実装の1つである Gauche による Win32 API 呼出しの例となっている。

    ソースコード

    (use os.windows)
     
    (define (main args)
      (sys-message-box #f "Hello, Win32 API World!" "Hello, World!" MB_OK)
      0)

    実行方法

    C:¥> gosh Hello.scm

    実行結果

    ---------------------------
    Hello, World!
    ---------------------------
    Hello, Win32 API World!
    ---------------------------
    OK   
    ---------------------------