int prn_func_macr(Obj a, Obj stream, char* which){
Obj env = CADR(a);
Obj args = CADDR(a);
Obj body = CDDDR(a);
writestr(stream, "(");
writestr(stream, which);
writestr(stream, " ");
prnobj( args, stream, 1);
writestr(stream, " ");
a = body;
while( NNULLP( a )){
if( NCONSP( a )){
writestr(stream, " . ");
prnobj(a, stream, 1);
break;
}
writestr(stream, " ");
prnobj( CAR(a), stream, 1);
a = CDR( a );
}
writestr(stream, ")");
return 1;
}
LISP lgdPointx(LISP ptr,LISP j,LISP value)
{ long n,i;
gdPointPtr pt;
pt = get_gdPointPtr(ptr,&n);
i = get_c_long(j);
if ((i < 0) || (i >= n)) err("index out of range",j);
if NNULLP(value)
pt[i].x = get_c_long(value);
else
int prnfunc(Obj a, Obj stream, int how){
char n;
if( NNULLP( CADR(a))){
if( how) return prn_func_macr(a, stream, "closure");
else writestr(stream, "#<closure>");
}else{
if( how) return prn_func_macr(a, stream, "lambda");
else writestr(stream, "#<lambda>");
}
return 1;
}
LISP lexec(LISP path,LISP args,LISP env)
{int iflag;
char **argv = NULL, **envp = NULL;
LISP gcsafe=NIL;
iflag = no_interrupt(1);
argv = list2char(&gcsafe,args);
if NNULLP(env)
envp = list2char(&gcsafe,env);
if (envp)
execve(get_c_string(path),argv,envp);
else
execv(get_c_string(path),argv);
no_interrupt(iflag);
return(err("exec",llast_c_errmsg(-1)));}
int prncons(Obj a, Obj stream, int how){
writestr(stream, "(");
prnobj(CAR(a), stream, how);
a = CDR(a);
while( NNULLP( a )){
if( NCONSP( a )){
writestr(stream, " . ");
prnobj(a, stream, how);
break;
}
writestr(stream, " ");
prnobj( CAR(a), stream, how );
a = CDR( a );
}
writestr(stream, ")");
return 1;
}
int assemble_options(LISP l, ...)
{int result = 0,val,noptions,nmask = 0;
LISP lsym,lp = NIL;
char *sym;
va_list syms;
if NULLP(l) return(0);
noptions = CONSP(l) ? get_c_long(llength(l)) : -1;
va_start(syms,l);
while((sym = va_arg(syms,char *)))
{val = va_arg(syms,int);
lsym = cintern(sym);
if (EQ(l,lsym) || (CONSP(l) && NNULLP(lp = memq(lsym,l))))
{result |= val;
if (noptions > 0)
nmask = nmask | (1 << (noptions - get_c_long(llength(lp))));
else
noptions = -2;}}
va_end(syms);
if ((noptions == -1) ||
((noptions > 0) && (nmask != ((1 << noptions) - 1))))
err("contains undefined options",l);
return(result);}
/*
stdio.h
printf
*/
void err(char *message,LISP x)
{
nointerrupt = 1;
if NNULLP(x)
printf("ERROR: %s (see errobj)\n",message);
else printf("ERROR: %s\n",message);
LISP lrandom(LISP n)
{int res;
res = rand();
return(flocons(NNULLP(n) ? res % get_c_long(n) : res));}
