Windows API support
Brian Rice
water at tunes.org
Tue Jan 4 19:46:16 PST 2005
That does sound more natural. I've changed this in CVS. Thank you.
On Jan 4, 2005, at 7:27 PM, Shaping wrote:
> 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\window
>> s\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\window
>> s\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>
>
>
--
Brian T. Rice
LOGOS Research and Development
http://tunes.org/~water/
More information about the Slate
mailing list