Commit c07388ea authored by John van Groningen's avatar John van Groningen
Browse files

implement foreign export with stdcall

parent dd98e055
......@@ -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);
......
......@@ -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 {
......
......@@ -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
......
......@@ -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;
}
......
......@@ -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)
......
......@@ -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)
......
......@@ -817,6 +817,7 @@ struct string_list {
struct foreign_export_list {
SymbolP fe_symbol_p;
int fe_stdcall;
struct foreign_export_list *fe_next;
};
......
......@@ -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)
......
......@@ -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
......
......@@ -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 }
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment