void ConstCat( int size ) {
//============================
itnode *last_node;
byte *dest;
int opn_size;
int size_left;
byte *string;
itnode *link_node;
last_node = CITNode;
string = FMemAlloc( size );
size_left = size;
dest = string;
for(;;) {
opn_size = last_node->value.cstring.len;
memcpy( dest, last_node->value.cstring.strptr, opn_size );
size_left -= opn_size;
if( size_left == 0 ) break;
last_node = last_node->link;
dest += opn_size;
}
CITNode->value.cstring.strptr = (char *)string;
CITNode->value.cstring.len = size;
CITNode->size = size;
link_node = last_node->link;
last_node->link = NULL;
FreeITNodes( CITNode->link );
CITNode->link = link_node;
AddConst( CITNode );
CITNode->value.cstring.strptr = (char *)&CITNode->sym_ptr->u.lt.value;
FMemFree( string );
}
void InitImpDo( itnode *lastcomma ) {
//======================================
// Initialize the implied DO-loop.
int level;
itnode *imp_do_list;
CITNode = lastcomma;
CITNode->opr = OPR_TRM; // marks the end of the i/o list
ImpDo();
if( !ReqCloseParen() ) {
level = 0;
for(;;) {
if( RecOpenParen() ) {
level++;
} else if( RecCloseParen() ) {
level--;
}
if( level < 0 ) break;
if( CITNode->link == NULL ) {
DelCSNode();
CITNode->opr = OPR_TRM;
CITNode->oprpos = 9999;
break;
}
AdvanceITPtr();
}
}
ReqNOpn();
imp_do_list = lastcomma->link;
lastcomma->link = CITNode->link;
CITNode->link = NULL;
FreeITNodes( imp_do_list );
}
void CatArgs( int num ) {
//==================================
// Generate code for concatenation arguments.
itnode *itptr;
itnode *junk;
int count;
itptr = CITNode;
count = num;
for(;;) {
// Don't call CatArg() if no operand or not of type character.
// This covers the case where invalid operands are specified.
if( ( itptr->opn.ds != DSOPN_PHI ) && ( itptr->typ == FT_CHAR ) ) {
GCatArg( itptr );
}
if( --count <= 0 ) break;
itptr = itptr->link;
}
if( CITNode != itptr ) {
junk = CITNode->link;
CITNode->link = itptr->link;
itptr->link = NULL;
FreeITNodes( junk );
}
}
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;
}
void SFPrologue( void ) {
//====================
// Generate code for statement function prologue.
sym_id sym;
itnode *func_node;
itnode *arg_list;
sf_parm **parm;
StmtSw |= SS_SF_REFERENCED;
CkTypeDeclared();
SFSymId = CITNode->sym_ptr;
if( ( SFSymId->ns.typ == FT_CHAR ) && ( SFSymId->ns.xt.size == 0 ) ) {
Error( SF_ILL_CHAR_LEN );
} else if( SFSymId->ns.typ == FT_STRUCTURE ) {
Error( SF_ILL_TYPE );
}
GStartSF();
SFSymId->ns.flags = SY_USAGE | SY_TYPE | SY_SUBPROGRAM | SY_STMT_FUNC;
CITNode->flags = SFSymId->ns.flags;
func_node = CITNode;
AdvanceITPtr();
ReqOpenParen();
SFSymId->ns.si.sf.header = FMemAlloc( sizeof( sf_header ) );
SFSymId->ns.si.sf.header->ref_count = 1;
parm = &SFSymId->ns.si.sf.header->parm_list;
*parm = NULL;
if( RecNOpn() ) {
AdvanceITPtr();
} else {
for(;;) {
if( ReqName( NAME_SF_DUMMY ) ) {
sym = LkSym();
sym->ns.xflags |= SY_DEFINED;
CkTypeDeclared();
if( ( ( sym->ns.flags & SY_CLASS ) == SY_VARIABLE ) &&
( ( sym->ns.flags & SY_SUBSCRIPTED ) == 0 ) &&
( ( sym->ns.typ != FT_CHAR ) ||
( sym->ns.xt.size != 0 ) ) &&
( sym->ns.typ != FT_STRUCTURE ) ) {
if( sym->ns.flags & SY_SPECIAL_PARM ) {
Error( SF_DUPLICATE_DUMMY_PARM );
} else {
*parm = FMemAlloc( sizeof( sf_parm ) );
(*parm)->link = NULL;
(*parm)->actual = sym;
(*parm)->shadow = STShadow( sym );
parm = &((*parm)->link);
}
} else {
Error( SF_ILL_DUMMY_PARM );
}
}
AdvanceITPtr();
if( !RecComma() ) break;
}
}
ReqCloseParen();
ReqNOpn();
arg_list = func_node->link;
func_node->link = CITNode->link;
CITNode->link = NULL;
CITNode = func_node;
FreeITNodes( arg_list );
}
