Windows API support
Shaping
shaping1 at bellsouth.net
Tue Jan 4 19:27:33 PST 2005
Very Nice.
Suggestion:
Change
l lookup: 'MessageBoxA'
to read
l functionNamed: 'MessageBoxA'.
Shaping
----- Original Message -----
From: "Todd Fleming" <todd at flemingcnc.com>
To: "Slate project discussion" <slate at tunes.org>
Sent: Tuesday, January 04, 2005 19:33
Subject: Windows API support
> Here is my updated patch for Windows __stdcall support. I also attached
> my VS 2003 project files (slate/src/mobius/vm/platform/windows).
>
> Example use:
> [| l f |
> l: (ExternalLibrary newNamed: 'User32').
> f: (l lookup: 'MessageBoxA').
> f argumentsFormat:
> {
> ExternalMethod ArgumentFormat Int.
> ExternalMethod ArgumentFormat Bytes.
> ExternalMethod ArgumentFormat Bytes.
> ExternalMethod ArgumentFormat Int.
> }.
> f callFormat: ExternalMethod CallFormat Std.
> (f applyTo: {0 'Hello from Slate!\0' 'My Dialog\0' 0}).
> ] do.
>
> The call format defaults to cdecl.
>
> Todd
>
>
--------------------------------------------------------------------------------
> Index: src/lib/extlib.slate
> ===================================================================
> RCS file: /var/lib/cvs/slate/slate/src/lib/extlib.slate,v
> retrieving revision 1.5
> diff -u -r1.5 extlib.slate
> --- src/lib/extlib.slate 1 Jan 2005 02:52:14 -0000 1.5
> +++ src/lib/extlib.slate 5 Jan 2005 00:14:05 -0000
> @@ -14,9 +14,15 @@
> #Boolean -> 5.
> } do: [| :assoc | ExternalMethod ArgumentFormat addImmutableSlot: assoc key
> valued: assoc value].
>
> +ExternalMethod traits ensureNamespace: #CallFormat.
> +{ #C -> 0.
> + #Std -> 1.
> +} do: [| :assoc | ExternalMethod CallFormat addImmutableSlot: assoc key
> valued: assoc value].
> +
> ExternalMethod addSlot: #library valued: Nil.
> ExternalMethod addSlot: #name valued: Nil.
> ExternalMethod addSlot: #argumentsFormat valued: {}.
> +ExternalMethod addSlot: #callFormat valued: ExternalMethod CallFormat C.
> ExternalMethod addSlot: #resultFormat valued: ExternalMethod ArgumentFormat
> Void.
>
> d@(ExternalLibrary traits) newNamed: libName
> @@ -77,5 +83,5 @@
>
> m@(ExternalMethod traits) applyTo: args
> [
> - m library primitiveApply: m handle accepting: m argumentsFormat returning:
> m resultFormat to: args
> + m library primitiveApply: m handle accepting: m argumentsFormat callFormat:
> m callFormat returning: m resultFormat to: args
> ].
> Index: src/mobius/vm/ext/extprim.slate
> ===================================================================
> RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/ext/extprim.slate,v
> retrieving revision 1.2
> diff -u -r1.2 extprim.slate
> --- src/mobius/vm/ext/extprim.slate 2 Nov 2004 21:35:00 -0000 1.2
> +++ src/mobius/vm/ext/extprim.slate 5 Jan 2005 00:14:05 -0000
> @@ -23,9 +23,9 @@
> ifFalse: [interpreter pushFalse].
> ] `pidginPrimitive.
>
> -p at ExternalLibraryTraits primitiveApply: ptr at ByteArrayTraits accepting:
> argsFormat returning: resultFormat to: args at ArrayTraits
> +p at ExternalLibraryTraits primitiveApply: ptr at ByteArrayTraits accepting:
> argsFormat callFormat: callFormat returning: resultFormat to: args at ArrayTraits
> [
> interpreter stackPush:
> - ('applyExternalLibraryPrimitive((struct ByteArray *) ptr, (struct
> OopArray *) argsFormat, resultFormat, (struct OopArray *) args)'
> + ('applyExternalLibraryPrimitive((struct ByteArray *) ptr, (struct
> OopArray *) argsFormat, callFormat, resultFormat, (struct OopArray *) args)'
> directly!ObjectPointer).
> ] `pidginPrimitive.
> Index: src/mobius/vm/platform/extprim.c
> ===================================================================
> RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/platform/extprim.c,v
> retrieving revision 1.6
> diff -u -r1.6 extprim.c
> --- src/mobius/vm/platform/extprim.c 15 Dec 2004 23:29:50 -0000 1.6
> +++ src/mobius/vm/platform/extprim.c 5 Jan 2005 00:14:06 -0000
> @@ -15,7 +15,30 @@
> typedef unsigned (* ext_fn11_t) (unsigned, unsigned, unsigned, unsigned,
> unsigned, unsigned, unsigned, unsigned, unsigned, unsigned, unsigned);
> typedef unsigned (* ext_fn12_t) (unsigned, unsigned, unsigned, unsigned,
> unsigned, unsigned, unsigned, unsigned, unsigned, unsigned, unsigned,
> unsigned);
>
> -ObjectPointer applyExternalLibraryPrimitive (struct ByteArray * fnHandle,
> struct OopArray * argsFormat, ObjectPointer resultFormat, struct OopArray *
> argsArr)
> +#ifndef _WIN32
> +# define __stdcall
> +#endif
> +
> +typedef unsigned (__stdcall * ext_std_fn0_t) (void);
> +typedef unsigned (__stdcall * ext_std_fn1_t) (unsigned);
> +typedef unsigned (__stdcall * ext_std_fn2_t) (unsigned, unsigned);
> +typedef unsigned (__stdcall * ext_std_fn3_t) (unsigned, unsigned, unsigned);
> +typedef unsigned (__stdcall * ext_std_fn4_t) (unsigned, unsigned, unsigned,
> unsigned);
> +typedef unsigned (__stdcall * ext_std_fn5_t) (unsigned, unsigned, unsigned,
> unsigned, unsigned);
> +typedef unsigned (__stdcall * ext_std_fn6_t) (unsigned, unsigned, unsigned,
> unsigned, unsigned, unsigned);
> +typedef unsigned (__stdcall * ext_std_fn7_t) (unsigned, unsigned, unsigned,
> unsigned, unsigned, unsigned, unsigned);
> +typedef unsigned (__stdcall * ext_std_fn8_t) (unsigned, unsigned, unsigned,
> unsigned, unsigned, unsigned, unsigned, unsigned);
> +typedef unsigned (__stdcall * ext_std_fn9_t) (unsigned, unsigned, unsigned,
> unsigned, unsigned, unsigned, unsigned, unsigned, unsigned);
> +typedef unsigned (__stdcall * ext_std_fn10_t) (unsigned, unsigned, unsigned,
> unsigned, unsigned, unsigned, unsigned, unsigned, unsigned, unsigned);
> +typedef unsigned (__stdcall * ext_std_fn11_t) (unsigned, unsigned, unsigned,
> unsigned, unsigned, unsigned, unsigned, unsigned, unsigned, unsigned,
> unsigned);
> +typedef unsigned (__stdcall * ext_std_fn12_t) (unsigned, unsigned, unsigned,
> unsigned, unsigned, unsigned, unsigned, unsigned, unsigned, unsigned,
> unsigned, unsigned);
> +
> +ObjectPointer applyExternalLibraryPrimitive (
> + struct ByteArray * fnHandle,
> + struct OopArray * argsFormat,
> + ObjectPointer callFormat,
> + ObjectPointer resultFormat,
> + struct OopArray * argsArr)
> {
> ext_fn0_t fn;
> unsigned args [12];
> @@ -64,50 +87,102 @@
> }
> }
>
> - switch(argCount)
> + if(callFormat == CALL_FORMAT_C)
> {
> - case 0:
> - result = (* (ext_fn0_t) fn) ();
> - break;
> - case 1:
> - result = (* (ext_fn1_t) fn) (args [0]);
> - break;
> - case 2:
> - result = (* (ext_fn2_t) fn) (args [0], args [1]);
> - break;
> - case 3:
> - result = (* (ext_fn3_t) fn) (args [0], args [1], args [2]);
> - break;
> - case 4:
> - result = (* (ext_fn4_t) fn) (args [0], args [1], args [2], args [3]);
> - break;
> - case 5:
> - result = (* (ext_fn5_t) fn) (args [0], args [1], args [2], args [3], args
> [4]);
> - break;
> - case 6:
> - result = (* (ext_fn6_t) fn) (args [0], args [1], args [2], args [3], args
> [4], args [5]);
> - break;
> - case 7:
> - result = (* (ext_fn7_t) fn) (args [0], args [1], args [2], args [3], args
> [4], args [5], args [6]);
> - break;
> - case 8:
> - result = (* (ext_fn8_t) fn) (args [0], args [1], args [2], args [3], args
> [4], args [5], args [6], args [7]);
> - break;
> - case 9:
> - result = (* (ext_fn9_t) fn) (args [0], args [1], args [2], args [3], args
> [4], args [5], args [6], args [7], args [8]);
> - break;
> - case 10:
> - result = (* (ext_fn10_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5], args [6], args [7], args [8], args [9]);
> - break;
> - case 11:
> - result = (* (ext_fn11_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5], args [6], args [7], args [8], args [9], args [10]);
> - break;
> - case 12:
> - result = (* (ext_fn12_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5], args [6], args [7], args [8], args [9], args [10], args
> [11]);
> - break;
> - default:
> - return CurrentMemory -> NilObject;
> + switch(argCount)
> + {
> + case 0:
> + result = (* (ext_fn0_t) fn) ();
> + break;
> + case 1:
> + result = (* (ext_fn1_t) fn) (args [0]);
> + break;
> + case 2:
> + result = (* (ext_fn2_t) fn) (args [0], args [1]);
> + break;
> + case 3:
> + result = (* (ext_fn3_t) fn) (args [0], args [1], args [2]);
> + break;
> + case 4:
> + result = (* (ext_fn4_t) fn) (args [0], args [1], args [2], args [3]);
> + break;
> + case 5:
> + result = (* (ext_fn5_t) fn) (args [0], args [1], args [2], args [3],
> args [4]);
> + break;
> + case 6:
> + result = (* (ext_fn6_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5]);
> + break;
> + case 7:
> + result = (* (ext_fn7_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5], args [6]);
> + break;
> + case 8:
> + result = (* (ext_fn8_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5], args [6], args [7]);
> + break;
> + case 9:
> + result = (* (ext_fn9_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5], args [6], args [7], args [8]);
> + break;
> + case 10:
> + result = (* (ext_fn10_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5], args [6], args [7], args [8], args [9]);
> + break;
> + case 11:
> + result = (* (ext_fn11_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5], args [6], args [7], args [8], args [9], args [10]);
> + break;
> + case 12:
> + result = (* (ext_fn12_t) fn) (args [0], args [1], args [2], args [3],
> args [4], args [5], args [6], args [7], args [8], args [9], args [10], args
> [11]);
> + break;
> + default:
> + return CurrentMemory -> NilObject;
> + }
> }
> + else if(callFormat == CALL_FORMAT_STD)
> + {
> + switch(argCount)
> + {
> + case 0:
> + result = (* (ext_std_fn0_t) fn) ();
> + break;
> + case 1:
> + result = (* (ext_std_fn1_t) fn) (args [0]);
> + break;
> + case 2:
> + result = (* (ext_std_fn2_t) fn) (args [0], args [1]);
> + break;
> + case 3:
> + result = (* (ext_std_fn3_t) fn) (args [0], args [1], args [2]);
> + break;
> + case 4:
> + result = (* (ext_std_fn4_t) fn) (args [0], args [1], args [2], args
> [3]);
> + break;
> + case 5:
> + result = (* (ext_std_fn5_t) fn) (args [0], args [1], args [2], args
> [3], args [4]);
> + break;
> + case 6:
> + result = (* (ext_std_fn6_t) fn) (args [0], args [1], args [2], args
> [3], args [4], args [5]);
> + break;
> + case 7:
> + result = (* (ext_std_fn7_t) fn) (args [0], args [1], args [2], args
> [3], args [4], args [5], args [6]);
> + break;
> + case 8:
> + result = (* (ext_std_fn8_t) fn) (args [0], args [1], args [2], args
> [3], args [4], args [5], args [6], args [7]);
> + break;
> + case 9:
> + result = (* (ext_std_fn9_t) fn) (args [0], args [1], args [2], args
> [3], args [4], args [5], args [6], args [7], args [8]);
> + break;
> + case 10:
> + result = (* (ext_std_fn10_t) fn) (args [0], args [1], args [2], args
> [3], args [4], args [5], args [6], args [7], args [8], args [9]);
> + break;
> + case 11:
> + result = (* (ext_std_fn11_t) fn) (args [0], args [1], args [2], args
> [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10]);
> + break;
> + case 12:
> + result = (* (ext_std_fn12_t) fn) (args [0], args [1], args [2], args
> [3], args [4], args [5], args [6], args [7], args [8], args [9], args [10],
> args [11]);
> + break;
> + default:
> + return CurrentMemory -> NilObject;
> + }
> + }
> + else
> + return CurrentMemory -> NilObject;
>
> switch (resultFormat)
> {
> Index: src/mobius/vm/platform/includes/extprim.h
> ===================================================================
> RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/platform/includes/extprim.h,v
> retrieving revision 1.3
> diff -u -r1.3 extprim.h
> --- src/mobius/vm/platform/includes/extprim.h 15 Dec 2004 23:30:42 -0000 1.3
> +++ src/mobius/vm/platform/includes/extprim.h 5 Jan 2005 00:14:06 -0000
> @@ -18,6 +18,12 @@
> ARG_FORMAT_BOOLEAN = (5 << 1) | 1
> };
>
> +enum CallFormat
> +{
> + CALL_FORMAT_C = (0 << 1) | 1,
> + CALL_FORMAT_STD = (1 << 1) | 1,
> +};
> +
> struct ByteArray;
> struct OopArray;
>
> @@ -31,6 +37,7 @@
> struct ByteArray *ptr);
> extern ObjectPointer applyExternalLibraryPrimitive(struct ByteArray *ptr,
> struct OopArray *argsFormat,
> + ObjectPointer callFormat,
> ObjectPointer resultFormat,
> struct OopArray *args);
>
--------------------------------------------------------------------------------
> <?xml version="1.0" encoding="Windows-1252"?>
> <VisualStudioProject
> ProjectType="Visual C++"
> Version="7.10"
> Name="Slate-VS2003"
> ProjectGUID="{91D9428D-902A-4CA9-BC50-91C726F50342}"
> Keyword="Win32Proj">
> <Platforms>
> <Platform
> Name="Win32"/>
> </Platforms>
> <Configurations>
> <Configuration
> Name="Debug|Win32"
> OutputDirectory="..\..\..\..\.."
> IntermediateDirectory="Debug"
> ConfigurationType="1"
> CharacterSet="2">
> <Tool
> Name="VCCLCompilerTool"
> Optimization="4"
> GlobalOptimizations="FALSE"
> InlineFunctionExpansion="0"
> EnableIntrinsicFunctions="TRUE"
> FavorSizeOrSpeed="1"
> OmitFramePointers="FALSE"
> OptimizeForProcessor="3"
> OptimizeForWindowsApplication="TRUE"
> AdditionalIncludeDirectories="..\..\..\..\..;..\includes"
> PreprocessorDefinitions="WIN32;_DEBUG;_CONSOLE"
> StringPooling="TRUE"
> MinimalRebuild="FALSE"
> ExceptionHandling="FALSE"
> BasicRuntimeChecks="0"
> RuntimeLibrary="4"
> BufferSecurityCheck="FALSE"
> UsePrecompiledHeader="0"
> WarningLevel="4"
> Detect64BitPortabilityProblems="FALSE"
> DebugInformationFormat="3"
> CompileAs="1"/>
> <Tool
> Name="VCCustomBuildTool"/>
> <Tool
> Name="VCLinkerTool"
> OutputFile="$(OutDir)/Slate.exe"
> LinkIncremental="1"
> SuppressStartupBanner="TRUE"
> GenerateDebugInformation="TRUE"
> ProgramDatabaseFile="$(OutDir)/Slate.pdb"
> SubSystem="1"
> TargetMachine="1"/>
> <Tool
> Name="VCMIDLTool"/>
> <Tool
> Name="VCPostBuildEventTool"/>
> <Tool
> Name="VCPreBuildEventTool"/>
> <Tool
> Name="VCPreLinkEventTool"/>
> <Tool
> Name="VCResourceCompilerTool"/>
> <Tool
> Name="VCWebServiceProxyGeneratorTool"/>
> <Tool
> Name="VCXMLDataGeneratorTool"/>
> <Tool
> Name="VCWebDeploymentTool"/>
> <Tool
> Name="VCManagedWrapperGeneratorTool"/>
> <Tool
> Name="VCAuxiliaryManagedWrapperGeneratorTool"/>
> </Configuration>
> <Configuration
> Name="Release|Win32"
> OutputDirectory="..\..\..\..\.."
> IntermediateDirectory="Release"
> ConfigurationType="1"
> CharacterSet="2">
> <Tool
> Name="VCCLCompilerTool"
> Optimization="4"
> GlobalOptimizations="TRUE"
> InlineFunctionExpansion="0"
> EnableIntrinsicFunctions="TRUE"
> FavorSizeOrSpeed="1"
> OmitFramePointers="TRUE"
> OptimizeForProcessor="3"
> OptimizeForWindowsApplication="TRUE"
> AdditionalIncludeDirectories="..\..\..\..\..;..\includes"
> PreprocessorDefinitions="WIN32;_DEBUG;_CONSOLE"
> StringPooling="TRUE"
> MinimalRebuild="FALSE"
> ExceptionHandling="FALSE"
> BasicRuntimeChecks="0"
> RuntimeLibrary="4"
> BufferSecurityCheck="FALSE"
> UsePrecompiledHeader="0"
> WarningLevel="4"
> Detect64BitPortabilityProblems="FALSE"
> DebugInformationFormat="3"
> CompileAs="1"/>
> <Tool
> Name="VCCustomBuildTool"/>
> <Tool
> Name="VCLinkerTool"
> OutputFile="$(OutDir)/Slate.exe"
> LinkIncremental="1"
> SuppressStartupBanner="TRUE"
> GenerateDebugInformation="TRUE"
> ProgramDatabaseFile="$(OutDir)/Slate.pdb"
> SubSystem="1"
> TargetMachine="1"/>
> <Tool
> Name="VCMIDLTool"/>
> <Tool
> Name="VCPostBuildEventTool"/>
> <Tool
> Name="VCPreBuildEventTool"/>
> <Tool
> Name="VCPreLinkEventTool"/>
> <Tool
> Name="VCResourceCompilerTool"/>
> <Tool
> Name="VCWebServiceProxyGeneratorTool"/>
> <Tool
> Name="VCXMLDataGeneratorTool"/>
> <Tool
> Name="VCWebDeploymentTool"/>
> <Tool
> Name="VCManagedWrapperGeneratorTool"/>
> <Tool
> Name="VCAuxiliaryManagedWrapperGeneratorTool"/>
> </Configuration>
> </Configurations>
> <References>
> </References>
> <Files>
> <File
> RelativePath="..\ansifile.c">
> </File>
> <File
> RelativePath="..\boot.c">
> </File>
> <File
> RelativePath="..\..\..\..\..\..\oldslate\src\mobius\vm\platform\windows\directory.c">
> </File>
> <File
> RelativePath="..\..\..\..\lib\extlib.slate">
> </File>
> <File
> RelativePath="..\extprim.c">
> </File>
> <File
> RelativePath="..\includes\extprim.h">
> </File>
> <File
> RelativePath="..\..\ext\extprim.slate">
> </File>
> <File
> RelativePath="..\..\..\..\..\..\oldslate\src\mobius\vm\platform\windows\main.c">
> </File>
> <File
> RelativePath="..\includes\slate.h">
> </File>
> <File
> RelativePath="..\..\..\..\..\slatevm.c">
> </File>
> <File
> RelativePath="..\..\..\..\..\slatevm.h">
> </File>
> <File
> RelativePath=".\windows-extprim.c">
> </File>
> </Files>
> <Globals>
> </Globals>
> </VisualStudioProject>
>
More information about the Slate
mailing list