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 ); }