static char*
doDir_assert(char* pzArg, char* pzScan)
{
switch (*pzArg) {
case '`':
{
char* pzS = pzArg+1;
char* pzR;
pzR = strrchr(pzS, '`');
if (pzR == NULL)
break; /* not a valid script */
*pzR = NUL;
pzS = runShell((char const*)pzS);
check_assert_str(pzS, pzArg);
free(pzS);
break;
}
case '(':
{
SCM res = ag_scm_c_eval_string_from_file_line(
pzArg, pCurCtx->pzCtxFname, pCurCtx->lineNo );
check_assert_str(resolveSCM(res), pzArg);
break;
}
default:
break;
}
return pzScan;
}
static void
init_scm(void)
{
last_scm_cmd = SCHEME_INIT_TEXT;
{
SCM ini_res = ag_scm_c_eval_string_from_file_line(
SCHEME_INIT_TEXT, AG_TEXT_STRTABLE_FILE, SCHEME_INIT_TEXT_LINENO);
AGDUPSTR(libguile_ver, scm2display(ini_res), "ini res");
}
{
unsigned int maj, min, mic;
switch (sscanf(libguile_ver, "%u.%u.%u", &maj, &min, &mic)) {
case 2:
case 3: break;
default:
AG_ABEND(aprf(GUILE_VERSION_BAD, libguile_ver));
/* NOT_REACHED */
}
maj = min + (100 * maj);
if ((GUILE_VERSION / 1000) != maj)
AG_ABEND(aprf(GUILE_VERSION_WRONG, libguile_ver,
MK_STR(GUILE_VERSION)));
}
{
# if GUILE_VERSION >= 200000
# define SCHEME_INIT_DEBUG SCHEME_INIT_DEBUG_2_0
# else
# define SCHEME_INIT_DEBUG SCHEME_INIT_DEBUG_1_6
# endif
char * p = aprf(INIT_SCM_ERRS_FMT, SCHEME_INIT_DEBUG);
# undef SCHEME_INIT_DEBUG
last_scm_cmd = p;
ag_scm_c_eval_string_from_file_line(p, __FILE__, __LINE__);
AGFREE(p);
}
}
static void
loadScheme(void)
{
char* pzText = pCurCtx->pzScan;
char* pzEnd = (char*)skipScheme(pzText, pzText + strlen(pzText));
char endCh = *pzEnd;
int schemeLen = (pzEnd - pzText);
int next_ln;
SCM res;
/*
* NUL terminate the Scheme expression, run it, then restore
* the NUL-ed character.
*/
if (*pzEnd == NUL)
AG_ABEND(aprf(zErrMsg, pzProg,
"end of Guile/scheme expression not found",
pCurCtx->pzCtxFname, pCurCtx->lineNo));
*pzEnd = NUL;
next_ln = pCurCtx->lineNo + count_nl(pzText);
procState = PROC_STATE_GUILE_PRELOAD;
res = ag_scm_c_eval_string_from_file_line(
pzText, pCurCtx->pzCtxFname, pCurCtx->lineNo );
procState = PROC_STATE_LOAD_DEFS;
*pzEnd = endCh;
pCurCtx->pzScan = pzEnd;
pzEnd = (char*)resolveSCM(res); /* ignore const-ness */
pCurCtx->lineNo = next_ln;
if (strlen(pzEnd) >= schemeLen) {
AGDUPSTR(pzEnd, pzEnd, "SCM Result");
pz_token = pzEnd;
manageAllocatedData(pz_token);
}
else {
/*
* We know the result is smaller than the source. Copy in place.
*/
strcpy(pzText, pzEnd);
pz_token = pzText;
}
lastToken = DP_EV_STRING;
}
/**
* This directive @i{is} processed, but only if the expression begins with
* either a back quote (@code{`}) or an open parenthesis (@code{(}).
* Text within the back quotes are handed off to the shell for processing
* and parenthesized text is handed off to Guile. Multiple line expressions
* must be joined with backslashes.
*
* If the @code{shell-script} or @code{scheme-expr} do not yield @code{true}
* valued results, autogen will be aborted. If @code{<anything else>} or
* nothing at all is provided, then this directive is ignored.
*
* The result is @code{false} (and fails) if the result is empty, the
* number zero, or a string that starts with the letters 'n' or 'f' ("no"
* or "false").
*/
char *
doDir_assert(directive_enum_t id, char const * dir, char * scan_next)
{
(void)id;
dir = SPN_WHITESPACE_CHARS(dir);
switch (*dir) {
case '`':
{
char * pzS = (char *)dir+1;
char * pzR = SPN_WHITESPACE_BACK(pzS, NULL);
if (*(--pzR) != '`')
break; /* not a valid script */
*pzR = NUL;
pzS = shell_cmd((char const *)pzS);
check_assert_str(pzS, dir);
AGFREE(pzS);
break;
}
case '(':
{
SCM res = ag_scm_c_eval_string_from_file_line(
dir, cctx->scx_fname, cctx->scx_line);
check_assert_str(scm2display(res), dir);
break;
}
default:
break;
}
return scan_next;
}
/*
* process a single scheme expression, yielding text that gets processed
* into AutoGen definitions.
*/
static void
alist_to_autogen_def(void)
{
static char const zSchemeText[] = "Scheme Computed Definitions";
static char const zWrap[] = "(alist->autogen-def %s)";
char* pzText = ++(pCurCtx->pzScan);
char* pzEnd = (char*)skipScheme(pzText, pzText + strlen(pzText));
SCM res;
size_t res_len;
tScanCtx* pCtx;
/*
* Wrap the scheme expression with the `alist->autogen-def' function
*/
{
char endCh = *pzEnd;
*pzEnd = NUL;
pzText = aprf(zWrap, pzText);
*pzEnd = endCh;
}
/*
* Run the scheme expression. The result is autogen definition text.
*/
procState = PROC_STATE_GUILE_PRELOAD;
res = ag_scm_c_eval_string_from_file_line(
pzText, pCurCtx->pzCtxFname, pCurCtx->lineNo );
/*
* The result *must* be a string, or we choke.
*/
if (! AG_SCM_STRING_P(res)) {
static char const zEr[] =
"Scheme definition expression does not yield string:\n";
AG_ABEND(zEr);
}
res_len = AG_SCM_STRLEN(res);
procState = PROC_STATE_LOAD_DEFS;
pCurCtx->pzScan = pzEnd;
AGFREE(pzText);
/*
* Now, push the resulting string onto the input stack
* and link the new scan data into the context stack
*/
pCtx = (tScanCtx*)AGALOC(sizeof(tScanCtx) + 4 + res_len, "lex scan ctx");
pCtx->pCtx = pCurCtx;
pCurCtx = pCtx;
/*
* Set up the rest of the context structure
*/
AGDUPSTR(pCtx->pzCtxFname, zSchemeText, "scheme text");
pCtx->pzScan = \
pCtx->pzData = (char*)(pCtx+1);
pCtx->lineNo = 0;
memcpy((void*)(pCtx->pzScan), (void*)AG_SCM_CHARS(res), res_len);
pCtx->pzScan[ res_len ] = NUL;
/*
* At this point, the next token will be obtained
* from the newly allocated context structure.
* When empty, input will resume from the '}' that we
* left as the next input token in the old context.
*/
}
