fis-gtm/sr_port/m_zwrite.c

358 lines
9.7 KiB
C

/****************************************************************
* *
* Copyright 2001, 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 "mdq.h"
#include "opcode.h"
#include "nametabtyp.h"
#include "indir_enum.h"
#include "gdsroot.h"
#include "gtm_facility.h"
#include "fileinfo.h"
#include "gdsbt.h"
#include "gdsfhead.h"
#include "zwrite.h"
#include "toktyp.h"
#include "svnames.h"
#include "funsvn.h"
#include "advancewindow.h"
#include "cmd.h"
#include "compile_pattern.h"
#include "mvalconv.h"
#include "namelook.h"
GBLREF char window_token;
GBLREF mval window_mval;
GBLREF mident window_ident;
GBLREF triple *curtchain;
GBLREF char director_token;
GBLREF short int source_column;
GBLREF uint4 pat_everything[];
GBLREF mstr_len_t sizeof_pat_everything;
error_def(ERR_COMMA);
error_def(ERR_INVSVN);
error_def(ERR_RPARENMISSING);
error_def(ERR_SVNEXPECTED);
error_def(ERR_VAREXPECTED);
error_def(ERR_ZWRSPONE);
LITREF unsigned char svn_index[];
LITREF nametabent svn_names[];
LITREF svn_data_type svn_data[];
/****** CAUTION !!! ******
* All occurrences of put_lit should be replaced by put_ilit. In order to maintain object
* code compatibility, however, this replacement has been preempted by preceding put_lit
* with n2s.
* -no runtime module looks at anything but nm, so call to n2s is dispensed with. -mwm
*/
int m_zwrite(void)
{
int index;
int4 pcount; /* parameter count */
triple *ref, *ref1, *head, *last, *count;
opctype op;
oprtype name, limit;
mval mv;
mint code;
mint subscount;
char c;
boolean_t parse_warn, pat;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
subscount = 0;
count = 0;
pat = FALSE;
if (TK_CIRCUMFLEX == window_token)
{
advancewindow();
op = OC_GVZWRITE;
} else
op = OC_LVZWRITE;
switch(window_token)
{
case TK_SPACE:
case TK_EOL:
if (OC_GVZWRITE == op)
{
stx_error(ERR_VAREXPECTED);
return FALSE;
}
op = OC_LVPATWRITE;
head = maketriple(op);
head->operand[0] = put_ilit((mint)3); /* count */
ref1 = newtriple(OC_PARAMETER);
head->operand[1] = put_tref(ref1);
ref1->operand[0] = put_ilit(0); /* shows not from zshow */
ref = newtriple(OC_PARAMETER);
ref1->operand[1] = put_tref(ref);
ref->operand[0] = put_str((char *)pat_everything, sizeof_pat_everything);
MV_FORCE_MVAL(&mv, ZWRITE_ASTERISK) ;
ref->operand[1] = put_lit(&mv);
ins_triple(head);
return TRUE;
case TK_IDENT:
name = put_str(window_ident.addr, window_ident.len);
advancewindow();
break;
case TK_DOLLAR:
advancewindow();
if ((TK_IDENT != window_token) || (OC_GVZWRITE == op))
{
stx_error(ERR_SVNEXPECTED);
return FALSE;
}
parse_warn = FALSE;
index = namelook(svn_index, svn_names, window_ident.addr, window_ident.len);
if (0 > index)
{
STX_ERROR_WARN(ERR_INVSVN); /* sets "parse_warn" to TRUE */
} else
{
if (!VALID_SVN(index))
{
STX_ERROR_WARN(ERR_FNOTONSYS); /* sets "parse_warn" to TRUE */
}
}
advancewindow();
switch(window_token)
{
case TK_SPACE:
case TK_EOL:
case TK_COMMA:
if (!parse_warn)
{
assert(SV_NUM_SV > svn_data[index].opcode);
ref = maketriple(OC_ZWRITESVN);
ref->operand[0] = put_ilit(svn_data[index].opcode);
ins_triple(ref);
} else
{ /* OC_RTERROR triple would have been inserted in curtchain by ins_errtriple
* (invoked by stx_error). No need to do anything else.
*/
assert(OC_RTERROR == curtchain->exorder.bl->exorder.bl->exorder.bl->opcode);
}
return TRUE;
default:
stx_error(ERR_SVNEXPECTED);
return FALSE;
}
break;
case TK_LPAREN:
if (OC_GVZWRITE != op) /* naked reference */
{
stx_error(ERR_VAREXPECTED);
return FALSE;
}
name = put_str(window_ident.addr, 0);
break;
case TK_ATSIGN:
if (!indirection(&name))
return FALSE;
if ((OC_LVZWRITE == op) && (TK_LPAREN != window_token))
{
ref = maketriple(OC_COMMARG);
ref->operand[0] = name;
ref->operand[1] = put_ilit(indir_zwrite);
ins_triple(ref);
return TRUE;
}
ref = newtriple(OC_INDPAT);
ref->operand[0] = name;
name = put_tref(ref);
break;
case TK_QUESTION:
advancewindow();
source_column = TREF(last_source_column);
if (!compile_pattern(&name, FALSE))
return FALSE;
if (op == OC_LVZWRITE)
op = OC_LVPATWRITE;
pat = TRUE;
break;
default:
stx_error(ERR_VAREXPECTED);
return FALSE;
}
head = maketriple(op);
last = newtriple(OC_PARAMETER);
head->operand[1] = put_tref(last);
pcount = 1;
if ((OC_LVPATWRITE == op) || (OC_GVZWRITE == op))
{
pcount++;
last->operand[0] = put_ilit((op == OC_GVZWRITE ? pat : 0));
ref = newtriple(OC_PARAMETER);
last->operand[1] = put_tref(ref);
last = ref;
if (OC_GVZWRITE == op)
{
pcount++;
count = last;
ref = newtriple(OC_PARAMETER);
last->operand[1] = put_tref(ref);
last = ref;
}
}
last->operand[0] = name;
if (TK_LPAREN != window_token)
{
pcount++;
if (pat)
{
MV_FORCE_MVAL(&mv, ZWRITE_END);
} else
{
subscount++ ;
MV_FORCE_MVAL(&mv, ZWRITE_ASTERISK);
}
last->operand[1] = put_lit(&mv);
head->operand[0] = put_ilit(pcount);
if (count)
count->operand[0] = put_ilit(subscount);
ins_triple(head);
return TRUE;
}
advancewindow();
for(;;)
{
ref = newtriple(OC_PARAMETER);
last->operand[1] = put_tref(ref);
switch (window_token)
{
case TK_RPAREN:
dqdel(ref,exorder);
advancewindow();
MV_FORCE_MVAL(&mv, ZWRITE_END);
last->operand[1] = put_lit(&mv);
pcount++;
head->operand[0] = put_ilit((mint)pcount);
if (count)
count->operand[0] = put_ilit(subscount);
ins_triple(head);
return TRUE;
case TK_ASTERISK:
dqdel(ref,exorder);
advancewindow();
if (window_token != TK_RPAREN)
{
stx_error(ERR_RPARENMISSING);
return FALSE;
}
advancewindow();
MV_FORCE_MVAL(&mv, ZWRITE_ASTERISK);
last->operand[1] = put_lit(&mv);
pcount++;
subscount++;
head->operand[0] = put_ilit((mint)pcount);
if (count)
count->operand[0] = put_ilit(subscount);
ins_triple(head);
return TRUE;
case TK_QUESTION:
advancewindow();
source_column = TREF(last_source_column);
if (!compile_pattern(&limit, FALSE))
return FALSE;
if (window_token != TK_COMMA && window_token != TK_RPAREN)
{
stx_error(ERR_ZWRSPONE);
return FALSE;
}
if (TK_COMMA == window_token)
advancewindow();
subscount++;
MV_FORCE_MVAL(&mv, ZWRITE_PATTERN);
ref->operand[0] = put_lit(&mv);
pcount++;
ref1 = newtriple(OC_PARAMETER);
ref->operand[1] = put_tref(ref1);
ref1->operand[0] = limit;
last = ref1;
pcount++;
continue;
case TK_COLON:
if ((c = director_token) != TK_RPAREN)
{
if (TK_COMMA != c)
{
advancewindow();
MV_FORCE_MVAL(&mv, ZWRITE_UPPER);
ref->operand[0] = put_lit(&mv);
pcount++;
subscount++;
break;
}
advancewindow();
}
/* caution: fall through */
case TK_COMMA:
advancewindow();
MV_FORCE_MVAL(&mv, ZWRITE_ALL);
ref->operand[0] = put_lit(&mv);
pcount++;
subscount++;
last = ref;
continue;
default:
if (!expr(&limit))
return FALSE;
subscount++;
last = newtriple(OC_PARAMETER);
ref->operand[1] = put_tref(last);
last->operand[0] = limit;
pcount++;
if (TK_COLON == (c = window_token))
{
code = ZWRITE_LOWER;
advancewindow();
c = window_token;
} else
code = ZWRITE_VAL;
switch (c)
{
case TK_COMMA:
advancewindow();
/* caution: fall through */
case TK_RPAREN:
MV_FORCE_MVAL(&mv, code) ;
ref->operand[0] = put_lit(&mv);
pcount++;
continue;
default:
if (code == ZWRITE_VAL)
{
stx_error(ERR_COMMA);
return FALSE;
}
MV_FORCE_MVAL(&mv, ZWRITE_BOTH) ;
ref->operand[0] = put_lit(&mv);
pcount++;
ref = last;
break;
}
break;
}
if (!expr(&limit))
return FALSE;
last = newtriple(OC_PARAMETER);
ref->operand[1] = put_tref(last);
last->operand[0] = limit;
pcount++;
if (window_token == TK_COMMA)
advancewindow();
}
}