void ArrayIO( RTCODE num_array, RTCODE chr_array ) {
//=====================================================
// Output an array.
sym_id arr;
sym_id field;
cg_name addr;
cg_name num_elts;
cg_name elt_size;
arr = GetPtr();
field = GetPtr();
if( field == NULL ) {
addr = SymAddr( arr );
num_elts = ArrayNumElts( arr );
if( arr->ns.typ == FT_CHAR ) {
ChrArrayIO( chr_array, addr, num_elts, ArrayEltSize( arr ) );
} else {
NumArrayIO( num_array, addr, num_elts,
ParmType( arr->ns.typ, arr->ns.xt.size ) );
}
} else { // must be a array field in a structure
addr = XPop();
num_elts = FieldArrayNumElts( field );
if( field->fd.typ == FT_CHAR ) {
elt_size = CGInteger( field->fd.xt.size, TY_INTEGER );
ChrArrayIO( chr_array, addr, num_elts, elt_size );
} else {
NumArrayIO( num_array, addr, num_elts,
ParmType( field->fd.typ, field->fd.xt.size ) );
}
}
}
cg_type F772CGType( sym_id sym ) {
//========================================
// Map a WATFOR-77 type to a CG type.
if( sym->ns.typ == FT_STRUCTURE ) return( sym->ns.xt.record->cg_typ );
return( MkCGType( ParmType( sym->ns.typ, sym->ns.xt.size ) ) );
}
static void StructIOItem( sym_id fd ) {
//=========================================
// Perform i/o of structure field.
RTCODE rtn;
if( fd->fd.dim_ext == NULL ) {
XPush( TmpVal( TmpStructPtr, TY_POINTER ) );
if( fd->fd.typ == FT_CHAR ) {
XPush( CGInteger( fd->fd.xt.size, TY_INTEGER ) );
}
IORtnTable[ ParmType( fd->fd.typ, fd->fd.xt.size ) ]();
CGTrash( CGAssign( TmpPtr( TmpStructPtr, TY_POINTER ),
CGBinary( O_PLUS,
TmpVal( TmpStructPtr, TY_POINTER ),
CGInteger( fd->fd.xt.size, TY_UINT_4 ),
TY_POINTER ),
TY_POINTER ) );
} else {
if( IORtnTable == &OutRtn ) {
rtn = RT_PRT_ARRAY;
} else {
rtn = RT_INP_ARRAY;
}
if( fd->fd.typ == FT_CHAR ) {
ChrArrayIO( rtn + 1, TmpVal( TmpStructPtr, TY_POINTER ),
CGInteger( fd->fd.dim_ext->num_elts, TY_INT_4 ),
CGInteger( fd->fd.xt.size, TY_INTEGER ) );
} else {
NumArrayIO( rtn, TmpVal( TmpStructPtr, TY_POINTER ),
CGInteger( fd->fd.dim_ext->num_elts, TY_INT_4 ),
ParmType( fd->fd.typ, fd->fd.xt.size ) );
}
CGTrash( CGAssign( TmpPtr( TmpStructPtr, TY_POINTER ),
CGBinary( O_PLUS,
TmpVal( TmpStructPtr, TY_POINTER ),
CGInteger( fd->fd.xt.size *
fd->fd.dim_ext->num_elts,
TY_UINT_4 ),
TY_POINTER ),
TY_POINTER ) );
}
}
static void GIORoutine( TYPE typ, uint size ) {
//=================================================
FCODE op_code;
op_code = ParmType( typ, size ) - PT_LOG_1;
if( StmtProc == PR_READ ) {
EmitOp( op_code + FC_INP_LOG1 );
} else {
EmitOp( op_code + FC_OUT_LOG1 );
}
}
static void InitArr( act_dim_list *dim, TYPE typ, uint size ) {
//=================================================================
// Data initialize an array.
unsigned_32 num_elts;
num_elts = dim->num_elts;
while( num_elts != 0 ) {
DtItemSize = size; // AsnVal() sets DtItemSize to 0 when done
AsnVal( ParmType( typ, size ) );
DtOffset += size;
num_elts--;
}
}
static void StructInitItem( sym_id fd ) {
//===========================================
// Initialize a structure field.
DtItemSize = fd->u.fd.xt.size;
if( fd->u.fd.dim_ext == NULL ) {
AsnVal( ParmType( fd->u.fd.typ, DtItemSize ) );
} else {
if( fd->u.fd.typ == FT_STRUCTURE ) {
InitStructArr( fd, fd->u.fd.dim_ext );
} else {
InitArr( fd->u.fd.dim_ext, fd->u.fd.typ, DtItemSize );
}
}
}
static int DumpArgInfo( itnode *node ) {
//===========================================
// Dump argument types.
int num_args;
unsigned_16 arg_info;
PTYPE parm_type;
PCODE parm_code;
#if _CPU == 386
aux_info *aux;
#endif
num_args = 0;
if( node != NULL ) {
for(;;) {
if( node->opr == OPR_COL )
break;
if( node->opr == OPR_RBR )
break;
if( node->opn.ds == DSOPN_PHI )
break;
if( node->opn.us != USOPN_STN ) {
parm_type = ParmType( node->typ, node->size );
parm_code = ParmClass( node );
#if _CPU == 386
if( (parm_code == PC_PROCEDURE) || (parm_code == PC_FN_OR_SUB) ) {
aux = AuxLookup( node->sym_ptr );
if( aux->cclass & FAR16_CALL ) {
parm_code |= PC_PROC_FAR16;
}
}
#endif
arg_info = _SetTypeInfo( parm_code, parm_type );
OutU16( arg_info );
++num_args;
}
node = node->link;
}
}
return( num_args );
}
