/*{
** Name: IIAG4fosFreeObjectStack - Free objects from the Known Obj stack
**
** Description:
** Pop the Known object stack back to the specified size, which must be
** non-negative and not more than the current stack size. This marks
** the objects as "unknown". Also, reference count information can
** be decremented in the previously known objects so that ABF run-time can
** potentially free up memory (this step is skipped for now).
**
** Inputs:
** reset_sp {nat} value to reset stackpointer to.
**
** Outputs:
** NONE.
**
** Returns:
** OK - object stack reset
** E_G42726_NO_INIT - stack was never initialized.
** E_G42728_BAD_STACK_POP - invalid stackpointer value (beyond current).
**
** History:
** 15-dec-92 (davel)
** Initial version.
*/
STATUS
IIAG4fosFreeObjectStack(i4 reset_sp)
{
G4ERRDEF g4errdef;
if (alloc_stacksize == 0)
{
g4errdef.errmsg = E_G42726_NO_INIT;
g4errdef.numargs = 0;
IIAG4semSetErrMsg(&g4errdef, TRUE);
return E_G42726_NO_INIT;
}
else if (reset_sp < 0 || reset_sp > stackpointer)
{
/* this should never happen. Show the current and reset stackpointers
** in the error message.
*/
char buf[64];
g4errdef.errmsg = E_G42728_BAD_STACK_POP;
g4errdef.numargs = 1;
STprintf(buf, "%d -> %d", stackpointer, reset_sp);
g4errdef.args[0] = (PTR)buf;
IIAG4semSetErrMsg(&g4errdef, TRUE);
return E_G42728_BAD_STACK_POP;
}
else
{
/* XXX just reset the stack for now; no reference count decrementing */
stackpointer = reset_sp;
return OK;
}
}
/*{
** Name: IIAG4gkoGetKnownObject - Get a known object by its index number
**
** Description:
** Validate the index number and make sure that the known object stack
** has been initialized. An index of zero means the "NULL object", which
** ABF probably doesn't need. Return the PTR
** from the objectstack corresponding to the specified index.
**
** Inputs:
** index i4 object handle
**
** Outputs:
** object PTR * object found (if OK is returned)
**
** Returns:
** STATUS
** E_G4271E_BAD_OBJECT
**
** History:
** 15-dec-92 (davel)
** Initial version, based on W4GL version developed by MikeS.
*/
STATUS
IIAG4gkoGetKnownObject(i4 index, PTR *object)
{
G4ERRDEF g4errdef;
if (index == 0)
{
*object = (PTR)NULL;
return OK;
}
else if (alloc_stacksize == 0)
{
g4errdef.errmsg = E_G42726_NO_INIT;
g4errdef.numargs = 0;
IIAG4semSetErrMsg(&g4errdef, TRUE);
return E_G42726_NO_INIT;
}
else if (index < 0 || index > stackpointer)
{
return E_G4271E_BAD_OBJECT;
}
else
{
*object = objectstack[index-1];
return OK;
}
}
/*{
** Name: IIAG4s4Set4GL - EXEC 4GL SET
**
** Description:
** Return data for the various possible sets. Note that some
** parameters are unused for some inquiries.
**
** Inputs:
** object i4 object to inquire about
** code i4 Which inquire to perform
** ind *i2 User's null indicator
** isvar i4 data passed by reference
** type i4 ADF type of user's variable
** length i4 size of user's variable
** data PTR User's data buffer
**
** Returns:
** STATUS
**
** History:
** 22-dec-92 (davel)
** Initial version, based on W4GL version developed by MikeS.
*/
STATUS
IIAG4s4Set4GL
(i4 object, i4 code, i2 *ind, i4 isvar, i4 type, i4 length, PTR data)
{
STATUS status;
G4ERRDEF g4errdef;
DB_DATA_VALUE dbv;
i4 intin;
/*
** Currently, the object parameter is never used. If, in the future,
** some types of SET require it, it should be checked here.
*/
/* Set up our DBV. */
switch (code)
{
case G4STmessages:
dbv.db_datatype = DB_INT_TYPE;
dbv.db_prec = 0;
dbv.db_length = 4;
dbv.db_data = (PTR)&intin;
break;
}
/*
** Now that we have a DBV, fill it from 3GL. Set common g4errdef info
** first; IIAG4set_data may reset this information for certain errors.
*/
g4errdef.numargs = 3;
g4errdef.args[0] = iiAG4routineNames[G4SET_ID];
g4errdef.args[1] = iiAG4routineNames[G4SET_ID];
g4errdef.args[2] = iiAG4settypes[code];
if ((status = IIAG4set_data( &dbv, ind, isvar, type, length, data,
&g4errdef)) != OK)
{
g4errdef.errmsg = status;
IIAG4semSetErrMsg(&g4errdef, TRUE);
return status;
}
/* Do the right thing for each set */
switch (code)
{
case G4STmessages:
iiAG4showMessages = intin;
break;
}
return status;
}
/*{
** Name: IIAG4i4Inq4GL - EXEC 4GL INQUIRE_4GL
**
** Description:
** Return data for the various possible inquiries. Note that some
** parameters are unused for some inquiries.
**
** Inputs:
** i4 isvar data passed by reference?
** type i4 ADF type of user's variable
** length i4 size of user's variable
** i4 object object to inquire about
** code i4 Which inquire to perform
**
** Outputs:
** ind i2 * User's null indicator
** data PTR User's data buffer
**
** Returns:
** STATUS
**
** History:
** 22-dec-92 (davel)
** Initial version, based on W4GL version developed by MikeS.
** 25-Aug-1993 (fredv)
** Included <st.h>.
*/
STATUS
IIAG4i4Inq4GL
(i2 *ind, i4 isvar, i4 type, i4 length, PTR data, i4 object, i4 code)
{
STATUS status;
G4ERRDEF g4errdef;
i4 access;
DB_DATA_VALUE dbv, odbv;
i4 intout;
i4 count, dcount;
AB_TYPENAME buf;
/* Check object, if it applies */
switch(code)
{
case G4IQallrows:
case G4IQlastrow:
case G4IQfirstrow:
access = G4OA_ARRAY;
break;
case G4IQisarray:
case G4IQclassname:
access = G4OA_OBJECT;
break;
default:
access = G4OA_INVALID;
}
if (access != G4OA_INVALID)
{
if ((status = IIAG4chkobj(object, access, 0, G4INQUIRE_ID)) != OK)
return status;
}
/* save the object in DBV form */
IIAG4dbvFromObject(iiAG4savedObject, &odbv);
/* Set up the output DBV. Almost everything is integer */
switch (code)
{
case G4IQclassname:
case G4IQerrtext:
dbv.db_datatype = DB_CHA_TYPE;
dbv.db_prec = 0;
break;
default:
dbv.db_datatype = DB_INT_TYPE;
dbv.db_prec = 0;
dbv.db_length = 4;
dbv.db_data = (PTR)&intout;
break;
}
/* Do the right thing for each inquiry */
switch (code)
{
case G4IQerrtext:
dbv.db_data = iiAG4errtext;
dbv.db_length = STlength(iiAG4errtext);
break;
case G4IQerrno:
intout = iiAG4errno & MSGMASK;
break;
case G4IQallrows:
(void) iiarArAllCount( &odbv, &count, &dcount );
intout = count + dcount;
break;
case G4IQlastrow:
(void) iiarArAllCount( &odbv, &count, &dcount );
intout = count;
break;
case G4IQfirstrow:
(void) iiarArAllCount( &odbv, &count, &dcount );
intout = 1 - dcount;
break;
case G4IQisarray:
intout = (iiarIarIsArray( &odbv ) ? 1 : 0);
break;
case G4IQclassname:
iiarCcnClassName( &odbv, buf, FALSE );
dbv.db_data = (PTR)buf;
dbv.db_length = STlength(buf);
break;
}
if ((status = IIAG4get_data(&dbv, ind, type, length, data)) != OK)
{
g4errdef.errmsg = status;
g4errdef.numargs = 3;
g4errdef.args[0] = iiAG4routineNames[G4INQUIRE_ID];
g4errdef.args[1] = iiAG4routineNames[G4INQUIRE_ID];
g4errdef.args[2] = iiAG4inqtypes[code];
IIAG4semSetErrMsg(&g4errdef, TRUE);
}
return status;
}
/*{
** Name: IIAG4aoAddObject - Add a known object
**
** Description:
** This adds another object to the list of objects known by 3GL.
** If we don't ahve room in the current allocated stack of known
** objects, then we allocate a new stack (twice the size of the old one),
** and copy the old stack over.
**
** 3GL uses the index into this stack as a handle for the object.
** A value of zero is the null object (although it's not clear that
** ABF/4GL ever uses this concept).
**
** Inputs:
** object PTR object to add
**
** Returns:
** i4 The index into the stack of known objects. This is
** used as an object handle by 3GL.
**
** History:
** 15-dec-92 (davel)
** Initial version, based on W4GL version developed by MikeS.
*/
STATUS
IIAG4aoAddObject(PTR object, i4 *objno)
{
G4ERRDEF g4errdef;
i4 i;
/* even though ABF doesn't use the concept of NULL objects, we leave this
** in for now...
*/
if (object == NULL)
{
*objno = 0;
return OK;
}
/* make sure we've initialized the stack */
if (alloc_stacksize == 0)
{
g4errdef.errmsg = E_G42726_NO_INIT;
g4errdef.numargs = 0;
IIAG4semSetErrMsg(&g4errdef, TRUE);
return E_G42726_NO_INIT;
}
/* don't look for this in our stack - always re-issue a new object
** handle for it.
*/
if (stackpointer >= alloc_stacksize)
{
u_i4 size = (u_i4) (alloc_stacksize * 2 * sizeof(PTR) );
PTR *newstack;
newstack = (PTR *)MEreqmem(0, size, TRUE, NULL);
if (newstack == (PTR *)NULL)
{
g4errdef.errmsg = E_G42727_MEM_ALLOC_FAIL;
g4errdef.numargs = 0;
IIAG4semSetErrMsg(&g4errdef, TRUE);
return E_G42727_MEM_ALLOC_FAIL;
}
else
{
/* copy the old stack over. Note: don't use MEcopy, as
** the stack size might be larger than 64K, the limit
** on MEcopy.
*/
for (i = 0; i < alloc_stacksize; i++)
{
newstack[i] = objectstack[i];
}
(void) MEfree(objectstack);
alloc_stacksize *= 2;
objectstack = newstack;
}
}
objectstack[stackpointer++] = object;
*objno = stackpointer;
/* XXX also increment the reference count for this saved object. We'll
** decrement when the object gets freed in IIAG4fosFreeObjectStack().
*/
return OK;
}
