Skip to content

Commit

Permalink
Allow passing constant identifiers as inputs to external functions (d…
Browse files Browse the repository at this point in the history 
…gees uses a protected constant array as dummy input to F77)

git-svn-id: https://openmodelica.org/svn/OpenModelica/trunk@21519 f25d12d1-65f4-0310-ae8a-bbce733d8d8e
  • Loading branch information
@sjoelund
sjoelund committed Jul 15, 2014
1 parent a4f66cf commit e92fb0b
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 22 deletions.
39 changes: 23 additions & 16 deletions Compiler/FrontEnd/InstUtil.mo
View file
Expand Up @@ -5829,7 +5829,7 @@ algorithm
case (cache,env,SCode.EXTERNALDECL(funcName = _,lang = lang,output_ = _,args = absexps),impl,pre,_)
equation
(cache,exps,props,_) = elabExpListExt(cache,env, absexps, impl,NONE(),pre,info);
(cache,extargs) = instExtGetFargs2(cache, env, exps, props, lang, info);
(cache,extargs) = instExtGetFargs2(cache, env, absexps, exps, props, lang, info);
then
(cache,extargs);
else
Expand All @@ -5845,14 +5845,15 @@ protected function instExtGetFargs2
Helper function to instExtGetFargs"
input Env.Cache inCache;
input Env.Env inEnv;
input list<Absyn.Exp> absynExps;
input list<DAE.Exp> inExpExpLst;
input list<DAE.Properties> inTypesPropertiesLst;
input Option<String> lang;
input Absyn.Info info;
output Env.Cache outCache;
output list<DAE.ExtArg> outDAEExtArgLst;
algorithm
(outCache,outDAEExtArgLst) := match (inCache,inEnv,inExpExpLst,inTypesPropertiesLst,lang,info)
(outCache,outDAEExtArgLst) := match (inCache,inEnv,absynExps,inExpExpLst,inTypesPropertiesLst,lang,info)
local
list<DAE.ExtArg> extargs;
DAE.ExtArg extarg;
Expand All @@ -5862,11 +5863,13 @@ algorithm
DAE.Properties p;
list<DAE.Properties> props;
Env.Cache cache;
case (cache,_,{},_,_,_) then (cache,{});
case (cache,env,(e :: exps),(p :: props),_,_)
Absyn.Exp ae;
list<Absyn.Exp> aes;
case (cache,_,_,{},_,_,_) then (cache,{});
case (cache,env,ae :: aes, e :: exps,p :: props,_,_)
equation
(cache,SOME(extarg)) = instExtGetFargsSingle(cache, env, e, p, lang, info);
(cache,extargs) = instExtGetFargs2(cache, env, exps, props, lang, info);
(cache,SOME(extarg)) = instExtGetFargsSingle(cache, env, ae, e, p, lang, info);
(cache,extargs) = instExtGetFargs2(cache, env, aes, exps, props, lang, info);
then
(cache,extarg :: extargs);
end match;
Expand All @@ -5877,14 +5880,15 @@ protected function instExtGetFargsSingle
Helper function to instExtGetFargs2, does the work for one argument."
input Env.Cache inCache;
input Env.Env inEnv;
input Absyn.Exp absynExp;
input DAE.Exp inExp;
input DAE.Properties inProperties;
input Option<String> lang;
input Absyn.Info info;
output Env.Cache outCache;
output Option<DAE.ExtArg> outExtArg;
algorithm
(outCache,outExtArg) := matchcontinue (inCache,inEnv,inExp,inProperties,lang,info)
(outCache,outExtArg) := matchcontinue (inCache,inEnv,absynExp,inExp,inProperties,lang,info)
local
DAE.Attributes attr, fattr;
DAE.Type ty,varty;
Expand All @@ -5901,7 +5905,7 @@ algorithm
Values.Value val;
String str;

case (_, _, DAE.CREF(componentRef = cref as DAE.CREF_QUAL(ident = _)),
case (_, _, _, DAE.CREF(componentRef = cref as DAE.CREF_QUAL(ident = _)),
DAE.PROP(constFlag = DAE.C_VAR()), _, _)
equation
(cache, attr, ty,_, _, _, _, _, _) = Lookup.lookupVarLocal(inCache, inEnv, cref);
Expand All @@ -5914,14 +5918,14 @@ algorithm
then
(cache, SOME(DAE.EXTARG(cref, attr, ty)));

case (_, _, DAE.CREF(componentRef = cref as DAE.CREF_IDENT(ident = _)),
case (_, _, _, DAE.CREF(componentRef = cref as DAE.CREF_IDENT(ident = _)),
DAE.PROP(constFlag = DAE.C_VAR()), _, _)
equation
(cache, attr, ty,_, _, _, _, _, _) = Lookup.lookupVarLocal(inCache, inEnv, cref);
then
(cache,SOME(DAE.EXTARG(cref, attr, ty)));

case (cache,env,DAE.CREF(componentRef = cref),DAE.PROP(constFlag = _),_,_)
case (cache,env,_,DAE.CREF(componentRef = cref),DAE.PROP(constFlag = _),_,_)
equation
failure((_,_,_,_,_,_,_,_,_) = Lookup.lookupVarLocal(cache,env,cref));
crefstr = ComponentReference.printComponentRefStr(cref);
Expand All @@ -5930,27 +5934,30 @@ algorithm
then
(cache, NONE());

case (cache,env,DAE.SIZE(exp = DAE.CREF(componentRef = cref,ty = _),sz = SOME(dim)),DAE.PROP(type_ = _),_,_)
case (cache,env,_,DAE.SIZE(exp = DAE.CREF(componentRef = cref,ty = _),sz = SOME(dim)),DAE.PROP(type_ = _),_,_)
equation
(cache,attr,varty,_,_,_,_,_,_) = Lookup.lookupVarLocal(cache,env, cref);
then
(cache,SOME(DAE.EXTARGSIZE(cref,attr,varty,dim)));

// adrpo: these can be non-local if they are constants or parameters!
case (cache,env,_,DAE.PROP(type_ = ty,constFlag = DAE.C_CONST()),_,_)
case (cache,env,_,_,DAE.PROP(type_ = ty,constFlag = DAE.C_CONST()),_,_)
equation
(cache, exp,_) = Ceval.cevalIfConstant(cache, env, inExp, inProperties, false, info);
true = Expression.isScalarConst(exp);
then
(cache,SOME(DAE.EXTARGEXP(exp, ty)));

case (cache,_,_,DAE.PROP(type_ = ty),SOME("builtin"),_)
case (cache,_,_,_,DAE.PROP(type_ = ty),SOME("builtin"),_)
then (cache,SOME(DAE.EXTARGEXP(inExp, ty)));

case (cache,_,DAE.CALL(attr = DAE.CALL_ATTR(builtin = true)),DAE.PROP(type_ = ty),_,_)
case (cache,_,_,DAE.CALL(attr = DAE.CALL_ATTR(builtin = true)),DAE.PROP(type_ = ty),_,_)
then (cache,SOME(DAE.EXTARGEXP(inExp, ty)));

case (cache,_,exp,DAE.PROP(type_ = _,constFlag = _),_,_)
case (cache,_,Absyn.CREF(_),_,DAE.PROP(type_ = ty),_,_)
then (cache,SOME(DAE.EXTARGEXP(inExp, ty)));

case (cache,_,_,exp,DAE.PROP(type_ = _,constFlag = _),_,_)
equation
str = ExpressionDump.printExpStr(exp);
Error.addSourceMessage(Error.EXTERNAL_ARG_WRONG_EXP,{str},info);
Expand Down Expand Up @@ -5991,7 +5998,7 @@ algorithm
case (cache,env,SCode.EXTERNALDECL(funcName = _,lang = lang,output_ = SOME(cref)),impl,pre,_)
equation
(cache,SOME((exp,prop,_))) = Static.elabCref(cache,env,cref,impl,false /* Do NOT vectorize arrays; we require a CREF */,pre,info);
(cache,SOME(extarg)) = instExtGetFargsSingle(cache,env,exp,prop,lang,info);
(cache,SOME(extarg)) = instExtGetFargsSingle(cache,env,Absyn.CREF(cref),exp,prop,lang,info);
assertExtArgOutputIsCrefVariable(lang,extarg,Types.getPropType(prop),Types.propAllConst(prop),info);
then
(cache,extarg);
Expand Down
31 changes: 25 additions & 6 deletions Compiler/Template/CodegenC.tpl
View file
Expand Up @@ -6686,10 +6686,7 @@ template extArgF77(SimExtArg extArg, Text &preExp, Text &varDecls, Text &auxFunc
let &preExp += '<%tvar%> = <%texp%>;<%\n%>'
'(char*)<%tvar%>'
case SIMEXTARGEXP(__) then
let texp = daeExp(exp, contextFunction, &preExp, &varDecls, &auxFunction)
let tvar = tempDecl(expTypeFromExpFlag(exp,8),&varDecls)
let &preExp += '<%tvar%> = <%texp%>;<%\n%>'
'&<%tvar%>'
daeExternalF77Exp(exp, contextFunction, &preExp, &varDecls, &auxFunction)
case SIMEXTARGSIZE(cref=c) then
// Fortran functions only takes references to variables, so we must store
// the result from size_of_dimension_<type>_array in a temporary variable.
Expand Down Expand Up @@ -7678,6 +7675,20 @@ template daeExternalCExp(Exp exp, Context context, Text &preExp, Text &varDecls,
else daeExp(exp, context, &preExp, &varDecls, &auxFunction)
end daeExternalCExp;

template daeExternalF77Exp(Exp exp, Context context, Text &preExp, Text &varDecls, Text &auxFunction)
"Like daeExp, but also converts the type to external C"
::=
match typeof(exp)
case T_ARRAY(__) then // Array-expressions
let shortTypeStr = expTypeShort(typeof(exp))
'(<%extType(typeof(exp),true,true)%>) data_of_<%shortTypeStr%>_array(&<%daeExp(exp, context, &preExp, &varDecls, &auxFunction)%>)'
else
let texp = daeExp(exp, contextFunction, &preExp, &varDecls, &auxFunction)
let tvar = tempDecl(expTypeFromExpFlag(exp,8),&varDecls)
let &preExp += '<%tvar%> = <%texp%>;<%\n%>'
'&<%tvar%>'
end daeExternalF77Exp;

template daeExpSconst(String string)
"Generates code for a string constant."
::=
Expand Down Expand Up @@ -10058,9 +10069,17 @@ template expTypeFlag(DAE.Type ty, Integer flag)
'<%expTypeShort(ty)%>_array'
case 4 then
// we want the "array type" only if type is array, otherwise "modelica type"
match ty
(match ty
case T_ARRAY(__) then '<%expTypeShort(ty)%>_array'
else expTypeFlag(ty, 2)
else expTypeFlag(ty, 2))
case 8 then
(match ty
case T_ARRAY(__) then '<%expTypeFlag(ty,8)%>*'
case T_INTEGER(__) then 'int'
case T_BOOL(__) then 'int'
case T_REAL(__) then 'double'
case T_STRING(__) then 'const char*'
else error(sourceInfo(),'I do not know the external type of <%unparseType(ty)%>'))
end expTypeFlag;


Expand Down

0 comments on commit e92fb0b

Please sign in to comment.