cg_name SCBLength( cg_name scb ) {
//================================
// Get length from SCB.
return( CGUnary( O_POINTS, SCBLenAddr( scb ), TY_UNSIGNED ) );
}
void FCSetSCBLen( void ) {
//=====================
// Fill scb length
sym_id scb;
cg_name len;
// Get general information
scb = GetPtr();
len = GetTypedValue();
CGTrash( CGAssign( SCBLenAddr( CGFEName( scb, TY_CHAR ) ), len, TY_INTEGER ) );
}
void MakeSCB( sym_id scb, cg_name len ) {
//==========================================
// Make an SCB.
CGTrash( CGAssign( SCBLenAddr( CGFEName( scb, TY_CHAR ) ), len, TY_INTEGER ) );
// assumption is that the pointer in the SCB is the first field in
// the SCB so that when we push the cg_name returned by CGAssign()
// it is a pointer to the SCB
XPush( CGLVAssign( SCBPtrAddr( CGFEName( scb, TY_CHAR ) ), XPop(), TY_POINTER ) );
// Don't do it the following way:
// CGTrash( CGAssign( SCBPtrAddr( CGFEName( scb, TY_CHAR ) ), XPop(), TY_POINTER ) );
// XPush( CGFEName( scb, TY_CHAR ) );
}
void FCIntlArrSet( void ) {
//======================
// Call runtime routine to set internal file to character array.
call_handle handle;
sym_id sym;
sym_id scb;
sym = GetPtr();
scb = GetPtr();
CGTrash( CGAssign( SCBLenAddr( CGFEName( scb, TY_POINTER ) ),
ArrayEltSize( sym ), TY_INTEGER ) );
CGTrash( CGAssign( SCBPtrAddr( CGFEName( scb, TY_POINTER ) ),
SymAddr( sym ), TY_POINTER ) );
handle = InitCall( RT_SET_INTL );
CGAddParm( handle, ArrayNumElts( sym ), TY_INT_4 );
CGAddParm( handle, CGFEName( scb, TY_POINTER ), TY_POINTER );
CGDone( CGCall( handle ) );
}
void FCSubString( void ) {
//=====================
// Do substring operation.
sym_id char_var;
sym_id dest;
cg_name src;
cg_name first_1;
cg_name first_2;
cg_name last;
unsigned_16 typ_info;
cg_name len;
cg_name ptr;
call_handle call;
char_var = GetPtr();
typ_info = GetU16();
src = XPop();
first_1 = XPopValue( GetType1( typ_info ) );
if( char_var == NULL ) { // i.e. chr(i:i)
len = CGInteger( GetInt(), TY_INTEGER );
if( Options & OPT_BOUNDS ) {
CloneCGName( first_1, &first_1, &last );
last = CGBinary( O_PLUS, last, len, TY_INTEGER );
last = CGBinary( O_MINUS, last, CGInteger( 1, TY_INTEGER ),
TY_INTEGER );
}
} else {
last = XPop();
if( last == NULL ) {
if( char_var->ns.xt.size == 0 ) {
last = CharItemLen( char_var );
} else {
last = CGInteger( char_var->ns.xt.size, TY_INTEGER );
}
} else {
XPush( last );
last = XPopValue( GetType2( typ_info ) );
}
if( !( Options & OPT_BOUNDS ) ) {
CloneCGName( first_1, &first_1, &first_2 );
len = CGBinary( O_MINUS, last, first_2, TY_INTEGER );
len = CGBinary( O_PLUS, len, CGInteger( 1, TY_INTEGER ), TY_INTEGER );
}
}
dest = GetPtr();
if( Options & OPT_BOUNDS ) {
call = InitCall( RT_SUBSTRING );
CGAddParm( call, CGFEName( dest, TY_CHAR ), TY_LOCAL_POINTER );
CGAddParm( call, last, TY_INT_4 );
CGAddParm( call, first_1, TY_INT_4 );
CGAddParm( call, src, TY_LOCAL_POINTER );
XPush( CGBinary( O_COMMA, CGCall( call ), CGFEName( dest, TY_CHAR ),
TY_LOCAL_POINTER ) );
} else {
ptr = CGBinary( O_PLUS, SCBPointer( src ),
CGBinary( O_MINUS, first_1, CGInteger( 1, TY_INTEGER ),
TY_INTEGER ),
TY_GLOBAL_POINTER );
CGTrash( CGAssign( SCBLenAddr( CGFEName( dest, TY_CHAR ) ),
len, TY_INTEGER ) );
// Assumption is that the pointer in the SCB is the first field in
// the SCB so that when we push the cg_name returned by CGAssign()
// it is a pointer to the SCB. We must leave the assignment of the
// pointer into the SCB in the tree so that the aliasing information
// is not lost.
XPush( CGLVAssign( SCBPtrAddr( CGFEName( dest, TY_CHAR ) ),
ptr, TY_GLOBAL_POINTER ) );
// Don't do it the following way:
// CGTrash( CGAssign( SCBPtrAddr( CGFEName( dest, TY_CHAR ) ),
// ptr, TY_GLOBAL_POINTER ) );
// XPush( CGFEName( dest, TY_CHAR ) );
}
}