75 lines
2.5 KiB
C
75 lines
2.5 KiB
C
/****************************************************************
|
|
* *
|
|
* Copyright 2010, 2012 Fidelity Information Services, Inc *
|
|
* *
|
|
* This source code contains the intellectual property *
|
|
* of its copyright holder(s), and is made available *
|
|
* under a license. If you do not know the terms of *
|
|
* the license, please stop and do not read further. *
|
|
* *
|
|
****************************************************************/
|
|
|
|
#include "mdef.h"
|
|
|
|
#include "rtnhdr.h"
|
|
#include "stack_frame.h"
|
|
#include "op.h"
|
|
#include "lv_val.h"
|
|
#include "gdsroot.h"
|
|
#include "gtm_facility.h"
|
|
#include "fileinfo.h"
|
|
#include "gdsbt.h"
|
|
#include "gdsfhead.h"
|
|
#include "alias.h"
|
|
|
|
GBLREF mval *alias_retarg;
|
|
GBLREF boolean_t dollar_zquit_anyway;
|
|
|
|
LITREF mval literal_null;
|
|
|
|
error_def(ERR_QUITARGREQD);
|
|
error_def(ERR_QUITALSINV);
|
|
|
|
/* Routine to:
|
|
* (1) To turn off the MV_RETARG flag in the mval returned from the M function call.
|
|
* (2) To verify the flag was ON in the first place, else this is not a return value.
|
|
* (3) To verify the MV_ALIASCONT flag is NOT on which would signify a QUIT * was done
|
|
* which does not match with this non-alias invocation. It would be possible to
|
|
* convert the arg at this point and let it pass but the requestors of this
|
|
* enhancement have asked an error to be generated so simple mistakes are not
|
|
* difficult to track down. This behavior could easily be made optional at some
|
|
* point in the future.
|
|
*/
|
|
void op_exfunret(mval *retval)
|
|
{
|
|
unsigned short savtyp;
|
|
lv_val *srclvc;
|
|
|
|
savtyp = retval->mvtype;
|
|
retval->mvtype &= ~MV_RETARG;
|
|
if (0 == (MV_RETARG & savtyp))
|
|
/* if dollar_zquit_anyway is TRUE, then do not give an error when no value is returned from an
|
|
* extrinsic; just make the return value NULL instead
|
|
*/
|
|
if (dollar_zquit_anyway)
|
|
*retval = literal_null;
|
|
else
|
|
rts_error(VARLSTCNT(1) ERR_QUITARGREQD);
|
|
if (0 != (MV_ALIASCONT & savtyp))
|
|
{ /* We have an alias container return which has already had its reference counts increased. Remove
|
|
* the extra reference counts before we raise the actual error since the assignment and thus the
|
|
* alias reference are NOT being created.
|
|
*/
|
|
srclvc = (lv_val *)retval->str.addr;
|
|
assert(LV_IS_BASE_VAR(srclvc)); /* Verify base var */
|
|
assert(srclvc->stats.trefcnt >= srclvc->stats.crefcnt);
|
|
assert(1 <= srclvc->stats.crefcnt); /* Verify is existing container ref */
|
|
DECR_CREFCNT(srclvc);
|
|
DECR_TREFCNT(srclvc);
|
|
alias_retarg = NULL;
|
|
rts_error(VARLSTCNT(1) ERR_QUITALSINV);
|
|
}
|
|
assert(NULL == alias_retarg);
|
|
}
|
|
|