uintptr_t *
apdns_getFQDN_MX (Region rAddrLPairs, Region rAddrEPairs, Region rAddrString,
String str, request_data *rd)
{
uintptr_t *list;
makeNIL (list);
return apdns_getFQDN_MX_1 (rAddrLPairs, rAddrEPairs, rAddrString,
&(str->data), list, 3, rd);
}
//-----------------------------
void initcell(void){
int addr,addr1;
for(addr=0; addr <= HEAPSIZE; addr++){
heap[addr].flag = FRE;
heap[addr].cdr = addr+1;
}
H = 0;
F = HEAPSIZE;
//0番地はnil、環境レジスタを設定する。初期環境
E = makeNIL();
assocsym(makeNIL(),makeNIL());
assocsym(makeT(),makeT());
S = 0;
A = 0;
}
int read(void){
gettoken();
switch(stok.type){
case NUMBER: return(makenum(atoi(stok.buf)));
case SYMBOL: return(makesym(stok.buf));
case QUOTE: return(cons(makesym("quote"), cons(read(),makeNIL())));
case LPAREN: return(readlist());
}
error(CANT_READ_ERR,"read",NIL);
}
int f_oblist(int arglist){
int addr,addr1,res;
checkarg(LEN0_TEST, "oblist", arglist);
res = makeNIL();
addr = E;
while(!(nullp(addr))){
addr1 = caar(addr);
res = cons(addr1,res);
addr = cdr(addr);
}
return(res);
}
int f_eqgreater(int arglist){
int num1,num2;
checkarg(LEN2_TEST, ">=", arglist);
checkarg(NUMLIST_TEST, ">=", arglist);
num1 = GET_NUMBER(car(arglist));
num2 = GET_NUMBER(cadr(arglist));
if(num1 >= num2)
return(makeT());
else
return(makeNIL());
}
int f_smaller(int arglist){
int num1,num2;
checkarg(LEN2_TEST, "<", arglist);
checkarg(NUMLIST_TEST, "<", arglist);
num1 = GET_NUMBER(car(arglist));
num2 = GET_NUMBER(cadr(arglist));
if(num1 < num2)
return(makeT());
else
return(makeNIL());
}
uintptr_t *
REG_POLY_FUN_HDR(sml_environ, Region rl, Region rs)
{
char **m;
uintptr_t *pair, *list;
makeNIL(list);
m = environ;
while (*m)
{
allocPairML(rl, pair);
first(pair) = (uintptr_t) REG_POLY_CALL(convertStringToML, rs, *m);
second(pair) = (uintptr_t) list;
makeCONS(pair,list);
}
return list;
}
uintptr_t
REG_POLY_FUN_HDR(sml_uname, Region rl, Region rp, Region s1, Region s2)
{
struct utsname i;
uintptr_t *list;
int j;
makeNIL(list);
j = uname(&i);
if (j == -1) return (uintptr_t)list;
list = REG_POLY_CALL(cons_pair_of_strings, rl, rp, s1, s2, "sysname", i.sysname, list);
list = REG_POLY_CALL(cons_pair_of_strings, rl, rp, s1, s2, "nodename", i.nodename, list);
list = REG_POLY_CALL(cons_pair_of_strings, rl, rp, s1, s2, "release", i.release, list);
list = REG_POLY_CALL(cons_pair_of_strings, rl, rp, s1, s2, "version", i.version, list);
list = REG_POLY_CALL(cons_pair_of_strings, rl, rp, s1, s2, "machine", i.machine, list);
return (uintptr_t)list;
}
int f_cond(int arglist){
int arg1,arg2,arg3;
if(nullp(arglist))
return(makeNIL());
arg1 = car(arglist);
checkarg(LIST_TEST, "cond", arg1);
arg2 = car(arg1);
arg3 = cdr(arg1);
if(! (nullp(eval(arg2))))
return(f_begin(arg3));
else
return(f_cond(cdr(arglist)));
}
uintptr_t
REG_POLY_FUN_HDR(sml_getgrnam, uintptr_t triple, Region memberListR, Region memberR, String nameML, size_t s, uintptr_t exn)
{
uintptr_t res;
uintptr_t *list, *pair;
char *b;
struct group gbuf, *gbuf2;
char **members;
char *name = &(nameML->data);
mkTagTripleML(triple);
s = convertIntToC(s) + 1;
b = (char *) malloc(s);
if (!b)
{
res = errno;
third(triple) = res;
return triple;
}
res = getgrnam_r(name, &gbuf, b, s-1, &gbuf2);
third(triple) = res;
if (res)
{
free(b);
return triple;
}
if (!gbuf2)
{
free(b);
raise_exn(exn);
}
first(triple) = convertIntToML(gbuf2->gr_gid);
members = gbuf2->gr_mem;
makeNIL(list);
while (*members)
{
allocPairML(memberListR, pair);
first(pair) = (uintptr_t) REG_POLY_CALL(convertStringToML, memberR, *members);
second(pair) = (uintptr_t) list;
makeCONS(pair, list);
members++;
}
free(b);
second(triple) = (uintptr_t) list;
return triple;
}
int readlist(void){
int car,cdr;
gettoken();
if(stok.type == RPAREN)
return(makeNIL());
else
if(stok.type == DOT){
cdr = read();
if(atomp(cdr))
gettoken();
return(cdr);
}
else{
stok.flag = BACK;
car = read();
cdr = readlist();
return(cons(car,cdr));
}
}
uintptr_t
REG_POLY_FUN_HDR(sml_getgroups, uintptr_t rp, Region rs, uintptr_t exn)
{
uintptr_t *pair, *list;
gid_t *tmp;
size_t r, i;
makeNIL(list);
mkTagPairML(rp);
r = getgroups(0, NULL);
if (r == -1)
{
first (rp) = r;
second(rp) = (uintptr_t) list;
return rp;
}
tmp = (gid_t *) malloc(sizeof(gid_t) * r);
if (!tmp)
{
first (rp) = convertIntToML(-1);
second(rp) = (uintptr_t) list;
return rp;
}
r = getgroups(r, tmp);
if (r == -1)
{
free(tmp);
raise_exn(exn);
}
for(i=0; i<r; i++)
{
REG_POLY_CALL(allocPairML, rs, pair);
first(pair) = (uintptr_t) convertIntToML(tmp[i]);
second(pair) = (uintptr_t) list;
makeCONS(pair, list)
}
free(tmp);
first(rp) = convertIntToML(0);
second(rp) = (uintptr_t) list;
return rp;
}
int list(int arglist){
if(nullp(arglist))
return(makeNIL());
else
return(cons(car(arglist),list(cdr(arglist))));
}
int f_listp(int arglist){
if(listp(car(arglist)))
return(makeT());
else
return(makeNIL());
}
int f_numberp(int arglist){
if(numberp(car(arglist)))
return(makeT());
else
return(makeNIL());
}
int f_symbolp(int arglist){
if(symbolp(car(arglist)))
return(makeT());
else
return(makeNIL());
}
