370 lines
6.2 KiB
C
370 lines
6.2 KiB
C
|
/* Functions used by cgen output */
|
||
|
|
|
||
|
|
#include <stdio.h>
|
||
|
|
|
||
|
|
#include "PROTO.h"
|
||
|
|
#include "object.h"
|
||
|
|
#include "intobject.h"
|
||
|
|
#include "floatobject.h"
|
||
|
|
#include "stringobject.h"
|
||
|
|
#include "tupleobject.h"
|
||
|
|
#include "listobject.h"
|
||
|
|
#include "methodobject.h"
|
||
|
|
#include "moduleobject.h"
|
||
|
|
#include "modsupport.h"
|
||
|
|
#include "import.h"
|
||
|
|
#include "cgensupport.h"
|
||
|
|
#include "errors.h"
|
||
|
|
|
||
|
|
|
||
|
|
/* Functions to construct return values */
|
||
|
|
|
||
|
|
object *
|
||
|
|
mknewcharobject(c)
|
||
|
|
int c;
|
||
|
|
{
|
||
|
|
char ch[1];
|
||
|
|
ch[0] = c;
|
||
|
|
return newsizedstringobject(ch, 1);
|
||
|
|
}
|
||
|
|
|
||
|
|
/* Functions to extract arguments.
|
||
|
|
These needs to know the total number of arguments supplied,
|
||
|
|
since the argument list is a tuple only of there is more than
|
||
|
|
one argument. */
|
||
|
|
|
||
|
|
int
|
||
|
|
getiobjectarg(args, nargs, i, p_arg)
|
||
|
|
register object *args;
|
||
|
|
int nargs, i;
|
||
|
|
object **p_arg;
|
||
|
|
{
|
||
|
|
if (nargs != 1) {
|
||
|
|
if (args == NULL || !is_tupleobject(args) ||
|
||
|
|
nargs != gettuplesize(args) ||
|
||
|
|
i < 0 || i >= nargs) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
args = gettupleitem(args, i);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if (args == NULL) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
*p_arg = args;
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getilongarg(args, nargs, i, p_arg)
|
||
|
|
register object *args;
|
||
|
|
int nargs, i;
|
||
|
|
long *p_arg;
|
||
|
|
{
|
||
|
|
if (nargs != 1) {
|
||
|
|
if (args == NULL || !is_tupleobject(args) ||
|
||
|
|
nargs != gettuplesize(args) ||
|
||
|
|
i < 0 || i >= nargs) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
args = gettupleitem(args, i);
|
||
|
|
}
|
||
|
|
if (args == NULL || !is_intobject(args)) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
*p_arg = getintvalue(args);
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getishortarg(args, nargs, i, p_arg)
|
||
|
|
register object *args;
|
||
|
|
int nargs, i;
|
||
|
|
short *p_arg;
|
||
|
|
{
|
||
|
|
long x;
|
||
|
|
if (!getilongarg(args, nargs, i, &x))
|
||
|
|
return 0;
|
||
|
|
*p_arg = x;
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
static int
|
||
|
|
extractdouble(v, p_arg)
|
||
|
|
register object *v;
|
||
|
|
double *p_arg;
|
||
|
|
{
|
||
|
|
if (v == NULL) {
|
||
|
|
/* Fall through to error return at end of function */
|
||
|
|
}
|
||
|
|
else if (is_floatobject(v)) {
|
||
|
|
*p_arg = GETFLOATVALUE((floatobject *)v);
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else if (is_intobject(v)) {
|
||
|
|
*p_arg = GETINTVALUE((intobject *)v);
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
|
||
|
|
static int
|
||
|
|
extractfloat(v, p_arg)
|
||
|
|
register object *v;
|
||
|
|
float *p_arg;
|
||
|
|
{
|
||
|
|
if (v == NULL) {
|
||
|
|
/* Fall through to error return at end of function */
|
||
|
|
}
|
||
|
|
else if (is_floatobject(v)) {
|
||
|
|
*p_arg = GETFLOATVALUE((floatobject *)v);
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else if (is_intobject(v)) {
|
||
|
|
*p_arg = GETINTVALUE((intobject *)v);
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getifloatarg(args, nargs, i, p_arg)
|
||
|
|
register object *args;
|
||
|
|
int nargs, i;
|
||
|
|
float *p_arg;
|
||
|
|
{
|
||
|
|
object *v;
|
||
|
|
float x;
|
||
|
|
if (!getiobjectarg(args, nargs, i, &v))
|
||
|
|
return 0;
|
||
|
|
if (!extractfloat(v, &x))
|
||
|
|
return 0;
|
||
|
|
*p_arg = x;
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getistringarg(args, nargs, i, p_arg)
|
||
|
|
object *args;
|
||
|
|
int nargs, i;
|
||
|
|
string *p_arg;
|
||
|
|
{
|
||
|
|
object *v;
|
||
|
|
if (!getiobjectarg(args, nargs, i, &v))
|
||
|
|
return NULL;
|
||
|
|
if (!is_stringobject(v)) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
*p_arg = getstringvalue(v);
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getichararg(args, nargs, i, p_arg)
|
||
|
|
object *args;
|
||
|
|
int nargs, i;
|
||
|
|
char *p_arg;
|
||
|
|
{
|
||
|
|
string x;
|
||
|
|
if (!getistringarg(args, nargs, i, &x))
|
||
|
|
return 0;
|
||
|
|
if (x[0] == '\0' || x[1] != '\0') {
|
||
|
|
/* Not exactly one char */
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
*p_arg = x[0];
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getilongarraysize(args, nargs, i, p_arg)
|
||
|
|
object *args;
|
||
|
|
int nargs, i;
|
||
|
|
long *p_arg;
|
||
|
|
{
|
||
|
|
object *v;
|
||
|
|
if (!getiobjectarg(args, nargs, i, &v))
|
||
|
|
return 0;
|
||
|
|
if (is_tupleobject(v)) {
|
||
|
|
*p_arg = gettuplesize(v);
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
if (is_listobject(v)) {
|
||
|
|
*p_arg = getlistsize(v);
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getishortarraysize(args, nargs, i, p_arg)
|
||
|
|
object *args;
|
||
|
|
int nargs, i;
|
||
|
|
short *p_arg;
|
||
|
|
{
|
||
|
|
long x;
|
||
|
|
if (!getilongarraysize(args, nargs, i, &x))
|
||
|
|
return 0;
|
||
|
|
*p_arg = x;
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
/* XXX The following four are too similar. Should share more code. */
|
||
|
|
|
||
|
|
int
|
||
|
|
getilongarray(args, nargs, i, n, p_arg)
|
||
|
|
object *args;
|
||
|
|
int nargs, i;
|
||
|
|
int n;
|
||
|
|
long *p_arg; /* [n] */
|
||
|
|
{
|
||
|
|
object *v, *w;
|
||
|
|
if (!getiobjectarg(args, nargs, i, &v))
|
||
|
|
return 0;
|
||
|
|
if (is_tupleobject(v)) {
|
||
|
|
if (gettuplesize(v) != n) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
for (i = 0; i < n; i++) {
|
||
|
|
w = gettupleitem(v, i);
|
||
|
|
if (!is_intobject(w)) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
p_arg[i] = getintvalue(w);
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else if (is_listobject(v)) {
|
||
|
|
if (getlistsize(v) != n) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
for (i = 0; i < n; i++) {
|
||
|
|
w = getlistitem(v, i);
|
||
|
|
if (!is_intobject(w)) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
p_arg[i] = getintvalue(w);
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getishortarray(args, nargs, i, n, p_arg)
|
||
|
|
object *args;
|
||
|
|
int nargs, i;
|
||
|
|
int n;
|
||
|
|
short *p_arg; /* [n] */
|
||
|
|
{
|
||
|
|
object *v, *w;
|
||
|
|
if (!getiobjectarg(args, nargs, i, &v))
|
||
|
|
return 0;
|
||
|
|
if (is_tupleobject(v)) {
|
||
|
|
if (gettuplesize(v) != n) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
for (i = 0; i < n; i++) {
|
||
|
|
w = gettupleitem(v, i);
|
||
|
|
if (!is_intobject(w)) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
p_arg[i] = getintvalue(w);
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else if (is_listobject(v)) {
|
||
|
|
if (getlistsize(v) != n) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
for (i = 0; i < n; i++) {
|
||
|
|
w = getlistitem(v, i);
|
||
|
|
if (!is_intobject(w)) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
p_arg[i] = getintvalue(w);
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getidoublearray(args, nargs, i, n, p_arg)
|
||
|
|
object *args;
|
||
|
|
int nargs, i;
|
||
|
|
int n;
|
||
|
|
double *p_arg; /* [n] */
|
||
|
|
{
|
||
|
|
object *v, *w;
|
||
|
|
if (!getiobjectarg(args, nargs, i, &v))
|
||
|
|
return 0;
|
||
|
|
if (is_tupleobject(v)) {
|
||
|
|
if (gettuplesize(v) != n) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
for (i = 0; i < n; i++) {
|
||
|
|
w = gettupleitem(v, i);
|
||
|
|
if (!extractdouble(w, &p_arg[i]))
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else if (is_listobject(v)) {
|
||
|
|
if (getlistsize(v) != n) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
for (i = 0; i < n; i++) {
|
||
|
|
w = getlistitem(v, i);
|
||
|
|
if (!extractdouble(w, &p_arg[i]))
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
int
|
||
|
|
getifloatarray(args, nargs, i, n, p_arg)
|
||
|
|
object *args;
|
||
|
|
int nargs, i;
|
||
|
|
int n;
|
||
|
|
float *p_arg; /* [n] */
|
||
|
|
{
|
||
|
|
object *v, *w;
|
||
|
|
if (!getiobjectarg(args, nargs, i, &v))
|
||
|
|
return 0;
|
||
|
|
if (is_tupleobject(v)) {
|
||
|
|
if (gettuplesize(v) != n) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
for (i = 0; i < n; i++) {
|
||
|
|
w = gettupleitem(v, i);
|
||
|
|
if (!extractfloat(w, &p_arg[i]))
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else if (is_listobject(v)) {
|
||
|
|
if (getlistsize(v) != n) {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
for (i = 0; i < n; i++) {
|
||
|
|
w = getlistitem(v, i);
|
||
|
|
if (!extractfloat(w, &p_arg[i]))
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
return err_badarg();
|
||
|
|
}
|
||
|
|
}
|