Windows API support

Todd Fleming todd at flemingcnc.com
Tue Jan 4 16:33:00 PST 2005


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

-------------- next part --------------
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);
-------------- next part --------------
<?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>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: Slate-VS2003.sln
Type: application/octet-stream
Size: 912 bytes
Desc: not available
Url : /archives/slate/attachments/20050104/686abe7e/Slate-VS2003.obj


More information about the Slate mailing list