static struct Code *parse_fortran(struct TestFile *tf, int *need_array_it)
{
struct Code *code = NEW0(struct Code);
char *start = tf->read_pos, *tok, *save_pos;
enum MacroType mtype;
size_t len;
code->type = FORTRAN_CODE;
code->lineno = tf->lineno;
// read lines until a recognized end sequence appears
while (tf->read_pos < tf->file_end) {
// look for end sequence
save_pos = tf->read_pos;
tok = next_token(tf, &len);
assert(tok != NULL);
if (is_test_token(tok, len) ||
(same_token("end", 3, tok, len) && next_is_test_end_token(tf))) {
break;
} else if (tf->read_pos == tf->file_end) {
break;
} else { // not found, this is fortran
tf->read_pos = save_pos;
}
if (find_macro(tf, &mtype, need_array_it)) {
// record initial fortran code
code->u.c.str = start;
code->u.c.len = tf->read_pos - start;
// parse the macro
tf->read_pos = tf->next_pos;
code->next = parse_macro(tf, mtype, need_array_it);
// parse_macro recurses to parse more code, so just return here
if (!code->next)
goto error;
return code;
} else {
next_line(tf);
}
}
if (tf->line_pos < tf->file_end) { // found non-fortran code
// record bounds of fortran code
code->u.c.str = start;
code->u.c.len = tf->line_pos - start;
tf->next_pos = tf->read_pos = tf->line_pos;
return code;
}
syntax_error(tf);
error:
free_code(code);
return NULL;
}
static int
build_argv(struct state *cur, const char *cmdname,
scconf_list *list, char **argv, unsigned int max)
{
unsigned int argc;
const char *str;
sc_macro_t *mac;
int r;
for (argc = 0; list; list = list->next) {
if (argc >= max) {
parse_error(cur, "%s: too many arguments", cmdname);
return SC_ERROR_INVALID_ARGUMENTS;
}
str = list->data;
if (str[0] != '$') {
argv[argc++] = list->data;
continue;
}
/* Expand macro reference */
if (!(mac = find_macro(cur->profile, str + 1))) {
parse_error(cur, "%s: unknown macro \"%s\"",
cmdname, str);
return SC_ERROR_SYNTAX_ERROR;
}
#if 0
{
scconf_list *list;
printf("Expanding macro %s:", mac->name);
for (list = mac->value; list; list = list->next)
printf(" %s", list->data);
printf("\n");
}
#endif
r = build_argv(cur, cmdname, mac->value,
argv + argc, max - argc);
if (r < 0)
return r;
argc += r;
}
return argc;
}
static void
new_macro(sc_profile_t *profile, const char *name, scconf_list *value)
{
sc_macro_t *mac;
if ((mac = find_macro(profile, name)) == NULL) {
mac = (sc_macro_t *) calloc(1, sizeof(*mac));
if (mac == NULL)
return;
mac->name = strdup(name);
mac->next = profile->macro_list;
profile->macro_list = mac;
}
mac->value = value;
}
macro_list *extract_macros(char *pBuffer)
{
macro_list *pRetval = NULL;
char *pTraverse = NULL;
char *pMacro = NULL;
pTraverse = pBuffer;
while(pTraverse) {
pMacro = NULL;
pTraverse = find_macro(pTraverse, &pMacro);
if(pMacro) {
add_macro(pMacro, &pRetval);
}
}
return(pRetval);
}
/*****************************************************************
* mdsdcl_show_macro:
*****************************************************************/
int mdsdcl_show_macro() /* Return: status */
{
int i;
int full;
int sts;
struct _mdsdcl_macro *m;
static DYNAMIC_DESCRIPTOR(dsc_name);
struct _mdsdcl_ctrl *ctrl = &MdsdclGetThreadStatic()->ctrl;
sts = cli_get_value("MACRO",&dsc_name);
if (sts & 1)
{
l2u(dsc_name.dscA_pointer,0);
m = find_macro(dsc_name.dscA_pointer);
if (!m)
{
fprintf(stderr," --> macro '%s' not defined\n\r",
dsc_name.dscA_pointer);
return(1);
}
display_macro(m);
return(1);
}
/*=======================================================
* List all defined macros ...
*======================================================*/
full = cli_present("FULL") & 1;
m = ctrl->macro.list;
if (!m)
{
fprintf(stderr," --> No macros defined\n\n\r");
return(1);
}
for (i=0 ; i<ctrl->macro.numMacros ; i++,m++)
{
if (full)
display_macro(m);
else
printf(" %s\n\r",m->name);
}
return(1);
}
/****************************************************************
* mdsdcl_do_macro:
****************************************************************/
int mdsdcl_do_macro() /* Return: status */
{
int i;
int icnt;
int irepeat;
int sts;
char prmName[4];
struct _mdsdcl_io *io;
struct _mdsdcl_macro *macro;
static DYNAMIC_DESCRIPTOR(dsc_util);
static char fmt0[] = "Qualifier not supported: use '@'";
static char fmt1[] = "No such command: '%s'";
static char fmt2[] = "Macro '%s' is already in use";
static char fmt3[] = "Exceeded MAX_DEPTH for indirect files & macros";
struct _mdsdcl_ctrl *ctrl = &MdsdclGetThreadStatic()->ctrl;
sts = cli_get_value("NAME",&dsc_util);
if (~sts & 1)
return(MdsMsg(MDSDCL_STS_ERROR,"Error getting NAME"));
if (cli_present("INTERACTIVE") & 1)
return(MdsMsg(MDSDCL_STS_ERROR,fmt0,0));
if (cli_present("INDIRECT") & 1)
{
sts = mdsdcl_openIndirectLevel(dsc_util.dscA_pointer);
if (!sts & 1)
return(MdsMsg(sts,"failed to open file %s",dsc_util.dscA_pointer));
for ( ; sts & 1 ; )
sts = mdsdcl_do_command(0);
return((sts==MDSDCL_STS_INDIRECT_EOF) ? 1 : sts);
}
l2u(dsc_util.dscA_pointer,0); /* convert to uc */
macro = find_macro(dsc_util.dscA_pointer);
if (!macro)
{
MdsMsg(0,"No such command");
return(MDSDCL_STS_ERROR);
}
if (macro->isOpen)
return(MdsMsg(MDSDCL_STS_ERROR,fmt2,dsc_util.dscA_pointer));
/*=======================================================
* Get repeat count ...
*======================================================*/
sts = cli_get_value("REPEAT",&dsc_util);
if (sts & 1)
{
if (sscanf(dsc_util.dscA_pointer,"%d",&irepeat) != 1)
irepeat = 1;
}
else
irepeat = 1;
/*========================================================
* Create new ioLevel[] in ctrl struct ...
*=======================================================*/
if (ctrl->depth >= MAX_DEPTH)
return(MdsMsg(MDSDCL_STS_INDIRECT_ERROR,fmt3,0));
for (icnt=0 ; icnt<irepeat ; icnt++)
{
macro->isOpen = 1;
io = ctrl->ioLevel + ++ctrl->depth;
io->fp = 0;
io->ioMacro = macro;
io->lineno = 0;
for (i=0 ; i<8 ; i++)
{
sprintf(prmName,"P%d",i+1);
sts = cli_get_value(prmName,io->ioParameter+i);
if (~sts & 1)
break;
}
for ( ; i<8 ; i++)
str_free1_dx(io->ioParameter+i);
do {
sts = mdsdcl_do_command(0);
} while (sts & 1);
if (sts == MDSDCL_STS_INDIRECT_EOF)
continue;
else
break;
}
return((sts==MDSDCL_STS_INDIRECT_EOF) ? 1 : sts);
}
char *
read_string(char endch, int esc)
{
int ch, oldch;
size_t pos, len, slen;
char *name, *s, *buf;
struct macro *macro;
len = 24;
buf = xmalloc(len + 1);
pos = 0;
while ((ch = lex_getc()) != endch) {
switch (ch) {
case EOF:
yyerror("missing %c", endch);
case '\\':
if (!esc)
break;
switch (ch = lex_getc()) {
case EOF:
yyerror("missing %c", endch);
case 'r':
ch = '\r';
break;
case 'n':
ch = '\n';
break;
case 't':
ch = '\t';
break;
}
break;
case '$':
case '%':
if (!esc)
break;
oldch = ch;
ch = lex_getc();
if (ch == EOF)
yyerror("missing %c", endch);
if (ch != '{') {
lex_ungetc(ch);
ch = oldch;
break;
}
name = read_macro(oldch, '{');
if ((macro = find_macro(name)) == NULL) {
xfree(name);
continue;
}
xfree(name);
if (macro->type == MACRO_NUMBER)
xasprintf(&s, "%lld", macro->value.num);
else
s = macro->value.str;
slen = strlen(s);
ENSURE_FOR(buf, len, pos, slen + 1);
memcpy(buf + pos, s, slen);
pos += slen;
if (macro->type == MACRO_NUMBER)
xfree(s);
continue;
}
buf[pos++] = ch;
ENSURE_SIZE(buf, len, pos);
}
buf[pos] = '\0';
return (buf);
}
int
read_token(int ch)
{
int ch2;
char token[128], *name;
size_t tlen;
struct token *ptr;
struct macro *macro;
tlen = 0;
token[tlen++] = ch;
while ((ch = lex_getc()) != EOF) {
if (!isalnum((u_char) ch) && ch != '-' && ch != '_')
break;
token[tlen++] = ch;
if (tlen == (sizeof token) - 1)
yyerror("token too long");
}
token[tlen] = '\0';
lex_ungetc(ch);
/*
* ifdef/ifndef/endif is special-cased here since it is really really
* hard to make work with yacc.
*/
if (strcmp(token, "ifdef") == 0 || strcmp(token, "ifndef") == 0) {
while ((ch = lex_getc()) != EOF && isspace((u_char) ch))
;
if (ch != '$' && ch != '%')
yyerror("syntax error");
ch2 = lex_getc();
if (ch2 != '{' && !isalnum((u_char) ch2))
yyerror("invalid macro name");
name = read_macro(ch, ch2);
macro = find_macro(name);
xfree(name);
if (token[2] == 'n' && macro != NULL)
lex_skip = 1;
if (token[2] != 'n' && macro == NULL)
lex_skip = 1;
lex_ifdef++;
return (NONE);
}
if (strcmp(token, "endif") == 0) {
if (lex_ifdef == 0)
yyerror("spurious endif");
lex_ifdef--;
if (lex_ifdef == 0)
lex_skip = 0;
return (NONE);
}
if (strcmp(token, "include") == 0) {
/*
* This is a bit strange.
*
* yacc may have symbols buffered and be waiting for more to
* decide which production to match, so we can't just switch
* file now. So, we set a flag that tells yylex to switch files
* next time it's called and return the NONE symbol. This is a
* placeholder not used in any real productions, so it should
* cause yacc to match using whatever it has (assuming it
* can). If we don't do this, there are problems with things
* like:
*
* $file = "abc"
* include "${file}"
*
* The include token is seen before yacc has matched the
* previous line, so the macro doesn't exist when we try to
* build the include file path.
*/
lex_include = 1;
return (NONE);
}
ptr = bsearch(token, tokens,
(sizeof tokens)/(sizeof tokens[0]), sizeof tokens[0], cmp_token);
if (ptr == NULL)
yyerror("unknown token: %s", token);
return (ptr->value);
}
static void scan_gml( void )
{
inputcb * cb;
char * p;
int toklen;
int k;
char csave;
bool processed;
gtentry * ge; // GML user tag entry
mac_entry * me; // script macro for processing GML tag
char linestr[MAX_L_AS_STR];
char tok_upper[TAG_NAME_LENGTH];
cb = input_cbs;
p = scan_start + 1;
tok_start = scan_start;
while( is_id_char( *p ) && p <= scan_stop ) { // search end of TAG
p++;
}
scan_start = p; // store argument start address
toklen = p - tok_start - 1;
csave = *p;
*p = '\0';
if( toklen >= TAG_NAME_LENGTH ) {
err_count++;
// SC--009 The tagname is too long
if( cb->fmflags & II_macro ) {
ultoa( cb->s.m->lineno, linestr, 10 );
g_err( err_tag_name, tok_start + 1, linestr, "macro",
cb->s.m->mac->name );
} else {
ultoa( cb->s.f->lineno, linestr, 10 );
g_err( err_tag_name, tok_start + 1, linestr, "file",
cb->s.f->filename );
}
if( inc_level > 0 ) {
show_include_stack();
}
*p = csave;
scan_start = tok_start; // process as text
return;
}
if( GlobalFlags.firstpass && cb->fmflags & II_research ) {
if( stricmp( tok_start + 1, "cmt" ) ) { // quiet for :cmt.
if( cb->fmflags & II_macro ) {
printf_research( "L%d %c%s tag found in macro %s(%d)\n\n",
inc_level, GML_char, tok_start + 1,
cb->s.m->mac->name, cb->s.m->lineno );
} else {
printf_research( "L%d %c%s tag found in file %s(%d)\n\n",
inc_level, GML_char, tok_start + 1,
cb->s.f->filename, cb->s.f->lineno );
}
}
add_GML_tag_research( tok_start + 1 );
}
if( ProcFlags.layout ) {
ge = NULL; // no user tags within :LAYOUT
} else {
ge = find_tag( &tag_dict, tok_start + 1 );
}
processed = false;
me = NULL;
if( ge != NULL ) { // GML user defined Tag found
*p = csave;
if( ge->tagflags & tag_off ) { // inactive, treat as text
scan_start = tok_start;
return;
}
me = find_macro( macro_dict, ge->macname );
if( me == NULL ) {
err_count++;
// SC--037: The macro 'xxxxxx' for the gml tag 'yyyyy'
// is not defined
if( cb->fmflags & II_macro ) {
ultoa( cb->s.m->lineno, linestr, 10 );
g_err( err_tag_macro, ge->macname, ge->name,
linestr, "macro", cb->s.m->mac->name );
} else {
ultoa( cb->s.f->lineno, linestr, 10 );
g_err( err_tag_macro, ge->macname, ge->name,
linestr, "file", cb->s.f->filename );
}
if( inc_level > 0 ) {
show_include_stack();
}
*p = csave;
scan_start = tok_start; // process as text
return;
} else {
/*******************************************************************/
/* The following is to prevent an endless loop */
/* Example from ow documentation: */
/* .gt ZH1 add zh1 */
/* .gt H1 add zh1 */
/* .dm zh1 begin */
/* ... */
/* :H1 <---- overridden gml tag */
/* ... */
/* .dm zh1 end */
/* */
/* we call the predefined :H1 instead */
/*******************************************************************/
if( (cb->fmflags & II_tag) && (cb->s.m->mac == me) ) {
me = NULL;
}
}
}
if( me != NULL ) { // usertag and coresponding macro ok
processed = process_tag( ge, me );
} else {
*p ='\0';
for( k = 0; k <= toklen; k++ ) {
tok_upper[k] = toupper( *(tok_start + 1 + k) );
}
tok_upper[k] = '\0';
if( ProcFlags.layout ) { // different tags within :LAYOUT
for( k = 0; k < LAY_TAGMAX; ++k ) {
if( toklen == lay_tags[k].taglen ) {
if( !strcmp( lay_tags[k].tagname, tok_upper ) ) {
*p = csave;
lay_ind = -1; // process tag not attribute
lay_tags[k].gmlproc( &lay_tags[k] );
processed = true;
lay_ind = k; // now process attributes if any
if( *scan_start == '.' ) {
scan_start++;
}
break;
}
}
}
if( !processed ) { // check for gml only tag in :LAYOUT
for( k = 0; k < GML_TAGMAX; ++k ) {
if( toklen == gml_tags[k].taglen ) {
if( !strcmp( gml_tags[k].tagname, tok_upper ) ) {
g_err( err_gml_in_lay, gml_tags[k].tagname );
err_count++;
file_mac_info();
processed = true;
scan_start = scan_stop + 1;
break;
}
}
}
}
} else { // not within :LAYOUT
for( k = 0; k < GML_TAGMAX; ++k ) {
if( toklen == gml_tags[k].taglen ) {
if( !strcmp( gml_tags[k].tagname, tok_upper ) ) {
if( GlobalFlags.firstpass &&
!strcmp(tok_upper, "LAYOUT" ) &&
ProcFlags.fb_document_done ) {
g_err( err_lay_too_late );
err_count++;
file_mac_info();
processed = true;
scan_start = scan_stop + 1;
break;
}
*p = csave;
if( (rs_loc == 0) && !ProcFlags.need_li_lp ) {
// no restrictions: do them all
gml_tags[k].gmlproc( &gml_tags[k] );
} else if( ProcFlags.need_li_lp &&
((gml_tags[k].taglocs & li_lp_tag) != 0) ) {
// tag is LP or LI
gml_tags[k].gmlproc( &gml_tags[k] );
} else if( (gml_tags[k].taglocs & rs_loc) != 0 ) {
// tag allowed in this restricted location
gml_tags[k].gmlproc( &gml_tags[k] );
} else if( (gml_tags[k].tagflags & tag_is_general) != 0 ) {
// tag allowed everywhere
gml_tags[k].gmlproc( &gml_tags[k] );
} else {
start_doc_sect(); // if not already done
if( ProcFlags.need_li_lp ) {
xx_nest_err( err_no_li_lp );
} else { // rs_loc > 0
g_err_tag_rsloc( rs_loc, tok_start );
}
}
processed = true;
if( *scan_start == '.' ) {
scan_start++;
}
break;
}
}
}
if( !processed ) { // check for layout tag in normal text
for( k = 0; k < LAY_TAGMAX; ++k ) {
if( toklen == lay_tags[k].taglen ) {
if( !strcmp( lay_tags[k].tagname, tok_upper ) ) {
g_err( err_lay_in_gml, lay_tags[k].tagname );
err_count++;
file_mac_info();
processed = true;
scan_start = scan_stop + 1;
break;
}
}
}
}
}
}
if( *p == '\0' ) {
*p = csave;
}
if( !processed ) { // treat as text
scan_start = tok_start;
}
}
static void scan_script( void )
{
inputcb * cb;
mac_entry * me;
char * p;
char * pt;
int toklen;
int k;
bool cwfound;
cb = input_cbs;
p = scan_start + 1;
scan_restart = scan_start;
if( (*p == '*') || !strnicmp( p, "cm ", 3 ) ) {
scan_start = scan_stop + 1; // .cm +++ ignore comment up to EOL
return; // .* +++ ignore comment up to EOL
}
if( *p == SCR_char && *(p+1) == SCR_char ) {
pt = token_buf;
*pt++ = SCR_char; // special for ...label
*pt++ = SCR_char;
*pt = '\0';
me = NULL;
scan_start = p + 2;
toklen = 2;
} else {
if( *p == '\'' ) { // .'
p++;
ProcFlags.CW_sep_ignore = 1;
} else {
if( CW_sep_char == '\0') {
ProcFlags.CW_sep_ignore = 1;// No separator char no split
} else{
ProcFlags.CW_sep_ignore = 0;
}
if( *p == SCR_char ) { // ..
p++;
ProcFlags.macro_ignore = 1;
me = NULL;
} else {
ProcFlags.macro_ignore = 0;
}
}
if( ProcFlags.literal ) { // no macro or split line if literal
ProcFlags.CW_sep_ignore = 1;
ProcFlags.macro_ignore = 1;
}
if( !ProcFlags.CW_sep_ignore ) { // scan line for CW_sep_char
char * pchar;
pchar = search_separator( buff2, CW_sep_char );
if( pchar != NULL ) {
if( *(pchar + 1) != '\0' ) { // only split if more follows
split_input( buff2, pchar + 1, false );// ignore CW_sep_char
}
*pchar= '\0'; // delete CW_sep_char
buff2_lg = strlen( buff2 ); // new length of first part
}
}
scan_start = p;
pt = token_buf;
while( *p && is_macro_char( *p ) ) { // end of controlword
*pt++ = tolower( *p++ ); // copy lowercase to TokenBuf
}
*pt = '\0';
toklen = pt - token_buf;
if( *p && (*p != ' ') || toklen == 0 ) {// no valid script controlword / macro
// if( !ProcFlags.literal ) { // TBD
// cw_err();
// }
scan_start = scan_restart; // treat as text
return;
}
if( toklen >= MAC_NAME_LENGTH ) {
*(token_buf + MAC_NAME_LENGTH) = '\0';
}
if( !ProcFlags.macro_ignore ) {
me = find_macro( macro_dict, token_buf );
} else {
me = NULL;
}
}
if( me != NULL ) { // macro found
if( GlobalFlags.firstpass && cb->fmflags & II_research ) {
if( cb->fmflags & II_macro ) {
printf_research( "L%d %c%s macro found in macro %s(%d)\n\n",
inc_level, SCR_char, token_buf,
cb->s.m->mac->name, cb->s.m->lineno );
} else {
printf_research( "L%d %c%s macro found in file %s(%d)\n\n",
inc_level, SCR_char, token_buf,
cb->s.f->filename, cb->s.f->lineno );
}
add_SCR_tag_research( token_buf );
}
add_macro_cb_entry( me, NULL );
inc_inc_level();
add_macro_parms( p );
scan_restart = scan_stop + 1;
} else { // try script controlword
cwfound = false;
if( cb->fmflags & II_research && GlobalFlags.firstpass ) {
if( cb->fmflags & II_macro ) {
printf_research( "L%d %c%s CW found in macro %s(%d)\n\n",
inc_level, SCR_char, token_buf,
cb->s.m->mac->name, cb->s.m->lineno );
} else {
printf_research( "L%d %c%s CW found in file %s(%d)\n\n",
inc_level, SCR_char, token_buf,
cb->s.f->filename, cb->s.f->lineno );
}
add_SCR_tag_research( token_buf );
}
if( toklen == SCR_KW_LENGTH ) {
for( k = 0; k < SCR_TAGMAX; ++k ) {
if( !strcmp( scr_tags[k].tagname, token_buf ) ) {
#if 0
if( !ProcFlags.fb_document_done &&
scr_tags[k].cwflags & cw_o_t ) {
/***************************************************/
/* if this is the first cw which produces output */
/* set page geometry and margins from layout */
/***************************************************/
do_layout_end_processing();
}
#endif
if( !ProcFlags.layout && (scr_tags[k].cwflags & cw_o_t) ) {
/********************************************************/
/* this is the first control word which produces output */
/* start the document, the layout is done */
/* start_doc_sect() calls do_layout_end_processing() */
/********************************************************/
start_doc_sect();
}
if( ProcFlags.literal ) { // .li active
if( !strcmp( token_buf, "li" ) ) { // .li
scan_start = p; // found, process
scr_tags[k].tagproc();
}
} else {
scan_start = p; // script controlword found, process
if( scr_tags[k].cwflags & cw_break ) {
scr_process_break();// output incomplete line, if any
}
scr_tags[k].tagproc();
}
cwfound = true;
break;
}
}
}
if( !cwfound ) {
cw_err(); // unrecognized control word
}
}
scan_start = scan_restart;
}
