fis-gtm/sr_port/extern_func.c

158 lines
4.1 KiB
C

/****************************************************************
* *
* Copyright 2011 Fidelity Information Services, Inc *
* *
* This source code contains the intellectual property *
* of its copyright holder(s), and is made available *
* under a license. If you do not know the terms of *
* the license, please stop and do not read further. *
* *
****************************************************************/
#include "mdef.h"
#include "compiler.h"
#include "opcode.h"
#include "toktyp.h"
#include "advancewindow.h"
#ifdef VMS
#include "vaxsym.h"
#include "mmemory.h"
#endif
GBLREF char *lexical_ptr;
GBLREF unsigned char *source_buffer;
error_def(ERR_RTNNAME);
/* Maximum size of external routine reference of the form label^routine */
#ifdef UNIX
#define MAX_EXTREF (2 * MAX_MIDENT_LEN + STR_LIT_LEN("^"))
#endif
/* compiler parse to AVT module for external functions ($&) */
int extern_func(oprtype *a)
{
boolean_t have_ident;
char *extref;
int cnt, actcnt;
mstr extentry, package;
oprtype *nxtopr;
triple *calltrip, *ref;
# ifdef VMS
char *extsym, *extern_symbol;
oprtype tabent;
# endif
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert (TK_AMPERSAND == TREF(window_token));
advancewindow();
cnt = 0;
extref = (char *)&source_buffer[TREF(last_source_column) - 1];
package.len = 0;
package.addr = NULL;
if (have_ident = (TK_IDENT == TREF(window_token))) /* NOTE assignment */
{
if (TK_PERIOD == TREF(director_token))
{ /* if ident is a package reference, then take it off */
package.addr = extref;
package.len = INTCAST(lexical_ptr - extref - 1);
VMS_ONLY(package.len = ((MAX_EXTREF < package.len) ? MAX_EXTREF : package.len));
extref = lexical_ptr;
advancewindow(); /* get to . */
advancewindow(); /* to next token */
if (have_ident = (TK_IDENT == TREF(window_token))) /* NOTE assignment */
advancewindow();
} else
advancewindow();
}
if (TK_CIRCUMFLEX == TREF(window_token))
{
advancewindow();
if (TK_IDENT == TREF(window_token))
{
have_ident = TRUE;
advancewindow();
}
}
if (!have_ident)
{
stx_error(ERR_RTNNAME);
return FALSE;
}
extentry.len = INTCAST((char *)&source_buffer[TREF(last_source_column) - 1] - extref);
extentry.len = INTCAST(extentry.len > MAX_EXTREF ? MAX_EXTREF : extentry.len);
extentry.addr = extref;
# ifdef VMS_CASE_SENSITIVE_MACROS
if (!run_time)
{ /* this code is disabled because the
* external call table macros are not case sensitive
*/
extern_symbol = mcalloc(MAX_SYMREF);
extsym = extern_symbol;
MEMCPY_LIT(extsym, ZCSYM_PREFIX);
extsym += SIZEOF(ZCSYM_PREFIX) - 1;
memcpy(extsym, package.addr, package.len);
if ('%' == *extsym)
*extsym = '_';
extsym += package.len;
*extsym++ = '.';
memcpy(extsym, extentry.addr, extentry.len);
if ('%' == *extsym)
*extsym = '_';
extsym += extentry.len;
extentry.addr = extern_symbol;
extentry.len = extsym - extern_symbol;
tabent = put_cdlt(&extentry);
} else
{
# endif
# ifdef VMS
ref = newtriple(OC_FGNLOOKUP);
ref->operand[0] = put_str(package.addr, package.len);
ref->operand[1] = put_str(extentry.addr, extentry.len);
tabent = put_tref(ref);
# endif
# ifdef VMS_CASE_SENSITIVE_MACROS
}
# endif
calltrip = maketriple(a ? OC_FNFGNCAL : OC_FGNCAL);
nxtopr = &calltrip->operand[1];
ref = newtriple(OC_PARAMETER);
ref->operand[0] = UNIX_ONLY(put_str(package.addr, package.len)) VMS_ONLY(tabent);
*nxtopr = put_tref(ref);
nxtopr = &ref->operand[1];
cnt++;
# ifdef UNIX
ref = newtriple(OC_PARAMETER);
ref->operand[0] = put_str(extentry.addr, extentry.len);
*nxtopr = put_tref(ref);
nxtopr = &ref->operand[1];
cnt++;
# endif
if (TK_LPAREN != TREF(window_token))
{
ref = newtriple(OC_PARAMETER);
ref->operand[0] = put_ilit(0);
*nxtopr = put_tref(ref);
nxtopr = &ref->operand[1];
cnt++;
ref = newtriple(OC_PARAMETER);
ref->operand[0] = put_ilit(0);
*nxtopr = put_tref(ref);
nxtopr = &ref->operand[1];
cnt++;
} else
{
if (!(actcnt = actuallist(nxtopr)))
return FALSE;
cnt += actcnt;
}
cnt++; /* dst mval, or 0 */
calltrip->operand[0] = put_ilit(cnt);
ins_triple(calltrip);
if (a)
*a = put_tref(calltrip);
return TRUE;
}