Beispiel #1
0
void dbl_display(variable* ch, int count, ...)
{
	Channel* canal=findchannel(decimal2integer(ch));
	va_list arg;
	int i;
	variable* field;
	FILE* fh;

	if (canal->terminal==1)
		fh=stdout;
	else
		fh=canal->fh;

	va_start(arg,count);

	for (i = 0; i < count; i++) {
		field=va_arg(arg,variable*);
		if (gettype(field)<=tALPHA)
			fwrite(getdata(field),getsize(field),1,fh);
		if (gettype(field)==tDECIMAL) {
			int64 code;
			code=decimal2integer(field);
			code%=256;
			fprintf(fh,"%c",code);
		}
	}

	fflush(fh);

	va_end(arg);
}
Beispiel #2
0
/*FUNCTION*/
int c_equal(tpLspObject pLSP,
            LVAL p,
            LVAL q
  ){
/*noverbatim
CUT*/
  if( p == q ) return 1;
  if( gettype(p) != gettype(q) )return 0;
  switch( gettype(p) ){
    case NTYPE_CON:
      return equal(car(p),car(q)) && equal(cdr(p),cdr(q));
    case NTYPE_FLO:
      return getfloat(p)==getfloat(q);
    case NTYPE_INT:
      return getint(p)==getint(q);
    case NTYPE_STR:
      return  getstring(p) == getstring(q) ||
                       !strcmp(getstring(p),getstring(q));
    case NTYPE_SYM:
      return getsymbol(p) == getsymbol(q) ||
                 !strcmp(getsymbol(p),getsymbol(q));
    case NTYPE_CHR:
      return getchr(p) == getchr(q);
    default:
      return 0;
      break;
    }
  }
Beispiel #3
0
/*
	clear a variable
	3-17
*/
void dbl_clear(variable* field)
{
	if (gettype(field)<=tALPHA)
		memset(getdata(field),' ',getsize(field));
	if (gettype(field)==tDECIMAL)
		memset(getdata(field),'0',getsize(field));
}
Beispiel #4
0
void tojson(BYTE* buffer, int level, int isarray)
{  
    int i = 0;    
    printf ((isarray) ? "[" : "{");
    if (*buffer)
    {
        do 
        {
            if (i>0)
                printf(",");
            printf ("\n");            
            addtabs(level); 
            if (!isarray)
            {                                
                printf("\"%s\": ", getkey(buffer));
            }                    
            switch (gettype(buffer))
            {
                case BT_INT32BIT:
                    printf("%d", asint(getvalue(buffer)));
                    break;
                case BT_FLOP64BIT:
                    printf("%lf", asdouble(getvalue(buffer)));
                    break;
                case BT_BOOLFALSETRUE:
                    printf("%s", (asboolean(getvalue(buffer)) ? "true" : "false"));
                    break;
                case BT_UTF8STRING:
                    printf("\"%s\"", asstring(getvalue(buffer)));
                    break;
                case BT_EMBEDEDDOC:
                    tojson(opendoc(getvalue(buffer), 0), level + 1, 0);                                
                    break;
                case BT_ARRAY:                 
                    tojson(opendoc(getvalue(buffer), 0), level + 1, 1);                
                    break;
                default:
                    printf(" \"(0x%X) __NOTIMPLEMENTED__\"", gettype(buffer));
            }
            
            i++;
            //getchar();
        } while (*(buffer = nextitem(buffer)));           
        printf ("\n"); 
        addtabs(level - 1);
    }
       
    printf ((isarray) ? "]" : "}");
    if (errorno)
        printf ("ERROR #%d\n", errorno);    
}
Beispiel #5
0
static void
printdata(size_t level, const void *v, size_t x, size_t l)
{
	const uint8_t *p = v, *ep = p + l;
	size_t ox;
	char buf[128];

	while (p + x < ep) {
		const uint8_t *q;
		uint8_t c = getclass(p[x]);
		uint8_t t = gettype(p[x]);
		ox = x;
		if (x != 0)
		printf("%.2x %.2x %.2x\n", p[x - 1], p[x], p[x + 1]);
		uint32_t tag = gettag(p, &x, ep - p + x);
		if (p + x >= ep)
			break;
		uint32_t len = getlength(p, &x, ep - p + x);
		
		printf("%zu %zu-%zu %c,%c,%s,%u:", level, ox, x,
		    der_class[c], der_type[t],
		    der_tag(buf, sizeof(buf), tag), len);
		q = p + x;
		if (p + len > ep)
			errx(EXIT_FAILURE, "corrupt der");
		printtag(tag, q, len);
		if (t != DER_TYPE_PRIMITIVE)
			printdata(level + 1, p, x, len + x);
		x += len;
	}
}
Beispiel #6
0
Value *apply(Value *proc, Value *args)
{
    switch (gettype(proc)) {
    case T_NATIVE:
        return proc->fn(args);
    case T_LAMBDA:
        {
            Value *call_env = proc->lambda.env;
            Value *formal = proc->lambda.args;
            Value *actual = args;
            while (!LISP_NILP(formal) && !LISP_NILP(actual)) {
                call_env = bind(CAR(formal), CAR(actual), call_env);
                formal = CDR(formal);
                actual = CDR(actual);
            }

            // Argument count mismatch?
            if (formal != actual) {
                error("Argument count mismatch.\n");
                exit(1);
            }

            return eval(proc->lambda.body, call_env);
        } break;
    default:
        error("Type is not callable.");
        exit(1);
    }
}
Beispiel #7
0
Value *eval(Value *form, Value *env)
{
    switch (gettype(form)) {
    case T_INT: return form;
    case T_SYM:
        {
            Value *value = lookup(form, env);
            if (value == NULL) {
                error("Undefined symbol.");
                exit(1);
            }
            return value;
        } break;
    case T_PAIR:
        {
            Value *verb = CAR(form);

            if (verb == quote_sym) {
                return CADR(form);
            } else if (verb == lambda_sym) {
                return eval_lambda(form, env);
            } else if (verb == if_sym) {
                return eval_if(form, env);
            } else if (verb == define_sym) {
                return eval_define(form, env);
            } else {
                return apply(eval(verb, env), mapeval(CDR(form), env));
            }
        } break;
    default:
        error("I don't know how to evaluate that.");
        break;
    }
}
Beispiel #8
0
void Z3BitVector::dump_variables(FILE* file){

	assert(free_variables.size() && "Empty free_variables");

	//printf("\e[31m Dump_variables free_variables.size() %lu\e[0m\n", free_variables.size() );


	for( set<NameAndPosition>::iterator it = free_variables.begin(); it != free_variables.end(); it++ ){

		string position = it->position;
		string type = gettype(it->name);
		int bits;

		//printf("dump_variables_type %s\n", type.c_str());

		if(type == "IntegerTyID32")
			bits = 32;
		else if(type == "IntegerTyID16")
			bits = 16;
		else if(type == "IntegerTyID8")
			bits = 8;
		else
			assert(0 && "Unknown Type");

		//dump_variable(position, type, file);
		fprintf(file,"(declare-const %s (_ BitVec %d))\n", position.c_str(), bits);

		
	}
	

}
Beispiel #9
0
/* Called when dhcp flag is toggled.  Toggle disabled state of other 3
 * controls. */
void networkdialogcallbacktype(newtComponent cm, void *data)
{
	char type[STRING_SIZE];
	
	gettype(type);

	if (strcmp(type, "STATIC") != 0)
	{
		newtEntrySetFlags(addressentry, NEWT_FLAG_DISABLED, NEWT_FLAGS_SET);
		newtEntrySetFlags(netmaskentry, NEWT_FLAG_DISABLED, NEWT_FLAGS_SET);
	}
	else
	{
		newtEntrySetFlags(addressentry, NEWT_FLAG_DISABLED, NEWT_FLAGS_RESET);
		newtEntrySetFlags(netmaskentry, NEWT_FLAG_DISABLED, NEWT_FLAGS_RESET);
	}
	if (strcmp(type, "DHCP") == 0)
	{
		newtEntrySetFlags(dhcphostnameentry, NEWT_FLAG_DISABLED, NEWT_FLAGS_RESET);
		newtEntrySetFlags(dhcpforcemtuentry, NEWT_FLAG_DISABLED, NEWT_FLAGS_RESET);
	}
	else
	{
		newtEntrySetFlags(dhcphostnameentry, NEWT_FLAG_DISABLED, NEWT_FLAGS_SET);		
		newtEntrySetFlags(dhcpforcemtuentry, NEWT_FLAG_DISABLED, NEWT_FLAGS_SET);		
	}
	newtRefresh();
	newtDrawForm(networkform);
}
Beispiel #10
0
T apply(T fn, T args) {
	T callingenv, formal, actual;

	switch (gettype(fn)) {
	case T_NATIVE:
		return fn->fn(args);
	case T_LAMBDA:
		callingenv = fn->lambda.env;
		formal = fn->lambda.args;
		actual = args;
		
		for (;!NILP(formal) && !NILP(actual); formal=CDR(formal), actual=CDR(actual)) {
			callingenv = bind(CAR(formal), CAR(actual), callingenv);
		}

		if (formal != actual) {
			error("Wrong number of arguments");
			exit(1);
		}

		return eval(fn->lambda.body, callingenv);
	default:
		error("Can't apply to this type");
		exit(1);
	}
}
Beispiel #11
0
char* lookup(ast* n)
{
	char* ret = gettype(n->info.variable);
	if (strcmp(ret, "UNDEFINED") == 0)
		error("Undefined identifier", n);
	return ret;
}
Beispiel #12
0
/*FUNCTION*/
int c_flatc(tpLspObject pLSP,
            LVAL p
  ){
/*noverbatim
CUT*/
  int j;
  LVAL fp;

  if( null(p) )return 3;
  switch( gettype(p) ){
    case NTYPE_CON:
      for( fp = p , j = 1/*(*/ ; fp ; fp = cdr(fp) )
      j+= flatc(car(fp))+1/*space*/;
      return p ? j : 1+j; /*) was calculated as a space. (Not always.) */
    case NTYPE_FLO:
      sprintf(BUFFER,"%lf",getfloat(p));
      break;
    case NTYPE_INT:
      sprintf(BUFFER,"%ld",getint(p));
      break;
    case NTYPE_STR:
      sprintf(BUFFER,"\"%s\"",getstring(p));
      break;
    case NTYPE_SYM:
      sprintf(BUFFER,"%s",getsymbol(p));
      break;
    case NTYPE_CHR:
      sprintf(BUFFER,"#\\%c",getchr(p));
      break;
    default:
      return 0;
      }
  return strlen(BUFFER);
  }
Beispiel #13
0
const char* toluaI_tt_getobjtype (lua_State* L, int lo)
{
 if (lua_gettop(L)<abs(lo))
  return "[no object]";
 else
  return gettype(L,lua_tag(L,lo));
}
Beispiel #14
0
static int process(struct nftw *state, struct dirent64 *dp)
{
char			*grow;
struct stat64	st;
int				type;

	if ((dp->d_namelen == 1 && dp->d_name[0] == '.') || (dp->d_namelen == 2 && dp->d_name[0] == '.' && dp->d_name[1] == '.'))
		return(0);
	if (state->stem + 1 + dp->d_namelen + 1 > state->size) {
		if ((grow = realloc(state->pathname, state->size + PATH_MAX)) == NULL)
			return(state->error = ENAMETOOLONG, -1);
		state->pathname = grow, state->size += PATH_MAX;
	}
	sprintf(&state->pathname[state->stem - 1], "/%.*s", dp->d_namelen, dp->d_name);
	if ((type = gettype(state, dp, &st)) == -1)
		return(state->error = errno, -1);
	if (type != FTW_NS && (state->flags & FTW_MOUNT) && st.st_dev != state->fsys)
		return(0);
	if (type != FTW_D)
		return((*state->invoke)(state, &st, type));
	if (!unique(state, st.st_dev, st.st_ino))
		return(0);
#ifdef FTW_CHECK_STACK
	if (__stackavail() < FTW_STACK_REQUIREMENTS())
		return(state->error = ENOMEM, -1);
#endif
	if (!visit(state, st.st_dev, st.st_ino))
		return(state->error = ENOMEM, -1);
	return(directory(state, &st));
}
/* access == 0 load; access == 1 store. */
void accessreg(context* ctx, assembly* casm, int access, qoperand* q,
			   int reg, int local, int temp)
{
	operand o = {0}, o1 = {0}, o2 = {0};
	if (!q) return;
	switch (q->scope)
	{
	case SGLOBAL:
		o.ival = rd;	o1.ival = q->entity.entity.offset;	o2.ival = reg;
		access==0?emit(ctx,casm,opLD,&o,&o1,&o2):emit(ctx,casm,opST,&o,&o1,&o2);
		break;
	case SLOCAL:
		o.ival = rf;	o1.ival = q->entity.entity.offset+1;	o2.ival = reg;
		access==0?emit(ctx,casm,opLD,&o,&o1,&o2):emit(ctx,casm,opST,&o,&o1,&o2);
		break;
	case SPARAMETER:	/* add the pass-by-address option here */
		o.ival = rf;	o1.ival = -q->entity.entity.offset-2;	o2.ival = reg;
		access==0?emit(ctx,casm,opLD,&o,&o1,&o2):emit(ctx,casm,opST,&o,&o1,&o2);
		break;
	case STEMP:
		o.ival = rf;	o1.ival = local+temp-q->entity.entity.offset;
		o2.ival = reg;
		access==0?emit(ctx,casm,opLD,&o,&o1,&o2):emit(ctx,casm,opST,&o,&o1,&o2);
		break;
	case SCONSTANT:
		switch (gettype(q))
		{
		case TINTEGER:
			o.ival = q->entity.entity.ival;		o1.ival = reg;
			emit(ctx, casm, opLCI, &o, NULL, &o1);
			break;
		case TFLOAT:
			o.fval = q->entity.entity.fval;		o1.ival = reg;
			emit(ctx, casm, opLCF, &o, NULL, &o1);
			break;
		case TSTRING:
			o.ival = q->entity.entity.ival;		o1.ival = reg;
			emit(ctx, casm, opNewstring, &o,0,&o1);
			break;
		case TNIL:
			o1.ival = reg;
			emit(ctx, casm, opLNIL, 0, 0, &o1);
			break;
		case THFUNCTION:
			o.ival = q->entity.entity.ival;		o1.ival = reg;
			emit(ctx, casm, opLHF, &o, 0, &o1);
			break;
		}
		break;
	case SFUNCTION:
		o.ival = q->entity.entity.ival;		o1.ival = reg;
		emit(ctx, casm, opLFUNC, &o, NULL, &o1);
		break;
	case SHFUNCTION:
		o.ival = q->entity.entity.ival;		o1.ival = reg;
		emit(ctx, casm, opLHF, &o, NULL, &o1);
		break;
	}
}
Beispiel #16
0
Variable&
Variable::operator+=(Variable& rhs)
{
	if ( (gettype()==tDECIMAL) && (rhs.gettype()==tDECIMAL)) {
		// Add two decimal variables
		int64 calcul;
		calcul=(int64)(*this)+(int64)rhs;
		this->fromint(calcul);
	} else
	if ((gettype()<=tALPHA) && (rhs.gettype()<=tALPHA)) {
		// Concat two alpha or record
		// TODO
	} else
		error(20);

	return (*this);
}
int main(int argc, char* argv[])
{
	int N, type, precedence;
	char line[3], next, symbol;
	std::stack<char> stk;
	std::vector<char> postfix;
	openFile();
	scanf("%d\n\n", &N);
	while (N--)
	{
		while(fgets(line, 3, stdin) && line[0] != '\n')
		{
			symbol = line[0];
			type = gettype(symbol);
			switch(type)
			{
			case LEFT_PARANTHESIS:
				stk.push(symbol);
				break;
			case RIGHT_PARANTHESIS:
				while((next = stk.top()) != '(')
				{
					stk.pop();
					postfix.push_back(next);
				}
				stk.pop();
				break;
			case OPERAND:
				postfix.push_back(symbol);
				break;
			case OPERATOR:
				precedence = getprecedence(symbol);
				while(stk.size() && precedence <= getprecedence(stk.top()))
				{
					postfix.push_back(stk.top());
					stk.pop();
				}
				stk.push(symbol);

			}	
		}

		while(stk.size())
		{
			postfix.push_back(stk.top());
			stk.pop();
		}
		for(std::vector<char>::size_type i = 0; i < postfix.size(); ++i)
			printf("%c", postfix[i]);
		printf("\n");
		postfix.clear();

		if (N > 0)
			printf("\n");
	}
	return 0;
}
Beispiel #18
0
element lookuppath(value buffer, char* path)
{ 
  /* returns pointer to the beginning of the field the path points to */
  /* buffer points to a doc/array value */

  while (*path)
  {
    char* next = path;
    while (*next && *next!='/')
      next++;
    buffer = lookup (buffer, path, (int)(next - path));    
    
    // lookup unsuccessful
    if (!buffer)
      return 0;
    
    // end of path string reached
    if (!*next)
      return buffer;

    #ifdef DEBUG
    printf("type=0X%x", gettype(buffer));
    #endif
    
    // point to the content of the array or embedded doc
    if (gettype(buffer) == BT_ARRAY || gettype(buffer) == BT_EMBEDEDDOC)
      buffer = opendoc(getvalue(buffer), 0); 
    
    #ifdef DEBUG
    printf ("B=%s\r\n", next);
    #endif      

    #ifdef DEBUG
    printf ("%s\r\n", next);
    getchar();
    #endif    

    next++;
    path = next;    
  }
  return 0;
}
Beispiel #19
0
int tolua_istype (lua_State* L, int narg, int tag, int def)
{
 if (lua_gettop(L)<abs(narg))
 {
  if (def==0)
  {
   toluaI_eh_set(L,narg,toluaI_tt_getobjtype(L,narg),gettype(L,tag));
   return 0;
  }
 }
 else
 {
  if (!istype(L,narg,tag))
  {
   toluaI_eh_set(L,narg,toluaI_tt_getobjtype(L,narg),gettype(L,tag));
   return 0;
  }
 }
 return 1;
}
Beispiel #20
0
bool
Variable::operator==(Variable& rhs)
{
	/* decimal comparaison */
	if ((gettype()==tDECIMAL) && (rhs.gettype()==tDECIMAL)) {
		if ((int64)(*this)==(int64)(rhs))
			return true;
		else
			return false;
	}

	/* alpha comparaison */
	if ((gettype()<=tALPHA) && (rhs.gettype()<=tALPHA)) {
		if (memcmp(getdata(),rhs.getdata(),getsize() < rhs.getsize() ? getsize() : rhs.getsize())==0)
			return false;
		else
			return true;
	}
	return false;
}
Beispiel #21
0
/* returns value of a keyvalue pair */
value getvalue(element buffer)
{ 
  if (gettype(buffer) == 0)
  {
    errorno = ERR_INVALIDBUFFER;
    return NULL;
  }
  buffer++;
  while (*(buffer++));
  return buffer;
}
Beispiel #22
0
int AsnTypeDesc::TclGetDesc (Tcl_DString *desc) const
{
  Tcl_DStringStartSublist (desc);
  Tcl_DStringAppendElement (desc, getmodule() ? (char*) getmodule()->name : "");
  Tcl_DStringAppendElement (desc, getname() ? (char*) getname() : "");
  Tcl_DStringEndSublist (desc);
  Tcl_DStringAppendElement (desc, ispdu() ? "pdu" : "sub");
  Tcl_DStringAppendElement (desc, (char*) typenames[gettype()]);

  return TCL_OK;
}
Beispiel #23
0
Value *lookup(Value *name, Value *env)
{
    assert(gettype(name) == T_SYM);
    for (; !LISP_NILP(env); env = CDR(env)) {
        // Pointer comparison is OK for interned symbols.
        Value *binding = CAR(env);
        if (CAR(binding) == name)
            return CDR(binding);
    }
    return NULL;
}
Beispiel #24
0
/* xsendmsg - send a message to an object */
LOCAL LVAL xsendmsg(LVAL obj, LVAL cls, LVAL sym)
{
    LVAL msg=NULL,msgcls,method,val,p;

    /* look for the message in the class or superclasses */
    for (msgcls = cls; msgcls; ) {

        /* lookup the message in this class */
        for (p = getivar(msgcls,MESSAGES); p; p = cdr(p))
            if ((msg = car(p)) && car(msg) == sym)
                goto send_message;

        /* look in class's superclass */
        msgcls = getivar(msgcls,SUPERCLASS);
    }

    /* message not found */
    xlerror("no method for this message",sym);

send_message:

    /* insert the value for 'self' (overwrites message selector) */
    *--xlargv = obj;
    ++xlargc;
    
    /* invoke the method */
    if ((method = cdr(msg)) == NULL)
        xlerror("bad method",method);
    switch (ntype(method)) {
    case SUBR:
        val = (*getsubr(method))();
        break;
    case CLOSURE:
        if (gettype(method) != s_lambda)
            xlerror("bad method",method);
        val = evmethod(obj,msgcls,method);
        break;
    default:
        xlerror("bad method",method);
    }

    /* after creating an object, send it the ":isnew" message */
    if (car(msg) == k_new && val) {
        xlprot1(val);
        xsendmsg(val,getclass(val),k_isnew);
        xlpop();
    }
    
    /* return the result value */
    return (val);
}
Beispiel #25
0
Datei: dump.c Projekt: 8l/mc
/* Outputs a symbol table, and it's sub-tables
 * recursively, with a sigil describing the symbol
 * type, as follows:
 *      T       type
 *      S       symbol
 *      N       namespace
 *
 * Does not print captured variables.
 */
static void outstab(Stab *st, FILE *fd, int depth)
{
	size_t i, n;
	char *name;
	void **k;
	char *ty;
	Type *t;

	name = "";
	if (st->name)
		name = st->name;
	findentf(fd, depth, "Stab %p (super = %p, name=\"%s\")\n", st, st->super, name);
	if (!st)
		return;

	/* print types */
	k = htkeys(st->ty, &n);
	for (i = 0; i < n; i++) {
		findentf(fd, depth + 1, "T ");
		/* already indented */
		outname(k[i], fd);
		t = gettype(st, k[i]);
		if (t->nsub)
			ty = tystr(t->sub[0]);
		else
			ty = strdup("none");
		fprintf(fd, " = %s [tid=%d]\n", ty, t->tid);
		free(ty);
	}
	free(k);

	/* dump declarations */
	k = htkeys(st->dcl, &n);
	for (i = 0; i < n; i++) {
		findentf(fd, depth + 1, "S ");
		/* already indented */
		outsym(getdcl(st, k[i]), fd, 0);
	}
	free(k);

	/* dump closure */
	if (st->env) {
		k = htkeys(st->env, &n);
		for (i = 0; i < n; i++) {
			findentf(fd, depth + 1, "U ");
			/* already indented */
			outsym(getclosed(st, k[i]), fd, 0);
		}
		free(k);
	}
}
Beispiel #26
0
zysid()

{
	register char *cp;

	SET_XR( pID1 );
	gettype( pID2BLK, ID2BLK_LENGTH );
	cp = pID2BLK->str + pID2BLK->len;
	*cp++ = ' ';
	*cp++ = ' ';
	pID2BLK->len += 2 + storedate(cp, ID2BLK_LENGTH - pID2BLK->len);
	SET_XL( pID2BLK );
	return NORMAL_RETURN;
}
Beispiel #27
0
void lwrite(Value *ptr)
{
    if (ptr == LISP_NIL) {
        printf("NIL");
        return;
    }

    switch (gettype(ptr)) {
    case T_INT: lwriteint(ptr); break;
    case T_SYM: lwritesym(ptr); break;
    case T_NATIVE: lwritenative(ptr); break;
    case T_LAMBDA: lwritelambda(ptr); break;
    case T_PAIR: lwritepair(ptr); break;
    }
}
Beispiel #28
0
/* macroexpand - expand a macro call */
int macroexpand(LVAL fun, LVAL args, LVAL *pval)
{
    LVAL *argv;
    int argc;
    
    /* make sure it's really a macro call */
    if (!closurep(fun) || gettype(fun) != s_macro)
        return (FALSE);
        
    /* call the expansion function */
    argc = pushargs(fun,args);
    argv = xlfp + 3;
    *pval = evfun(fun,argc,argv);
    xlsp = xlfp;
    xlfp = xlfp - (int)getfixnum(*xlfp);
    return (TRUE);
}
Beispiel #29
0
/* Outputs a symbol table, and it's sub-tables
 * recursively, with a sigil describing the symbol
 * type, as follows:
 *      T       type
 *      S       symbol
 *      N       namespace
 *
 * Does not print captured variables.
 */
static void outstab(Stab *st, FILE *fd, int depth)
{
    size_t i, n;
    void **k;
    char *ty;
    Type *t;

    indent(fd, depth);
    fprintf(fd, "Stab %p (super = %p, name=\"%s\")\n", st, st->super, namestr(st->name));
    if (!st)
        return;

    /* print types */
    k = htkeys(st->ty, &n);
    for (i = 0; i < n; i++) {
        indent(fd, depth + 1);
        fprintf(fd, "T ");
        /* already indented */
        outname(k[i], fd); 
        t = gettype(st, k[i]);
        ty = tystr(t);
        fprintf(fd, " = %s [tid=%d]\n", ty, t->tid);
        free(ty);
    }
    free(k);

    /* dump declarations */
    k = htkeys(st->dcl, &n);
    for (i = 0; i < n; i++) {
        indent(fd, depth + 1);
        fprintf(fd, "S ");
        /* already indented */
        outsym(getdcl(st, k[i]), fd, 0);
    }
    free(k);

    /* dump sub-namespaces */
    k = htkeys(st->ns, &n);
    for (i = 0; i < n; i++) {
        indent(fd, depth + 1);
        fprintf(fd, "N  %s\n", (char*)k[i]);
        outstab(getns_str(st, k[i]), fd, depth + 1);
    }
    free(k);
}
Beispiel #30
0
void lwritepair(Value *pair)
{
    printf("(");
    for (; !LISP_NILP(pair); pair = CDR(pair)) {
        lwrite(CAR(pair));
        if (!LISP_NILP(CDR(pair))) {
            if (gettype(CDR(pair)) == T_PAIR) {
                printf(" ");
            } else {
                // Handle improper lists
                printf(" . ");
                lwrite(CDR(pair));
                break;
            }
        }
    }
    printf(")");
}