IoObject *IoDBI_initWithDriversPath(IoDBI *self, IoObject *locals,
IoMessage *m)
{
/*doc DBI initWithDriversPath
Initialize the DBI environment with the specified libdbi driver path.
*/
IoObject *dir = IoMessage_locals_valueArgAt_(m, locals, 0);
if (ISSYMBOL(dir))
{
DATA(self)->driverCount = dbi_initialize(CSTRING(dir));
}
else
{
IoState_error_(IOSTATE, m, "argument 0 to method '%s' must be a Symbol, not a '%s'\n",
CSTRING(IoMessage_name(m)), IoObject_name(dir));
}
if (DATA(self)->driverCount == -1)
{
IoState_error_(IOSTATE, m, "*** IoDBI error during dbi_initialize\n");
}
else
{
DATA(self)->didInit = 1;
}
return IONUMBER(DATA(self)->driverCount);
}
IoObject *IoDBI_with(IoDBI *self, IoObject *locals, IoMessage *m)
{
//doc DBI with(driverName) Get a new connection with the given driver.
IoObject *name = IoMessage_locals_valueArgAt_(m, locals, 0);
if (!ISSYMBOL(name))
{
IoState_error_(IOSTATE, m, "argument 0 to method '%s' must be a Symbol, not a '%s'\n",
CSTRING(IoMessage_name(m)), IoObject_name(name));
return IONIL(self);
}
if (DATA(self)->didInit != 1)
{
IoDBI_init(self, locals, m);
}
dbi_conn c = dbi_conn_new(CSTRING(name));
if (c == NULL)
{
IoState_error_(IOSTATE, m, "libdbi error during dbi_conn_new\n");
return IONIL(self);
}
return IoDBIConn_new(IOSTATE, c);
}
OBJ
builtin_set(OBJ env, OBJ argList) {
OBJ varName, expr;
if (!ISCONS(argList)) {
js_error("(set!) expects 2 arguments:", argList);
}
varName = CAR(argList);
argList = CDR(argList);
if (!ISCONS(argList)) {
js_error("(set!) expects 2 arguments:", argList);
}
expr = CAR(argList);
argList = CDR(argList);
if (argList != js_nil) {
js_error("(set!) expects 2 arguments:", argList);
}
if (!ISSYMBOL(varName)) {
js_error("(set!) non symbol variable name:", varName);
}
if (expr == js_nil) {
environmentSet(env, varName, expr);
return js_void;
}
OBJ evaledExpr = js_eval(env, expr);
environmentSet(env, varName, evaledExpr);
return js_void;
}
static void _export_token (Token t)
{
static Token lasttok;
static bool concatenation = false;
if (t == FINISH_CMD) {
if (lasttok) output_itoken (GLOBAL, lasttok);
} else if (t == CONCAT_CMD) {
if (concatenation) return;
if (!lasttok) return;
concatenation = true;
} else if (!ISSYMBOL (t) && !ISRESERVED (t) && !ISVALUE (t)) {
if (lasttok) output_itoken (GLOBAL, lasttok);
output_itoken (GLOBAL, t);
lasttok = 0;
concatenation = false;
} else if (!concatenation) {
if (lasttok) output_itoken (GLOBAL, lasttok);
lasttok = t;
} else {
char *tmp = (char*) alloca (strlen (expand (lasttok)) + strlen (expand (t)) + 1);
strcat (strcpy (tmp, expand (lasttok)), expand (t));
lasttok = new_symbol (strdup (tmp));
}
}
IO_METHOD(IoSeq, inclusiveSlice)
{
/*doc Sequence inclusiveSlice(inclusiveStartIndex, inclusiveEndIndex)
Returns a new string containing the subset of the
receiver from the inclusiveStartIndex to the inclusiveEndIndex. The inclusiveEndIndex argument
is optional. If not given, it is assumed to be the end of the string.
*/
long fromIndex = IoMessage_locals_longArgAt_(m, locals, 0);
long last = UArray_size(DATA(self));
UArray *ba;
if (IoMessage_argCount(m) > 1)
{
last = IoMessage_locals_longArgAt_(m, locals, 1);
}
if (last == -1)
{
last = UArray_size(DATA(self));
}
else
{
last = last + 1;
}
ba = UArray_slice(DATA(self), fromIndex, last);
if (ISSYMBOL(self))
{
return IoState_symbolWithUArray_copy_(IOSTATE, ba, 0);
}
return IoSeq_newWithUArray_copy_(IOSTATE, ba, 0);
}
VOIDPTRFUNC
CP_builtin_set() {
OBJ env = ARG(0);
OBJ argList = ARG(1);
OBJ varName, expr;
VOIDPTRFUNC CP_builtin_set2();
if (!ISCONS(argList)) {
js_error("(set!) expects 2 arguments:", argList);
}
varName = CAR(argList);
argList = CDR(argList);
if (!ISCONS(argList)) {
js_error("(set!) expects 2 arguments:", argList);
}
expr = CAR(argList);
argList = CDR(argList);
if (argList != js_nil) {
js_error("(set!) expects 2 arguments:", argList);
}
if (!ISSYMBOL(varName)) {
js_error("(set!) non symbol variable name:", varName);
}
if (expr == js_nil) {
environmentSet(env, varName, expr);
RETURN (js_void);
}
CREATE_LOCALS(1);
SET_LOCAL(0, varName);
ASSERT(env != NULL, "bad env");
CALL2(CP_js_eval, env, expr, CP_builtin_set2);
// not reached
}
IO_METHOD(IoSandbox, doSandboxString)
{
/*doc Sandbox doSandboxString(aString)
Evaluate aString inside the Sandbox.
*/
IoState *boxState = IoSandbox_boxState(self);
char *s = IoMessage_locals_cStringArgAt_(m, locals, 0);
IoObject *result = IoState_doSandboxCString_(boxState, s);
if (ISSYMBOL(result))
{
return IOSYMBOL(CSTRING(result));
}
if (ISSEQ(result))
{
return IOSEQ(IOSEQ_BYTES(result), IOSEQ_LENGTH(result));
}
if (ISNUMBER(result))
{
return IONUMBER(CNUMBER(result));
}
return IONIL(self);
}
IO_METHOD(IoSeq, isMutable)
{
/*doc Sequence isMutable
Returns true if the receiver is a mutable Sequence or false otherwise.
*/
return IOBOOL(self, !ISSYMBOL(self));
}
IoObject *IoSeq_isMutable(IoSeq *self, IoObject *locals, IoMessage *m)
{
/*doc Sequence isMutable
Returns true if the receiver is a mutable Sequence or false otherwise.
*/
return IOBOOL(self, !ISSYMBOL(self));
}
IoObject *IoSeq_isSymbol(IoSeq *self, IoObject *locals, IoMessage *m)
{
/*doc Sequence isSymbol
Returns true if the receiver is a
immutable Sequence (aka, a Symbol) or false otherwise.
*/
return IOBOOL(self, ISSYMBOL(self));
}
void IoSeq_rawPio_reallocateToSize_(IoSeq *self, size_t size)
{
if (ISSYMBOL(self))
{
IoState_error_(IOSTATE, NULL, "attempt to resize an immutable Sequence");
}
UArray_sizeTo_(DATA(self), size);
}
static char shift_effect(char c, short code)
{
if (ISDIGIT(c) || ISSYMBOL(c))
return SCAN_CODES_SYMBOLS[code];
else if (ISALPHA(c) && ISLOWER(c))
return TOUPPER(c);
return c;
}
static void IoAssertNotSymbol(IoSeq *self, IoMessage *m)
{
if (ISSYMBOL(self))
{
IoState_error_(IOSTATE, m,
"'%s' cannot be called on an immutable Sequence",
CSTRING(IoMessage_name(m)));
}
}
IoObject *IoSeq_rawAsSymbol(IoSeq *self)
{
if (ISSYMBOL(self))
{
return self;
}
return IoState_symbolWithUArray_copy_(IOSTATE, DATA(self), 1);
}
IO_METHOD(IoSeq, isSymbol)
{
/*doc Sequence isSymbol
Returns true if the receiver is a
immutable Sequence (aka, a Symbol) or false otherwise.
*/
return IOBOOL(self, ISSYMBOL(self));
}
IoSeq *IoSeq_rawClone(IoSeq *proto)
{
if (ISSYMBOL(proto))
{
return proto;
}
else
{
IoSeq *self = IoObject_rawClonePrimitive(proto);
IoObject_setDataPointer_(self, UArray_clone(DATA(proto)));
return self;
}
}
static void pass ()
{
NormPtr i;
for (i = 0; CODE [i] != -1; i++)
if (CODE [i] == RESERVED_template
&& CODE [i + 1] != RESERVED_class && CODE [i + 1] != RESERVED_struct)
i = templatedef (i + 1);
else if (ISSYMBOL (CODE [i]) && tpls [CODE [i] - IDENTBASE])
i = expand_parse_template (i);
else output_itoken (GLOBAL, CODE [i]);
output_itoken (GLOBAL, -1);
}
intptr_t marshal(IoDynLib *self, IoObject *arg)
{
intptr_t n = 0;
if (ISNUMBER(arg))
{
n = IoNumber_asInt(arg);
}
else if (ISSYMBOL(arg))
{
n = (intptr_t)CSTRING(arg);
}
else if (ISLIST(arg))
{
int i;
intptr_t *l = io_calloc(1, IoList_rawSize(arg) * sizeof(intptr_t));
for (i = 0; i < IoList_rawSize(arg); i ++)
l[i] = marshal(self, List_rawAt_(IoList_rawList(arg), i));
n = (intptr_t)l;
}
else if (ISBUFFER(arg))
{
n = (intptr_t)IoSeq_rawBytes(arg);
}
else if (ISBLOCK(arg))
{
unsigned char *blk = io_calloc(1, 20), *p = blk;
// FIXME: need trampoline code for other architectures
*p++ = 0x68;
*((intptr_t *)p) = (intptr_t)arg;
p += sizeof(intptr_t);
*p++ = 0xb8;
*((intptr_t *)p) = (intptr_t)bouncer;
p += sizeof(intptr_t);
*p++ = 0xff;
*p++ = 0xd0;
*p++ = 0x83;
*p++ = 0xc4;
*p++ = 0x04;
*p++ = 0xc3;
n = (intptr_t)blk;
}
else
{
n = (intptr_t)arg; //IONIL(self);
}
return n;
}
IoSymbol *Levels_nameForAssignOperator(Levels *self, IoState *state, IoSymbol *operator, IoSymbol *slotName, IoMessage *msg)
{
IoObject *value = IoMap_rawAt(self->assignOperatorTable, operator);
char *operatorString = CSTRING(operator);
if (value != NULL && ISSYMBOL(value))
{
if (strcmp(operatorString, ":=") == 0 && isupper(CSTRING(slotName)[0]))
{
return state->setSlotWithTypeSymbol;
}
else
{
return value;
}
}
else
{
IoState_error_(IoObject_state(msg), msg, "compile error: Value for '%s' in Message OperatorTable assignOperators is not a symbol. Values in the OperatorTable assignOperators are symbols which are the name of the operator.", operatorString);
return NULL; // To keep the compiler happy.
}
}
IO_METHOD(IoSeq, with)
{
/*doc Sequence with(aSequence, ...)
Returns a new Sequence which is the concatination of the arguments.
The returned sequence will have the same mutability status as the receiver.
*/
int n, argCount = IoMessage_argCount(m);
UArray *ba = UArray_clone(DATA(self));
for (n = 0; n < argCount; n ++)
{
IoSeq *v = IoMessage_locals_seqArgAt_(m, locals, n);
UArray_append_(ba, DATA(v));
}
if (ISSYMBOL(self))
{
return IoState_symbolWithUArray_copy_(IOSTATE, ba, 0);
}
return IoSeq_newWithUArray_copy_(IOSTATE, ba, 0);
}
IoObject *IoRegexMatches_setRegex(IoRegexMatches *self, IoObject *locals, IoMessage *m)
{
/*doc RegexMatches setRegex(aRegexOrString)
Sets the regex to find matches in. Returns self.
*/
IoObject *arg = IoMessage_locals_valueArgAt_(m, locals, 0);
if (ISREGEX(arg))
DATA(self)->regex = IOREF(arg);
else if(ISSYMBOL(arg))
DATA(self)->regex = IoRegex_newWithPattern_(IOSTATE, arg);
else
IoState_error_(IOSTATE, m, "The argument to setRegex must be either a Regex or a Sequence");
{
/* Make the capture array big enough to hold the capture information and any other data
pcre_exec may want to put in it. */
int size = (IoRegex_rawRegex(DATA(self)->regex)->captureCount + 1) * 3;
UArray_setSize_(DATA(self)->captureArray, size);
}
IoRegexMatches_rawsetPosition_(self, 0);
return self;
}
IoObject *demarshal(IoObject *self, IoObject *arg, intptr_t n)
{
if (ISNUMBER(arg))
{
return IONUMBER(n);
}
else if (ISSYMBOL(arg))
{
if (n == 0)
return IOSYMBOL("");
return IOSYMBOL((char*)n);
}
else if (ISLIST(arg))
{
intptr_t *values = (intptr_t *)n;
int i;
for (i = 0; i < IoList_rawSize(arg); i ++)
{
IoObject *value = List_at_(IoList_rawList(arg), i);
List_at_put_(IoList_rawList(arg), i, demarshal(self, value, values[i]));
}
io_free(values);
return arg;
}
else if (ISBUFFER(arg))
{
return arg;
}
else if (ISBLOCK(arg))
{
return arg;
}
return IONIL(self);
}
bool is_expression (NormPtr p)
{
NormPtr p2 = skip_parenthesis (++p);
int nsym = 0;
Token t;
while (p < p2)
switch (t = CODE [p++]) {
case RESERVED_const:
case RESERVED_volatile:
case '(': case ')':
case '*': continue;
case '[': p = skip_brackets (p);
continue;
default:
if (ISSYMBOL (t))
if (nsym) return true;
else ++nsym;
else return true;
}
return false;
}
OBJ
builtin_define(OBJ env, OBJ argList){
if( !ISCONS(argList) ){
js_error("(define): expects at least 2 arguments", js_nil);
}
OBJ arg1 = CAR(argList);
argList = CDR(argList);
if( !ISCONS(argList) ){
js_error("(define): expects at least 2 arguments", js_nil);
}
// case 1: define SYMBOL -> (define symbol expression)
if( ISSYMBOL(arg1)) {
OBJ arg2 = CAR(argList);
argList = CDR(argList);
if( argList != js_nil ){
js_error("(define): this form expects exactly 2 arguments", js_nil);
}
OBJ value = js_eval(env, arg2);
environmentPut(env, arg1, value);
#ifdef DEBUG
// PRINT TRACE
if( EVAL_TRACE->state) {
printIndent(indentLevel);
fprintf(stdout, RED"DEFINE "RESET);
js_print(stdout, arg1,1);
fprintf(stdout, " -> ");
js_print(stdout, value,1);
if( TAG(env) == T_GLOBALENVIRONMENT ){
fprintf(stdout," in " CYN "GLOBAL" RESET " (%p)\n", env);
}
if( TAG(env) == T_LOCALENVIRONMENT ){
fprintf(stdout," in " YEL "LOCAL" RESET " (%p)\n", env);
}
}
#endif
return js_void;
}
// case 2: define CONS ( function ) -> (define (name args*) (body*) )
if( ISCONS(arg1)){
OBJ name = CAR(arg1);
if( ISSYMBOL(name) ){
OBJ formalArgList = CDR(arg1);
OBJ bodyList = argList;
OBJ newUDF;
newUDF = newUserDefinedFunction("anonymous lambda", formalArgList, bodyList);
newUDF->u.userDefinedFunction.numLocals = count_defines(bodyList);
newUDF->u.userDefinedFunction.home = env;
environmentPut(env, name, newUDF);
#ifdef DEBUG
// PRINT TRACE
if( EVAL_TRACE->state ){
printIndent(indentLevel);
fprintf(stdout, RED"DEFINE "RESET);
js_print(stdout, name,1);
fprintf(stdout, " -> ");
js_print(stdout, newUDF,1);
if( TAG(env) == T_GLOBALENVIRONMENT ){
fprintf(stdout," in " CYN "GLOBAL" RESET " (%p)\n", env);
}
if( TAG(env) == T_LOCALENVIRONMENT ){
fprintf(stdout," in " YEL "LOCAL" RESET " (%p)\n", env);
}
}
#endif
return js_void;
}
}
error("define form unimplemented", __FILE__, __LINE__);
// NOT REACHED
return js_nil;
}
Token *build_type (typeID t, Token o, Token ret[])
{
/* XXX: elliptics */
if (is_reference (t))
t = ptrdown (dereference (t));
Token tmp [100], *dcls = &tmp [20], *dcle = dcls;
Token *st = open_typeID (t);
int i = 1, b = 0;
if (o) {
*(++dcle) = -1;
*dcls-- = o;
} else *dcls-- = -1;
for (;;i++) {
switch (st [i]) {
case '*':
*dcls-- = '*';
b = 1;
continue;
case '[':
if (b) *dcls-- = '(', *dcle++ = ')', b = 0;
*dcle++ = '['; *dcle++ = ']';
continue;
case '(':
if (b) *dcls-- = '(', *dcle++ = ')', b = 0;
*dcle++ = '(';
for (i++;;)
if (st [i] == B_ELLIPSIS) {
*dcle++ = ELLIPSIS;
break;
} else {
if (st [i] == INTERNAL_ARGEND) break;
Token arg [50];
intcpy (dcle, build_type (st [i++], 0, arg));
dcle += intlen (dcle);
*dcle++ = ',';
}
if (dcle [-1] == ',') --dcle;
*dcle++ = ')';
continue;
case -1: break;
default: PRINTF ("UNKNWOWN %i\n", st [i]);
}
break;
}
*dcle = -1;
if (st [0] >= 0)
if (ISSYMBOL (st [0])) sintprintf (ret, st [0], -1);
else sintprintf (ret, isunion (st [0]) ? RESERVED_union : iRESERVED_struct (st [0]),
name_of_struct (st [0]), -1);
else switch (st [0]) {
case B_UCHAR: sintprintf (ret, RESERVED_unsigned, RESERVED_char, -1);
ncase B_SCHAR: sintprintf (ret, RESERVED_char, -1);
ncase B_USINT: sintprintf (ret, RESERVED_unsigned, RESERVED_short, RESERVED_int, -1);
ncase B_SSINT: sintprintf (ret, RESERVED_short, RESERVED_int, -1);
ncase B_UINT: sintprintf (ret, RESERVED_unsigned, RESERVED_int, -1);
ncase B_SINT: sintprintf (ret, RESERVED_int, -1);
ncase B_ULONG: sintprintf (ret, RESERVED_unsigned, RESERVED_long, -1);
ncase B_SLONG: sintprintf (ret, RESERVED_long, -1);
ncase B_ULLONG: sintprintf (ret, RESERVED_unsigned, RESERVED_long, RESERVED_long, -1);
ncase B_SLLONG: sintprintf (ret, RESERVED_long, RESERVED_long, -1);
ncase B_FLOAT: sintprintf (ret, RESERVED_float, -1);
ncase B_DOUBLE: sintprintf (ret, RESERVED_double, -1);
ncase B_VOID: sintprintf (ret, RESERVED_void, -1);
}
intcat (ret, dcls + 1);
return ret;
}
