void ParenCat( void ) {
//==========================
// Check if ) matches ( as opposed to [.
// called on ) // sequence
itnode *cit;
bool ok_to_axe;
bool all_const_opns;
cit = findMatch( &ok_to_axe, &all_const_opns );
if( cit != NULL ) {
// consider: a(1)(2:3)//c
if( ( cit->opr == OPR_LBR ) && ok_to_axe ) {
ReqNOpn();
cit->is_catparen = 1;
cit = CITNode;
AdvanceITPtr();
FreeOneNode( cit );
// check for CHAR(73) - CHAR is allowed in constant expressions
} else if( (cit->opr != OPR_FBR) || !all_const_opns ||
((cit->link->flags & SY_CLASS ) != SY_SUBPROGRAM) ||
(!(cit->link->flags & SY_INTRINSIC)) ||
(cit->link->sym_ptr->ns.si.fi.index != IF_CHAR) ) {
ChkConstCatOpn( CITNode->link );
}
}
BackTrack();
}
void KillOpnOpr(void) {
//====================
// jnneeded opn followed by unneeded opr in consecutive nodes so
// copy opr from node 1 down to node 2, then release node 1
//
// CASE1: (not at start-node of expression)
//
// --------------- ---------------
// Before: | opr1 | opn1 | After: released
// --------------- ---------------
// CIT==> | opr2 | opn2 | CIT==> | opr1 | opn2 |
// --------------- ---------------
//
// CASE2: (start-node of expression)
// DO NOT release start-node since some unknown itnode points at
// him
//
// --------------- ---------------
// Before: | TRM | opn1 | After: | PHI | PHI |
// --------------- ---------------
// CIT==> | opr2 | opn2 | CIT==> | TRM | opn2 |
// --------------- ---------------
//
// In CASE1, top node is released since there may not be room to copy
// operand up (variable length), but can easily copy operator-code down
itnode *itptr;
CITNode->opr = BkLink->opr; // copy operator information
CITNode->is_catparen = BkLink->is_catparen; // ...
CITNode->oprpos = BkLink->oprpos;
if( BkLink->opr == OPR_TRM ) {
BkLink->opr = OPR_PHI;
BkLink->link = CITNode; // restore link to point forward
BkLink = NULL;
} else {
itptr = BkLink; // back up to previous entry
BkLink = itptr->link; // fix back link
FreeOneNode( itptr ); // free single itnode
}
}
static void Free2CIT( itnode *node ) {
//========================================
// Free all nodes between "node" and "CITNode".
itnode *junk;
itnode *chaser;
// this code makes a(3)/3*5/ from a type declaration look like
// a/3*5/ as in a DATA statement so we can call DoData().
junk = node->link;
node->link = CITNode;
chaser = junk;
while( chaser != CITNode ) {
chaser = chaser->link;
FreeOneNode( junk );
junk = chaser;
}
}
static void USCleanUp( void ) {
//=================================
// Clean up text list after expression error has occurred
// releasing all nodes on the way, leaving:
// +------------------+
// CIT ==> | OPR_TRM | |
// +------------------+
// | OPR_TRM | |
// +------------------+
// NOTE : CITNode must not be pointing at the end of expression terminal
itnode *junk;
itnode *first;
while( CITNode->opr != OPR_TRM ) {
BackTrack();
}
first = CITNode;
switch( first->opn.us & USOPN_WHAT ) {
case USOPN_NWL:
case USOPN_ASS:
if( first->list != NULL ) {
FreeITNodes( first->list );
}
}
CITNode = CITNode->link;
while( CITNode->opr != OPR_TRM ) {
junk = CITNode;
CITNode = CITNode->link;
FreeOneNode( junk );
}
first->link = CITNode;
CITNode = first;
CITNode->typ = FT_NO_TYPE;
CITNode->opn.ds = DSOPN_PHI;
}
static void RemoveParen( void ) {
//===================================
// Upscan routine when second operator is '('.
//
// Before: | After:
// -------------- | --------------
// CIT ==> | opr1 | PHI | | released**
// -------------- | --------------
// | ( | opn | | CIT ==> | opr1 | opn |
// -------------- | --------------
// | ) | PHI | | released
// -------------- | --------------
// | opr2 | | | | opr2 | |
// -------------- | --------------
//
// ** see KillOpnOpr() for case where first node is start-node of expr
itnode *cit;
if( CITNode->opn.ds != DSOPN_PHI ) {
AdvError( SX_NO_OPR );
}
MoveDown();
KillOpnOpr();
cit = CITNode;
if( CITNode->opn.ds == DSOPN_PHI ) {
Error( PC_SURP_PAREN );
}
CITNode = CITNode->link;
if( CITNode->opn.ds != DSOPN_PHI ) {
Error( SX_NO_OPR );
}
cit->link = CITNode->link;
FreeOneNode( CITNode );
CITNode = cit;
}
void CatParen( void ) {
//==========================
// Check if ) matches ( as opposed to [.
// called on // ) sequence
itnode *cit;
bool ok_to_axe;
cit = findMatch( &ok_to_axe, NULL );
if( cit != NULL ) {
if( ( cit->opr == OPR_LBR ) && ok_to_axe ) {
cit->is_catparen = 1;
cit = CITNode;
AdvanceITPtr();
ReqNOpn();
cit->link = CITNode->link;
FreeOneNode( CITNode );
CITNode = cit;
} else {
CatOpn();
}
}
}
