implement foreign export with stdcall

backend/backend.dcl

@@ -277,8 +277,8 @@ BEExportFunction :: !Int !BackEnd -> BackEnd;
 // void BEExportFunction (int functionIndex);
 BEDefineImportedObjsAndLibs :: !BEStringListP !BEStringListP !BackEnd -> BackEnd;
 // void BEDefineImportedObjsAndLibs (BEStringListP objs,BEStringListP libs);
-BEInsertForeignExport :: !BESymbolP !BackEnd -> BackEnd;
-// void BEInsertForeignExport (BESymbolP symbol_p);
+BEInsertForeignExport :: !BESymbolP !Int !BackEnd -> BackEnd;
+// void BEInsertForeignExport (BESymbolP symbol_p,int stdcall);
 BESetMainDclModuleN :: !Int !BackEnd -> BackEnd;
 // void BESetMainDclModuleN (int main_dcl_module_n_parameter);
 BEStrictPositions :: !Int !BackEnd -> (!Int,!Int,!BackEnd);

backend/backend.icl

@@ -758,11 +758,11 @@ BEDefineImportedObjsAndLibs a0 a1 a2 = code {
 }
 // void BEDefineImportedObjsAndLibs (BEStringListP objs,BEStringListP libs);
 
-BEInsertForeignExport :: !BESymbolP !BackEnd -> BackEnd;
-BEInsertForeignExport a0 a1 = code {
-	ccall BEInsertForeignExport "I:V:I"
+BEInsertForeignExport :: !BESymbolP !Int !BackEnd -> BackEnd;
+BEInsertForeignExport a0 a1 a2 = code {
+	ccall BEInsertForeignExport "II:V:I"
 }
-// void BEInsertForeignExport (BESymbolP symbol_p);
+// void BEInsertForeignExport (BESymbolP symbol_p,int stdcall);
 
 BESetMainDclModuleN :: !Int !BackEnd -> BackEnd;
 BESetMainDclModuleN a0 a1 = code {

backend/backendconvert.icl

@@ -2039,11 +2039,11 @@ getVariableSequenceNumber varInfoPtr be
 		VI_AliasSequenceNumber {var_info_ptr}
 			-> getVariableSequenceNumber var_info_ptr be
 
-convertForeignExports :: [Int] Int BackEnd -> BackEnd
-convertForeignExports [functionIndex:icl_foreign_exports] main_dcl_module_n backEnd
+convertForeignExports :: [ForeignExport] Int BackEnd -> BackEnd
+convertForeignExports [{fe_fd_index,fe_stdcall}:icl_foreign_exports] main_dcl_module_n backEnd
 	# backEnd = convertForeignExports icl_foreign_exports main_dcl_module_n backEnd
-	# (function_symbol_p,backEnd) = BEFunctionSymbol functionIndex main_dcl_module_n backEnd
-	= BEInsertForeignExport function_symbol_p backEnd
+	# (function_symbol_p,backEnd) = BEFunctionSymbol fe_fd_index main_dcl_module_n backEnd
+	= BEInsertForeignExport function_symbol_p (if fe_stdcall 1 0) backEnd
 convertForeignExports [] main_dcl_module_n backEnd
 	= backEnd
 

backendC/CleanCompilerSources/backend.c

@@ -3072,7 +3072,7 @@ BEDefineImportedObjsAndLibs (BEStringListP objs, BEStringListP libs)
 	gBEState.be_icl.beicl_module->im_imported_libs	= libs;
 } /* BEDefineRules */
 
-void BEInsertForeignExport (BESymbolP symbol_p)
+void BEInsertForeignExport (BESymbolP symbol_p,int stdcall)
 {
 	ImpMod icl_mod_p;
 	struct foreign_export_list *foreign_export_list_p;
@@ -3082,6 +3082,7 @@ void BEInsertForeignExport (BESymbolP symbol_p)
 	icl_mod_p=gBEState.be_icl.beicl_module;
 
 	foreign_export_list_p->fe_symbol_p=symbol_p;
+	foreign_export_list_p->fe_stdcall=stdcall;
 	foreign_export_list_p->fe_next=icl_mod_p->im_foreign_exports;
 	icl_mod_p->im_foreign_exports=foreign_export_list_p;
 }

backendC/CleanCompilerSources/backend.h

@@ -532,8 +532,8 @@ Clean (BEExportFunction :: Int BackEnd -> BackEnd)
 void BEDefineImportedObjsAndLibs (BEStringListP objs, BEStringListP libs);
 Clean (BEDefineImportedObjsAndLibs :: BEStringListP BEStringListP BackEnd -> BackEnd)
 
-void BEInsertForeignExport (BESymbolP symbol_p);
-Clean (BEInsertForeignExport :: BESymbolP BackEnd -> BackEnd)
+void BEInsertForeignExport (BESymbolP symbol_p,int stdcall);
+Clean (BEInsertForeignExport :: BESymbolP Int BackEnd -> BackEnd)
 
 void BESetMainDclModuleN (int main_dcl_module_n_parameter);
 Clean (BESetMainDclModuleN :: Int BackEnd -> BackEnd)

backendC/CleanCompilerSources/instructions.c

@@ -3574,6 +3574,9 @@ void GenerateForeignExports (struct foreign_export_list *foreign_export_list)
 
 		FPrintF (OutFile,"\n\tcentry %s e_%s_s%s \"",function_sdef->sdef_ident->ident_name,CurrentModule,function_sdef->sdef_ident->ident_name);
 		
+		if (foreign_export_list->fe_stdcall)
+			FPutC ('P',OutFile);
+		
 		rule_type_p=function_sdef->sdef_rule->rule_type;
 		
 		for_l (type_arg_p,rule_type_p->type_alt_lhs->type_node_arguments,type_arg_next)

backendC/CleanCompilerSources/syntaxtr.t

@@ -817,6 +817,7 @@ struct string_list {
 
 struct foreign_export_list {
 	SymbolP						fe_symbol_p;
+	int							fe_stdcall;
 	struct foreign_export_list *fe_next;
 };
 

frontend/check.dcl

@@ -11,7 +11,7 @@ checkFunctions :: !Index !Level !Index !Index !Int !*{#FunDef} !*ExpressionInfo
 checkDclMacros :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
 										  -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState)
 
-checkForeignExportedFunctionTypes :: !*ErrorAdmin ![Int] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef})
+checkForeignExportedFunctionTypes :: !*ErrorAdmin ![ForeignExport] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef})
 										  
 determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps !u:(Optional (v:{#DclModule}, w:{#CheckedTypeDef}, Index)) !*ErrorAdmin
 		-> (!SymbolType, !Specials, !*TypeHeaps, !u:Optional (v:{#DclModule}, w:{#CheckedTypeDef}), !*ErrorAdmin)

frontend/check.icl

@@ -2522,7 +2522,7 @@ check_module1 cdefs icl_global_function_range fun_defs optional_dcl_mod optional
 	  		fill_macro_def_array i [dcl_macro_defs:macro_defs] a
 	  			= fill_macro_def_array (i+1) macro_defs {a & [i]=dcl_macro_defs}
 
-check_module2 :: Bool Ident {#Char} [.ImportedObject] .[Import ImportDeclaration] [IdentPos] .ModuleKind !.IndexRange !.IndexRange !.IndexRange !Int !Int 
+check_module2 :: Bool Ident {#Char} [.ImportedObject] .[Import ImportDeclaration] [ParsedForeignExport] .ModuleKind !.IndexRange !.IndexRange !.IndexRange !Int !Int 
 				(Optional (Module a)) [Declaration] *{#FunDef} *{#*{#FunDef}} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange) 
 				*{#.Int} *Heaps *CheckState
 			-> (!Bool,.IclModule,!.{#DclModule},.{!Group},!*{#*{#FunDef}},!Int,!.Heaps,!.{#PredefinedSymbol},!.Heap SymbolTableEntry,!.File,[String]);
@@ -2855,8 +2855,8 @@ check_module2 support_dynamics mod_ident mod_modification_time mod_imported_obje
 						-> ( popErrorAdmin cs_error, type_heaps)
 			= (icl_functions, type_heaps, cs_error)
 
-checkForeignExports :: [IdentPos] [IndexRange] *{#FunDef} *CheckState -> (![Int],!*{#FunDef},!*CheckState)
-checkForeignExports [ident_pos=:{ip_ident={id_name,id_info}}:foreign_exports] icl_global_functions_ranges fun_defs cs
+checkForeignExports :: [ParsedForeignExport] [IndexRange] *{#FunDef} *CheckState -> (![ForeignExport],!*{#FunDef},!*CheckState)
+checkForeignExports [{pfe_ident=pfe_ident=:{id_name,id_info},pfe_line,pfe_file,pfe_stdcall}:foreign_exports] icl_global_functions_ranges fun_defs cs
 	# ({ste_kind,ste_index},cs_symbol_table) = readPtr id_info cs.cs_symbol_table
 	# cs = { cs & cs_symbol_table = cs_symbol_table }
 	# (foreign_export_fundef_index,fun_defs,cs) = check_foreign_export ste_kind icl_global_functions_ranges fun_defs cs
@@ -2872,20 +2872,22 @@ checkForeignExports [ident_pos=:{ip_ident={id_name,id_info}}:foreign_exports] ic
 									-> ([],{cs & cs_error = checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in type of foreign exported function (context not allowed)" cs.cs_error})
 								| not (first_n_are_strict st_arity st_args_strictness)
 									-> ([],{cs & cs_error = checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in type of foreign exported function (strictness annotation missing)" cs.cs_error})
-									-> ([ste_index],cs)
+									-> ([{fe_fd_index=ste_index,fe_stdcall=pfe_stdcall}],cs)
 					= (foreign_export_fundef_index,fun_defs,cs)
 			check_foreign_export (STE_FunctionOrMacro _) [_,{ir_from, ir_to}:_] fun_defs cs
 				| ste_index>=ir_from && ste_index<ir_to
+					# ident_pos = { ip_ident=pfe_ident,ip_line=pfe_line,ip_file=pfe_file }
 					= ([],fun_defs,{cs & cs_error = checkErrorWithIdentPos ident_pos "has not been exported" cs.cs_error})
 			check_foreign_export _ _ fun_defs cs
+				# ident_pos = { ip_ident=pfe_ident,ip_line=pfe_line,ip_file=pfe_file }
 				= ([],fun_defs,{cs & cs_error = checkErrorWithIdentPos ident_pos "has not been declared" cs.cs_error})
 	# (foreign_export_fundef_indexes,fun_defs,cs) = checkForeignExports foreign_exports icl_global_functions_ranges fun_defs cs
 	= (foreign_export_fundef_index++foreign_export_fundef_indexes,fun_defs,cs)
 checkForeignExports [] icl_global_functions_ranges fun_defs cs
 	= ([],fun_defs,cs)
 
-checkForeignExportedFunctionTypes :: !*ErrorAdmin ![Int] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef})
-checkForeignExportedFunctionTypes error_admin [fun_def_index:icl_foreign_exports] fun_defs
+checkForeignExportedFunctionTypes :: !*ErrorAdmin ![ForeignExport] !*{#FunDef} -> (!*ErrorAdmin,!*{#FunDef})
+checkForeignExportedFunctionTypes error_admin [{fe_fd_index}:icl_foreign_exports] fun_defs
 	# error_admin = if (check_foreign_export_type st_result.at_type)
 						error_admin
 						(checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in result type for foreign exported function" error_admin)
@@ -2894,7 +2896,7 @@ checkForeignExportedFunctionTypes error_admin [fun_def_index:icl_foreign_exports
 						(checkErrorWithIdentPos (newPosition fun_ident fun_pos) "error in argument type for foreign exported function" error_admin)
 	= checkForeignExportedFunctionTypes error_admin icl_foreign_exports fun_defs2
 	where
-		({fun_type=Yes {st_args,st_result},fun_ident,fun_pos},fun_defs2) = fun_defs![fun_def_index]
+		({fun_type=Yes {st_args,st_result},fun_ident,fun_pos},fun_defs2) = fun_defs![fe_fd_index]
 
 		check_foreign_export_types [{at_type}:argument_types]
 			= check_foreign_export_type at_type && check_foreign_export_types argument_types 

frontend/checksupport.dcl

@@ -100,12 +100,14 @@ cConversionTableSize	:== 10
 	,	icl_common				:: !.CommonDefs
 	,	icl_import				:: !{!Declaration}
 	,	icl_imported_objects	:: ![ImportedObject]
-	,	icl_foreign_exports		:: ![FunDefIndex]
+	,	icl_foreign_exports		:: ![ForeignExport]
 	,	icl_used_module_numbers :: !NumberSet
 	,	icl_copied_from_dcl 	:: !CopiedDefinitions
 	,	icl_modification_time	:: !{#Char}
 	}
 
+:: ForeignExport = {fe_fd_index :: !FunDefIndex, fe_stdcall :: !Bool}
+
 ::	DclModule =
 	{	dcl_name			:: !Ident
 	,	dcl_functions		:: !{# FunType }

frontend/parse.icl

@@ -676,11 +676,28 @@ where
 				# (token, pState) = nextToken FunctionContext pState
 				-> case token of
 					IdentToken function_name
-						# pState = wantEndOfDefinition "foreign export" pState
-						# (ident,pState) = stringToIdent function_name IC_Expression pState
-						-> (True,PD_ForeignExport ident file_name line_nr,pState)
+						| function_name=="ccall"
+							# (token2, pState) = nextToken FunctionContext pState
+							-> case token2 of
+								IdentToken function_name
+									-> accept_foreign_export function_name line_nr False pState
+								_
+									-> accept_foreign_export function_name line_nr False (tokenBack pState)
+						| function_name=="stdcall"
+							# (token2, pState) = nextToken FunctionContext pState
+							-> case token2 of 
+								IdentToken function_name
+									-> accept_foreign_export function_name line_nr True pState
+								_
+									-> accept_foreign_export function_name line_nr False (tokenBack pState)
+							-> accept_foreign_export function_name line_nr False pState
 					_
 						-> foreign_export_error "function name" pState
+				where
+					accept_foreign_export function_name line_nr stdcall pState
+						# pState = wantEndOfDefinition "foreign export" pState
+						# (ident,pState) = stringToIdent function_name IC_Expression pState
+						= (True,PD_ForeignExport ident file_name line_nr stdcall,pState)
 			_
 				-> foreign_export_error "export" pState
 		where

frontend/postparse.icl

@@ -1241,7 +1241,7 @@ where
 		# (strictness_index,strictness,strictness_list) = add_next_not_strict strictness_index strictness strictness_list
 		= add_strictness_for_arguments fields strictness_index strictness strictness_list
 
-reorganiseDefinitions :: Bool [ParsedDefinition] Index Index Index Index *CollectAdmin -> (![FunDef],!CollectedDefinitions (ParsedInstance FunDef) [FunDef], ![ParsedImport], ![ImportedObject],![IdentPos],!*CollectAdmin)
+reorganiseDefinitions :: Bool [ParsedDefinition] Index Index Index Index *CollectAdmin -> (![FunDef],!CollectedDefinitions (ParsedInstance FunDef) [FunDef], ![ParsedImport], ![ImportedObject],![ParsedForeignExport],!*CollectAdmin)
 reorganiseDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kind : defs] cons_count sel_count mem_count type_count ca
 	# prio = if is_infix (Prio NoAssoc 9) NoPrio
 	  fun_arity = length args
@@ -1457,9 +1457,9 @@ reorganiseDefinitions icl_module [PD_Import new_imports : defs] cons_count sel_c
 reorganiseDefinitions icl_module [PD_ImportedObjects new_imported_objects : defs] cons_count sel_count mem_count type_count ca
 	# (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca
 	= (fun_defs, c_defs, imports, new_imported_objects ++ imported_objects,foreign_exports, ca)
-reorganiseDefinitions icl_module [PD_ForeignExport new_foreign_export file_name line_n : defs] cons_count sel_count mem_count type_count ca
+reorganiseDefinitions icl_module [PD_ForeignExport new_foreign_export file_name line_n stdcall : defs] cons_count sel_count mem_count type_count ca
 	# (fun_defs, c_defs, imports, imported_objects,foreign_exports, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca
-	= (fun_defs, c_defs, imports, imported_objects,[{ip_ident=new_foreign_export,ip_file=file_name,ip_line=line_n}:foreign_exports], ca)
+	= (fun_defs, c_defs, imports, imported_objects,[{pfe_ident=new_foreign_export,pfe_file=file_name,pfe_line=line_n,pfe_stdcall=stdcall}:foreign_exports], ca)
 reorganiseDefinitions icl_module [def:defs] _ _ _ _ ca
 	= abort ("reorganiseDefinitions does not match" ---> def)
 reorganiseDefinitions icl_module [] _ _ _ _ ca

frontend/syntax.dcl

@@ -96,10 +96,17 @@ instance == FunctionOrMacroIndex
 	,	mod_type		:: !ModuleKind
 	, 	mod_imports		:: ![ParsedImport]
 	,	mod_imported_objects :: ![ImportedObject]
-	,	mod_foreign_exports :: ![IdentPos]
+	,	mod_foreign_exports :: ![ParsedForeignExport]
 	,	mod_defs		:: !defs
 	}
 
+::	ParsedForeignExport =
+	{	pfe_ident	:: !Ident
+	,	pfe_line	:: !Int
+	,	pfe_file	:: !FileName
+	,	pfe_stdcall	:: !Bool
+	}
+
 ::	ParsedModule	:== Module  [ParsedDefinition]
 ::	ScannedModule 	:== Module  (CollectedDefinitions (ParsedInstance FunDef) IndexRange)
 	
@@ -175,7 +182,7 @@ cIsNotAFunction :== False
 	|	PD_Instances [ParsedInstance ParsedDefinition]
 	|	PD_Import [ParsedImport]
 	|	PD_ImportedObjects [ImportedObject]
-	|	PD_ForeignExport !Ident !{#Char} !Int
+	|	PD_ForeignExport !Ident !{#Char} !Int !Bool /* if stdcall */
 	|	PD_Generic GenericDef // AA
 	| 	PD_GenericCase GenericCaseDef // AA	
 	|	PD_Derive [GenericCaseDef] // AA
@@ -1327,7 +1334,7 @@ instance == OverloadedListType
 	=	CP_Expression !Expression
 	|	CP_FunArg !Ident !Int // Function symbol, argument position (>=1)
 	|	CP_LiftedFunArg !Ident !Ident // Function symbol, lifted argument ident
-	
+
 ::	IdentPos =
 	{	ip_ident	:: !Ident
 	,	ip_line		:: !Int