10#include "i_parse_blk.c"
34#define UT(ptr) ((UThread*) ptr)
35#define PTR_I (void*)(intptr_t)
36#define cp_error (void*)(intptr_t) ur_error
39enum FuncArgumentOpcodes
54#define CHECK_TYPE_PAD 0x10
59 AR_WORD, AR_TYPE, AR_LITW, AR_OPT, AR_LOCAL, AR_VARIANT
70#define LOCAL_OPT LWORD+8
71#define FIND_LOCAL LWORD+16
73static const uint8_t _argRules[ 76 ] =
78 PB_Rule, LOCAL_OPT, PB_AnyTs, LWORD, PB_ReportEnd, AR_LOCAL,
81 PB_Type, UT_WORD, PB_ReportEnd, AR_WORD,
84 PB_Type, UT_DATATYPE, PB_ReportEnd, AR_TYPE,
87 PB_Type, UT_LITWORD, PB_ReportEnd, AR_LITW,
90 PB_Type, UT_OPTION, PB_AnyTs, LWORD, PB_ReportEnd, AR_OPT,
93 PB_Type, UT_INT, PB_ReportEnd, AR_VARIANT,
95 PB_Type, UT_STRING, PB_End,
98 0x00,0xE0,0x00,0x00,0x00,0x00,0x00,0x00,
102 PB_LitWord, BAR, PB_End,
103 PB_LitWord, LOCAL, PB_End,
107 PB_ToLitWord, BAR, PB_End,
108 PB_ToLitWord, LOCAL, PB_End
117 uint8_t programOffset;
128 OptionEntry opt[ 1 ];
133#define OPTION_FLAGS id.ext
148 OptionEntry opt[ MAX_OPTIONS ];
163static void _defineArg(
UBuffer* ctx,
int binding,
UIndex stackMapN,
170 ur_binding(cell) = binding;
174 cell->
word.sel[1] = optArgN;
178#define EMIT(op) prog->ptr.b[ prog->used++ ] = op
180static void _argRuleHandler( UBlockParser* par,
int rule,
183 ArgCompiler* ap = (ArgCompiler*) par;
195 EMIT( FO_checkType );
215 EMIT( FO_checkTypeMask );
220 which |= CHECK_TYPE_PAD;
224 for( wbit = 1; wbit <= 4; wbit <<= 1 )
229 *((uint16_t*) (prog->
ptr.
b + prog->
used)) = mask;
235 prog->
ptr.
b[ wpos ] = which;
239 EMIT( FO_checkType );
248 if( ! ap->optionCount )
251 _defineArg( &ap->sval, BOR_BIND_FUNC, ap->stackMapN,
256 if( it->
word.
atom == par->atoms[ EXTERN ] )
258 for( ++it; it != end; ++it )
262 else if( it->
word.
atom == par->atoms[ NOTRACE ] )
264 par->rflag |= FUNC_FLAG_NOTRACE;
268 if( ap->optionCount < MAX_OPTIONS )
275 _defineArg( &ap->sval, BOR_BIND_OPTION, ap->stackMapN,
276 it->
word.
atom, ap->optionCount, 0 );
278 if( ! ap->optionCount )
280 ap->argEndPc = prog->
used;
285 ent = &ap->opt[ ap->optionCount++ ];
287 ent->optionIndex = ap->optionCount;
288 ent->programOffset = 0;
294 ent->programOffset = prog->
used - ap->origUsed;
295 for( ; it != end; ++it )
297 if( it->word.atom < UT_MAX )
299 EMIT( FO_checkType );
300 EMIT( it->word.atom );
304 EMIT(ur_is(it,UT_LITWORD) ? FO_litArg:FO_fetchArg);
307 _defineArg( &ap->sval, BOR_BIND_OPTION_ARG,
308 ap->stackMapN, it->word.atom,
309 ap->optionCount - 1, argCount );
317 ent->argCount = argCount;
322 for( ++it; it != end; ++it )
344 if( type == UT_SETWORD )
349 else if( type == UT_BLOCK || type == UT_PAREN )
350 _appendSetWords( ut, buf, bi.
it, argCtx );
356static void _zeroDuplicateU32(
UBuffer* a )
358 uint32_t* it = a->
ptr.
u32;
359 uint32_t* end = it + a->
used;
360 for( ; it != (end - 1); ++it )
362 if( find_uint32_t( it + 1, end, *it ) )
370 uint32_t* it = a->
ptr.
u32;
371 uint32_t* end = it + a->
used;
372 const uint32_t* bIt = b->
ptr.
u32;
373 const uint32_t* bEnd = bIt + b->
used;
374 for( ; it != end; ++it )
376 if( find_uint32_t( bIt, bEnd, *it ) )
382static void _removeValueU32(
UBuffer* buf, uint32_t val )
384 uint32_t* it = buf->
ptr.
u32;
385 uint32_t* end = it + buf->
used;
388 it = (uint32_t*) find_uint32_t( it, end, val );
391 for( out = it++; it != end; ++it )
400extern const UAtom* boron_compileAtoms( BoronThread* );
431void boron_compileArgProgram( BoronThread* bt,
const UCell* specC,
437 const int headerSize = 4;
442 ac.origUsed = prog->
used;
448 estimatedSize = ac.bp.end - ac.bp.it;
449 estimatedSize += (estimatedSize / 2) + 2;
450 estimatedSize = (estimatedSize + 3) & ~3;
453 prog->
used += headerSize;
459 if( ac.bp.it != ac.bp.end )
462 ac.bp.atoms = boron_compileAtoms(bt);
463 ac.bp.rules = _argRules;
464 ac.bp.report = _argRuleHandler;
467 ac.stackMapN = bodyN;
469 ur_arrInit( &ac.localWords,
sizeof(uint32_t), 0 );
470 ur_arrInit( &ac.externWords,
sizeof(uint32_t), 0 );
473 const UCell* start = ac.bp.it;
474 const UCell* end = ac.bp.end;
476 if( ur_parseBlockI( &ac.bp, _argRules + FIND_LOCAL, start ) )
477 local = ac.bp.end = ac.bp.it;
481 ur_parseBlockI( &ac.bp, ac.bp.rules, start );
486 ur_parseBlockI( &ac.bp, ac.bp.rules, local );
494 ur_initSeries( &tmp, UT_BLOCK, bodyN );
495 _appendSetWords( ut, &ac.localWords, &tmp, &ac.sval );
497 if( ac.localWords.
used > 1 )
498 _zeroDuplicateU32( &ac.localWords );
499 if( ac.externWords.
used )
500 _zeroDiffU32( &ac.localWords, &ac.externWords );
501 _removeValueU32( &ac.localWords, 0 );
503 if( ac.localWords.
used )
507 int localIndex = ac.funcArgCount;
513 _defineArg( &ac.sval, BOR_BIND_FUNC, bodyN,
514 *ai++, localIndex++, 0 );
516 localCount = ac.localWords.
used;
539 const int optRecSize = 1;
540 int tsize = ac.optionCount *
sizeof(OptionEntry) + optRecSize;
541 int newUsed = prog->
used + tsize;
544 ent = (OptionEntry*) (prog->
ptr.
b + ac.origUsed + headerSize);
545 ee = ent + ac.optionCount;
546 memmove( ((
char*) ent) + tsize, ent,
547 prog->
used - ac.origUsed - headerSize );
548 memcpy( ent, ac.opt, tsize - optRecSize );
549 prog->
used = newUsed;
551 for( ; ent != ee; ++ent )
553 if( ent->programOffset )
554 ent->programOffset += tsize;
557 *((uint8_t*) ent) = FO_optionRecord;
561 uint8_t* endArg = prog->
ptr.
b + ac.argEndPc + tsize;
562 *endArg++ = FO_clearLocal;
563 *endArg = localCount;
567 *sigFlags = ac.bp.rflag;
574 if( ! ac.optionCount )
578 EMIT( FO_clearLocal );
586 while( prog->
used & 3 )
590 head = (ArgProgHeader*) (prog->
ptr.
b + ac.origUsed);
591 head->progOffset = headerSize + ac.optionCount *
sizeof(OptionEntry);
592 head->funcFlags = *sigFlags;
593 head->optionCount = ac.optionCount;
595 if (bodyN && (ac.optionCount || ac.funcArgCount || localCount))
596 head->funcFlags |= FUNC_FLAG_NEEDSTACK;
603void boron_argProgramToStr(
UThread* ut,
const void* prog,
UBuffer* str )
605 ArgProgHeader* head = (ArgProgHeader*) prog;
606 const uint8_t* pc = ((
const uint8_t*) head) + head->progOffset;
610 if (head->optionCount) {
616 while( (op = *pc++) < FO_end )
644 case FO_checkTypeMask:
649 if( which & CHECK_TYPE_PAD )
653 mask |= *((uint16_t*) pc);
658 mask |= ((int64_t) *((uint16_t*) pc)) << 16;
663 mask |= ((int64_t) *((uint16_t*) pc)) << 32;
670 datatype_toString( ut, &dt, str, 0 );
674 case FO_optionRecord:
713EvalFrame* boron_reuseFrame(
UThread* ut,
int extraFrames,
int* keepStack)
716 EvalFrame* ef = ur_ptr(EvalFrame, buf) + buf->
used - 1;
717 assert(ef->block.eop == EOP_CALL_CFUNC);
720 *keepStack = ef->call.origStack;
722 ut->stack.
used = ef->call.origStack;
724 if (ef[-1].block.eop == EOP_OPTION_IT)
732 buf->
used += extraFrames;
743void boron_initEvalCatch(EvalFrame* ef,
745 int origStack,
UCell* result)
747 ef->invoke.eop = EOP_CATCH;
748 ef->invoke.state = 1;
749 ef->invoke.origStack = origStack;
750 ef->invoke.dat.catchf = handler;
751 ef->invoke.result = result;
764 UIndex top = BT->evalOp.used;
765 EvalFrame* ef = boron_pushEvalFrame(ut);
767 ef->invoke.eop = EOP_RUN_RECURSE;
768 ef->invoke.state = 1;
769 ef->invoke.origStack = ut->stack.
used;
770 ef->invoke.dat.catchf = NULL;
771 ef->invoke.result = result;
784 BT->evalOp.used = top;
792 ef->block.eop = EOP_DO_BLOCK;
793 ef->block.funcFlags = 0;
794 ef->block.origStack = ut->stack.
used;
795 ef->block.codeBlk = blkN;
798 ef->block.result = result;
802EvalFrame* boron_pushEvalFrame(
UThread* ut)
807 EvalFrame* ef = ur_ptr(EvalFrame, buf) + buf->
used;
815int boron_resetEvalFrame(
UThread* ut,
const EvalFrame* end)
818 buf->
used = end - ur_ptr(EvalFrame, buf);
819 return CFUNC_REFRAMED;
823EvalFrame* boron_findEvalFrame(
UThread* ut,
int op)
826 EvalFrame* start = ur_ptr(EvalFrame, buf);
827 EvalFrame* ef = start + buf->
used - 1;
828 for (; ef != start; --ef)
830 if (ef->block.eop == op)
841static EvalFrame* _reuseFrame(BoronThread* bt,
int eop)
844 EvalFrame* ef = ur_ptr(EvalFrame, buf) + buf->
used - 1;
845 assert(ef->block.eop == EOP_CALL_CFUNC);
846 bt->thread.stack.
used = ef->call.origStack;
848 if (ef[-1].block.eop == EOP_OPTION_IT)
858static EvalFrame* _pushEvalFrame(BoronThread* bt,
int eop)
863 EvalFrame* ef = ur_ptr(EvalFrame, buf) + buf->
used;
872static void _initEvalBlock( EvalFrame* ef,
UThread* ut,
UIndex blkN,
873 int stackPad,
UCell* result )
876 ef->block.funcFlags = 0;
877 ef->block.origStack = ut->stack.
used - stackPad;
878 ef->block.codeBlk = blkN;
881 ef->block.result = result;
885static void _initEvalReduce( EvalFrame* ef,
UThread* ut,
const UCell* blkC,
888 ef->reduce.origStack = ut->stack.
used;
891 ef->reduce.resBlk = resBlkN;
895#define CALL_TRACE_NA -1
896#define CALL_TRACE_SKIP -2
899static void _initEvalCallC( EvalFrame* ef,
UThread* ut,
const UCell* cfunc,
900 int origStack,
UCell* result )
904 const ArgProgHeader* head = (
const ArgProgHeader*)
906 ((
const UCellFunc*) cfunc)->argProgOffset);
907 ef->call.eop = EOP_CALL_CFUNC;
908 ef->call.origStack = origStack;
909 ef->call.argsPos = ut->stack.
used;
910 ef->call.pc = ((
const uint8_t*) head) + head->progOffset;
911 ef->call.funC = cfunc;
912 ef->call.result = result;
915 if (pf->block.eop == EOP_OPTION_IT)
917 pf->block.result = (
UCell*) head;
921 if (ur_flags(cfunc, FUNC_FLAG_NOTRACE))
922 ef->call.tracePos = CALL_TRACE_SKIP;
925 while ((1<<pf->block.eop & MASK_EOP_DO) == 0)
928 ef->call.tracePos = pf->block.it - blk->
ptr.
cell;
934static void _initEvalCallF( EvalFrame* ef,
UThread* ut,
const UCell* func,
935 int origStack,
UCell* result )
938 const ArgProgHeader* head = (
const ArgProgHeader*)
940 ef->call.eop = EOP_CALL_FUNC;
941 ef->call.funcFlags = head->funcFlags;
942 ef->call.origStack = origStack;
943 ef->call.argsPos = ut->stack.
used;
944 ef->call.pc = ((
const uint8_t*) head) + head->progOffset;
945 ef->call.funC = func;
946 ef->call.result = result;
948 if (ef[-1].block.eop == EOP_OPTION_IT)
949 ef[-1].block.result = (
UCell*) head;
967 EvalFrame* ef = _reuseFrame(BT, EOP_DO_BLOCK);
977 _initEvalBlock(ef, ut, blkN, pad, res);
978 ef->block.funcFlags = flags;
979 return CFUNC_REFRAMED;
1000 EvalFrame* ef = boron_reuseFrame(ut, 1, &origStack);
1001 ef->invoke.eop = EOP_INVOKE;
1002 ef->invoke.state = DO_BLOCK1_START;
1003 ef->invoke.origStack = origStack;
1004 ef->invoke.userBuf = 0;
1005 ef->invoke.func = valueFunc;
1006 ef->invoke.result = res;
1009 ef->block.eop = EOP_DO_BLOCK1;
1010 _initEvalBlock(ef, ut, blkN, 0, res);
1011 return CFUNC_REFRAMED;
1015int boron_breakDoBlock1(
UThread* ut, EvalFrameInvoke* ef)
1017 UBuffer* evalOp = &BT->evalOp;
1018 ut->stack.
used = ef->origStack;
1020 return CFUNC_REFRAMED;
1039 ur_initSeries(res, UT_BLOCK, blkN);
1041 ef = boron_reuseFrame(ut, 1, &origStack);
1042 ef->invoke.eop = EOP_INVOKE;
1044 ef->invoke.origStack = origStack;
1045 ef->invoke.userBuf = blkN;
1046 ef->invoke.func = complete;
1048 ef->invoke.result = res;
1051 ef->invoke.eop = EOP_REDUCE;
1052 _initEvalReduce(ef, ut, blkC, blkN);
1062 EvalFrame* ef = _pushEvalFrame(BT, EOP_DO_BLOCK);
1064 _initEvalBlock(ef, ut, blkN, 0, res);
1077#define REPORT(msg,...) printf(msg,__VA_ARGS__)
1079#define REPORT(msg,...)
1086#define INLINE_WORDVAL(it) \
1087 if( ur_binding(it) == UR_BIND_ENV ) \
1088 cell = (ut->sharedStoreBuf - it->word.ctx)->ptr.cell + it->word.index;\
1089 else if( ur_binding(it) == UR_BIND_THREAD ) \
1090 cell = (ut->dataStore.ptr.buf+it->word.ctx)->ptr.cell + it->word.index;\
1091 else if( ! (cell = ur_wordCell(ut, it)) ) \
1107 if( ur_is(cell, UT_CFUNC) )
1109 REPORT(
"%s cfunc!\n", ur_wordCStr(it-1));
1112 if( ur_is(cell, UT_FUNC) )
1114 REPORT(
"%s func!\n", ur_wordCStr(it-1));
1117 if( ur_is(cell, UT_UNSET) )
1130 ef = _pushEvalFrame(BT, EOP_SET);
1133 ef->set.result = res;
1137 (ur_is(it, UT_SETWORD) || ur_is(it, UT_SETPATH)))
1150 ef = _pushEvalFrame(BT, EOP_DO_BLOCK);
1153 _initEvalBlock(ef, ut, it->
series.
buf, 0, res);
1162 if( it->
word.selType )
1169 if( ur_is(last, UT_CFUNC) || ur_is(last, UT_FUNC) ) {
1182 if( headType == UT_WORD )
1184 origStack = ut->stack.
used;
1186 if( ur_is(last, UT_CFUNC) )
1188 ef = _pushEvalFrame(BT, EOP_OPTION_IT);
1189 ef->block.it = path.
it;
1190 ef->block.end = path.
end;
1194 else if( ur_is(last, UT_FUNC) )
1200 ef = _pushEvalFrame(BT, EOP_OPTION_IT);
1201 ef->block.it = path.
it;
1202 ef->block.end = path.
end;
1221 origStack = ut->stack.
used;
1223 if (origStack > BT->stackLimit)
1224 goto stack_overflow;
1225 ef = boron_pushEvalFrame(ut);
1228 _initEvalCallC(ef, ut, cell, origStack, res);
1235 origStack = ut->stack.
used;
1240 ef = _pushEvalFrame(BT, EOP_FUNC_BODY);
1243 _initEvalBlock(ef, ut, cell->
series.
buf, 0, res);
1247 if (origStack > BT->stackLimit)
1248 goto stack_overflow;
1249 ef = boron_pushEvalFrame(ut);
1252 _initEvalCallF(ef, ut, cell, origStack, res);
1270static int64_t _funcCheckTypeMask(EvalFrame* ef,
int type)
1273 const uint8_t* pc = ef->call.pc;
1275 if( which & CHECK_TYPE_PAD )
1279 mask |= *((uint16_t*) pc);
1284 mask |= ((int64_t) *((uint16_t*) pc)) << 16;
1289 mask |= ((int64_t) *((uint16_t*) pc)) << 32;
1293 return (1LL << type) & mask;
1297#define FETCH_OPT_ARG (UR_OK + 1)
1300static int _funcRecordOption(
UThread* ut, EvalFrame* cf, EvalFrame* options)
1303 while( options->block.it != options->block.end )
1305 const UCell* oc = options->block.it++;
1306 const ArgProgHeader* head = (
const ArgProgHeader*)
1307 options->block.result;
1308 const OptionEntry* ent = head->opt;
1309 int count = head->optionCount;
1311 for( i = 0; i < count; ++i, ++ent )
1313 if( ent->atom == oc->word.atom )
1316 args[-1].OPTION_FLAGS |= 1 << i;
1317 if( ent->programOffset )
1319 ((uint8_t*) args)[-1 - i] =
1320 ut->stack.
used - cf->call.argsPos;
1321 cf->call.pc = ((
const uint8_t*) head) + ent->programOffset;
1322 return FETCH_OPT_ARG;
1343int boron_runFibre(
UThread* ut )
1345 EvalFrame* evalFrames;
1351 UBuffer* evalOp = &BT->evalOp;
1355 evalFrames = ur_ptr(EvalFrame, evalOp);
1357 while (evalOp->
used)
1360 ef = evalFrames + evalOp->
used - 1;
1361 switch (ef->block.eop)
1364 if (ef->block.it == ef->block.end)
1366 stack->
used = ef->block.origStack;
1371 cell = boron_eval1F(ut, ef->block.it, ef->block.end,
1375 ef->block.it = cell;
1380 if (df->invoke.state == DO_BLOCK1_VALUE)
1382 op = df->invoke.func(ut, &df->invoke);
1383 if (op == CFUNC_REFRAMED)
1389 df->invoke.state = DO_BLOCK1_VALUE;
1391 if (ef->block.it != ef->block.end)
1394 stack->
used = df->invoke.origStack;
1396 df->invoke.state = DO_BLOCK1_COMPLETE;
1397 if (df->invoke.func(ut, &df->invoke) ==
UR_THROW)
1403 if (ef->block.it != ef->block.end)
1406 stack->
used = ef->block.origStack;
1407 evalOp->
used -= (ef[-1].block.eop == EOP_OPTION_IT) ? 2 : 1;
1408 if (ef->block.funcFlags & FUNC_FLAG_NEEDSTACK)
1409 BT->frames.used -= 2;
1413 for (cell = ef->set.it; cell != ef->set.end; ++cell)
1415 if (ur_is(cell, UT_SETWORD))
1430 if (ef->reduce.it == ef->reduce.end)
1432 stack->
used = ef->reduce.origStack;
1438 cell = boron_eval1F(ut, ef->reduce.it, ef->reduce.end,
1443 ef->reduce.it = cell;
1446 case EOP_BLOCK_ITER:
1452 stack->
used = ef->invoke.origStack;
1453 evalOp->
used -= ef->invoke.state;
1456 case EOP_RUN_RECURSE:
1460 return BOR_FIBRE_DONE;
1462 case EOP_INVOKE_LOOP:
1463 op = ef->invoke.func(ut, &ef->invoke);
1471 if (ef->invoke.func(ut, &ef->invoke) ==
UR_THROW)
1473 stack->
used = ef->invoke.origStack;
1479 case EOP_CALL_CFUNC:
1483 while ((1 << df->block.eop & MASK_EOP_DO) == 0)
1485 while( (op = *ef->call.pc++) < FO_end )
1490 op = *ef->call.pc++;
1493 UCell* lend = ls + op;
1494 for( ; ls != lend; ++ls )
1501 if( df->block.it == df->block.end )
1506 efUsed = evalOp->
used;
1507 cell = boron_eval1F(ut, df->block.it, df->block.end,r2);
1513 df->block.it = cell;
1514 if (evalOp->
used > efUsed)
1519 if (df->block.it == df->block.end)
1526 op = *ef->call.pc++;
1532 case FO_checkTypeMask:
1534 if (! _funcCheckTypeMask(ef,
ur_type(r2)))
1538 case FO_optionRecord:
1541 ef->call.argsPos = stack->
used;
1549 ur_int(r2) = *ef->call.pc++;
1555 if (df->block.eop == EOP_OPTION_IT)
1557 switch (_funcRecordOption(ut, ef, df)) {
1565 if (ef->call.eop == EOP_CALL_CFUNC)
1567 REPORT(
" cfunc! ef:%ld r:%d s:%d,%d,%d\n",
1568 ef - evalFrames, ef->call.result - stack->
ptr.
cell,
1569 ef->call.origStack, ef->call.argsPos, stack->
used);
1571 op = ((
const UCellFunc*) ef->call.funC)->m.func(ut,
1572 stack->
ptr.
cell + ef->call.argsPos,
1574 if (op == CFUNC_REFRAMED)
1578 stack->
used = ef->call.origStack;
1579 evalOp->
used -= (ef[-1].block.eop == EOP_OPTION_IT) ? 2 : 1;
1581 if (op == CFUNC_YIELD)
1582 return BOR_FIBRE_YIELD;
1587 const UCell* funC = ef->call.funC;
1588 if (ef->call.funcFlags & FUNC_FLAG_NEEDSTACK)
1596 smap->
used = newUsed;
1598 fi[1] = ef->call.argsPos;
1601 REPORT(
" func! ef:%ld r:%d s:%d,%d,%d\n",
1602 ef - evalFrames, ef->call.result - stack->
ptr.
cell,
1603 ef->call.origStack, ef->call.argsPos, stack->
used);
1610 ef->block.eop = EOP_FUNC_BODY;
1623 return BOR_FIBRE_EXCEPTION;
1626 return BOR_FIBRE_DONE;
1629 r2 = ur_exception(ut);
1630 efUsed = ur_is(r2, UT_WORD) ? ur_atom(r2) : 0;
1631 if (! ur_is(r2, UT_ERROR))
1633 callTrace = CALL_TRACE_NA;
1636 for (df = ef; df >= evalFrames; --df)
1638 switch (df->invoke.eop)
1641 case EOP_INVOKE_LOOP:
1642 op = df->invoke.dat.catchf(ut, df);
1647 stack->
used = df->invoke.origStack;
1648 evalOp->
used = (df - evalFrames) - (df->invoke.state - 1);
1655 if (efUsed == UR_ATOM_RETURN)
1657 evalOp->
used = (df - evalFrames) + 1;
1672 if ((1 << df->invoke.eop & MASK_EOP_FFLAGS) &&
1673 (df->block.funcFlags & FUNC_FLAG_NOTRACE))
1675 callTrace = CALL_TRACE_SKIP;
1683 callTrace = CALL_TRACE_NA;
1685 else if (callTrace == CALL_TRACE_SKIP)
1687 callTrace = CALL_TRACE_NA;
1691 doPos = df->block.it;
1693 ur_traceError(ut, r2, df->block.codeBlk, doPos);
1697 case EOP_RUN_RECURSE:
1699 return BOR_FIBRE_EXCEPTION;
1701 case EOP_CALL_CFUNC:
1702 if (callTrace == CALL_TRACE_NA)
1703 callTrace = df->call.tracePos;
1707 return BOR_FIBRE_EXCEPTION;
1726CFUNC_PUB( cfunc_do )
1728 EvalFrame* ef = NULL;
1739 if (ur_is(cell, UT_CFUNC) || ur_is(cell, UT_FUNC))
1741 boron_reuseFrame(ut, -1, NULL);
1742 if (! boron_eval1F(ut, cell, cell+1, res))
1744 return CFUNC_REFRAMED;
1756 return boron_copyWordValue(ut, a1, res);
1763 if (si.
it == si.
end)
1765 else if (ur_strIsUcs2(si.
buf))
1767 "FIXME: Cannot do ucs2 string!");
1783 ef = _reuseFrame(BT, EOP_DO_BLOCK);
1785 _initEvalBlock(ef, ut, blkN, 1, res);
1786 return CFUNC_REFRAMED;
1792 if (cfunc_load(ut, a1, res) ==
UR_THROW)
1794 if (res->
id.
type != UT_BLOCK)
1802 ef = _reuseFrame(BT, EOP_DO_BLOCK);
1803 _initEvalBlock(ef, ut, a1->series.buf, 0, res);
1804 return CFUNC_REFRAMED;
1812 if( a1->word.selType )
1819 if( ur_is(last, UT_CFUNC) || ur_is(last, UT_FUNC) ) {
1835 if( ur_is(last, UT_CFUNC) )
1837 ef = boron_reuseFrame(ut, 1, &origStack);
1840 ef->block.eop = EOP_OPTION_IT;
1841 ef->block.it = path.
it;
1842 ef->block.end = path.
end;
1847 else if( ur_is(last, UT_FUNC) )
1853 ef = boron_reuseFrame(ut, 1, &origStack);
1856 ef->block.eop = EOP_OPTION_IT;
1857 ef->block.it = path.
it;
1858 ef->block.end = path.
end;
1876 ef = boron_reuseFrame(ut, 0, &origStack);
1880 _initEvalCallC(ef, ut, a1, origStack, res);
1881 return CFUNC_REFRAMED;
1886 ef = boron_reuseFrame(ut, 0, &origStack);
1889 if (a1->series.it == 0)
1891 ef->block.eop = EOP_FUNC_BODY;
1892 _initEvalBlock(ef, ut, a1->series.buf,
1893 ut->stack.
used - origStack, res);
1900 _initEvalCallF(ef, ut, a1, origStack, res);
1902 return CFUNC_REFRAMED;
1923 if( ur_is(a1, UT_BLOCK) )
1926 ur_initSeries(res, UT_BLOCK, blkN);
1928 EvalFrame* ef = _reuseFrame(BT, EOP_REDUCE);
1929 _initEvalReduce(ef, ut, a1, blkN);
1930 return CFUNC_REFRAMED;
1943 if( ! context_make( ut, from, res ) )
1945 if( ur_is(from, UT_BLOCK) )
1947 EvalFrame* ef = _reuseFrame(BT, EOP_DO_BLOCK);
1949 return CFUNC_REFRAMED;
1965 bi.end = bi.it + bi.buf->
used;
1970 if( ur_isWordType(type) )
1973 if( threadCtx->
used )
1980 if( type == UT_SETWORD )
1999 if( ! ur_is(
ur_ctxCell(envCtx, wrdN), UT_UNSET ) )
2002 bi.it->
word.
ctx = -UR_MAIN_CONTEXT;
2012 bi.it->
word.
ctx = UR_MAIN_CONTEXT;
2015 else if( ur_isBlockType(type) )
2021 else if( ur_isPathType(type) )
2023 if( bi.it->
word.selType )
2045 _bindDefaultB( ut, blkN );
2051static void boron_unlinkFibre(BoronThread* start, BoronThread* toRemove)
2054 BoronThread* it = start;
2057 fib = it->nextFibre;
2058 if (fib == toRemove) {
2059 it->nextFibre = fib->nextFibre;
2070extern void thread_writeFibreResult(
UThread*);
2080 boron_startFibre(ut, blkN, res);
2082 fstate = boron_runFibre(ut);
2083 if (fstate == BOR_FIBRE_YIELD) {
2085 ut = boron_waitFibre(ut);
2087 if (ut == evalThread)
2090 if (fstate == BOR_FIBRE_EXCEPTION) {
2100 ut = (
UThread*) (BT->nextFibre);
2101 boron_unlinkFibre((BoronThread*) evalThread, (BoronThread*) cur);
2102 thread_writeFibreResult(cur);
2105 if (BT->timeout || BT->waitPorts)
2110 boron_startFibre(ut, blkN, res);
2111 return (boron_runFibre(ut) == BOR_FIBRE_EXCEPTION) ?
UR_THROW :
UR_OK;
2133 len = strlen(script);
2136 res = ur_stackTop(ut);
2137 bufN =
ur_tokenize(ut, script, script + len, res);
2144 if (! boron_evalBlock(ut, bufN, res))
The Boron programmer interface.
int boron_reframeDoBlock(UThread *, UIndex blkN, UCell *res, int flags)
Reuse the current CFUNC call frame for a EOP_DO_BLOCK operation.
Definition eval.c:964
UCell * boron_evalUtf8(UThread *, const char *script, int len)
Run script and put result in the last stack cell.
Definition eval.c:2127
#define CFUNC(name)
Macro to define C functions.
Definition boron.h:57
void boron_bindDefault(UThread *, UIndex blkN)
Bind block in thread dataStore to default contexts.
Definition eval.c:2042
UStatus boron_badArg(UThread *, UIndex atom, int argN)
Throw a standardized error for an unexpected function argument.
Definition eval.c:696
UIndex boron_evalRecurse(UThread *, UCell *res)
Begin a section where boron_evalBlock() can be recursively called.
Definition eval.c:762
void boron_evalSetTop(UThread *, UIndex top)
Reset evaluator operation stack position.
Definition eval.c:782
void boron_reset(UThread *)
Reset thread after exception.
Definition boron.c:222
void ur_binReserve(UBuffer *, int size)
Allocates enough memory to hold size bytes.
Definition binary.c:138
UCell * ur_blkAppendNew(UBuffer *, int type)
Add cell to end of block.
Definition block.c:109
UIndex ur_makeBlock(UThread *, int size)
Generate a single block of type UT_BLOCK.
Definition block.c:57
void ur_ctxFree(UBuffer *)
Free context data.
Definition context.c:316
int ur_ctxLookup(const UBuffer *, UAtom atom)
Find word in context by atom.
Definition context.c:579
#define ur_ctxCell(c, n)
Get pointer of UCell in context by index.
Definition urlan.h:668
UBuffer * ur_ctxSort(UBuffer *)
Sort the internal context search table so ur_ctxLookup() is faster.
Definition context.c:510
int ur_ctxAppendWord(UBuffer *, UAtom atom)
Append word to context.
Definition context.c:390
void ur_bindCopy(UThread *, const UBuffer *ctx, UCell *it, UCell *end)
Recursively bind blocks to the bindings found in a context.
Definition context.c:732
void ur_ctxInit(UBuffer *, int size)
Initialize context buffer.
Definition context.c:299
UStatus ur_setPath(UThread *, const UCell *path, const UCell *src)
Set path.
Definition path.c:361
int ur_pathResolve(UThread *, UBlockIt *pi, UCell *tmp, UCell **lastCell)
Get a pointer to the last value that a path! refers to.
Definition path.c:137
const UCell * ur_pathSelect(UThread *ut, const UCell *selC, UCell *tmp, UCell **expand)
Get a pointer to the last value that a select path! cell refers to.
Definition path.c:235
#define ur_strFree
A string is a simple array.
Definition urlan.h:629
void ur_strAppendChar(UBuffer *, int)
Append a single UCS2 character to a string.
Definition string.c:611
void ur_strTermNull(UBuffer *)
Terminate with null character so buffer can be used as a C string.
Definition string.c:1049
void ur_strAppendInt(UBuffer *, int32_t)
Append an integer to a string.
Definition string.c:706
void ur_strInit(UBuffer *, int enc, int size)
Initialize buffer to type UT_STRING.
Definition string.c:430
void ur_strAppendCStr(UBuffer *, const char *)
Append a null-terminated UTF-8 string to a string buffer.
Definition string.c:641
void ur_seriesSlice(const UThread *, USeriesIter *si, const UCell *cell)
Set USeriesIter to series slice.
Definition env.c:1338
#define ur_bufferSer(c)
Convenience macro for ur_bufferSeries().
Definition urlan.h:752
#define ur_setId(c, t)
Set type and initialize the other 24 bits of UCellId to zero.
Definition urlan.h:701
@ UT_TYPEMASK
Used in UCellDatatype to declare a multi-type datatype!.
Definition urlan.h:73
const char * ur_atomCStr(UThread *, UAtom atom)
Get name of atom.
Definition atoms.c:47
const UBuffer * ur_bufferEnv(UThread *, UIndex n)
Get buffer from either the thread dataStore or environment sharedStore.
Definition env.c:1258
UIndex ur_tokenize(UThread *, const char *it, const char *end, UCell *res)
Convert a UTF-8 data string into a block.
Definition tokenize.c:1197
UIndex it
Start position.
Definition urlan.h:338
UStatus ur_error(UThread *, int errorType, const char *fmt,...)
Create error! exception.
Definition env.c:964
UCell * ur_push(UThread *, int type)
Set id of cell on top of stack and increment stack.used.
Definition env.c:906
const UCell * ur_wordCell(UThread *, const UCell *cell)
Get word value for read-only operations.
Definition env.c:1132
UBuffer * ur_envContext(UThread *)
Get shared global context.
Definition env.c:945
const UCell * end
End position.
Definition urlan.h:388
UStatus ur_setWord(UThread *, const UCell *wordCell, const UCell *src)
Set word.
Definition env.c:1225
void ur_toText(UThread *, const UCell *cell, UBuffer *str)
Append textual representation of cell to a string.
Definition env.c:1118
#define ur_pop(ut)
Decrement stack.used.
Definition urlan.h:747
UIndex end
End position.
Definition urlan.h:339
const UCell * it
Start position.
Definition urlan.h:387
UBuffer * ur_threadContext(UThread *)
Get thread global context.
Definition env.c:934
@ UR_THROW
Returned to indicate an evaluation exception occured.
Definition urlan.h:117
@ UR_OK
Returned to indicate successful evaluation/operation.
Definition urlan.h:118
#define ur_foreach(bi)
Loop over all members of an iterator struct.
Definition urlan.h:760
int ur_destroyThread(UThread *)
Free memory used by UThread.
Definition env.c:214
const UBuffer * ur_blockIt(const UThread *ut, UBlockIt *bi, const UCell *blkCell)
Set UBlockIt to the start and end of a block slice.
Definition env.c:1388
const UBuffer * buf
Buffer pointer.
Definition urlan.h:337
#define ur_isShared(n)
True if buffer number refers to a buffer in the shared environment.
Definition urlan.h:726
#define ur_buffer(n)
Macro to get buffer known to be in thread dataStore.
Definition urlan.h:750
#define ur_type(c)
Return UrlanDataType of cell.
Definition urlan.h:695
UCell * ur_pushCell(UThread *, const UCell *)
Copy cell to top of stack and increment stack.used.
Definition env.c:920
Iterator for const UCell array.
Definition urlan.h:386
The UBuffer struct holds information about a resource, usually a chunk of memory.
Definition urlan.h:266
uint8_t * b
bytes
Definition urlan.h:277
int32_t * i32
int32_t
Definition urlan.h:281
char * c
chars
Definition urlan.h:276
uint32_t * u32
uint32_t
Definition urlan.h:282
UIndex used
This typically holds the number of elements in the buffer.
Definition urlan.h:271
UCell * cell
Array of cells.
Definition urlan.h:275
union UBuffer::@312146223224040072236377336057316010374162171270 ptr
This typically holds a pointer to a chunk of memory.
uint32_t mask0
Low 32 bits of type mask.
Definition urlan.h:169
uint32_t mask1
Middle 32 bits of type mask.
Definition urlan.h:170
uint8_t type
UrlanDataType.
Definition urlan.h:156
UIndex buf
Buffer id.
Definition urlan.h:228
UIndex it
Iterator index.
Definition urlan.h:229
uint16_t index
Normally the word index into a context.
Definition urlan.h:218
UAtom atom
The name of the word.
Definition urlan.h:219
UIndex ctx
Normally the buffer id of a context.
Definition urlan.h:217
The UDatatype struct holds methods for a specific class of data.
Definition urlan.h:439
Iterator for const series of any type.
Definition urlan.h:336
The UThread struct stores the data specific to a thread of execution.
Definition urlan.h:309
A cell holds a single value of a simple type or a reference (often to a UBuffer) for a complex type.
Definition urlan.h:248
UCellWord word
For word!, lit-word!, set-word!, get-word! types.
Definition urlan.h:251
UCellSeries series
For binary!, bitset!, string!, file!, block!, paren!, path! types.
Definition urlan.h:255
UCellId id
Basic type identification.
Definition urlan.h:249
UCellDatatype datatype
For datatype! type.
Definition urlan.h:250
void ur_arrAppendInt32(UBuffer *, int32_t)
Append int32_t to array.
Definition array.c:180
#define ur_avail(buf)
Returns the capacity of a UBuffer that is known to have been allocated.
Definition urlan.h:687
UStatus
Definition urlan.h:116
#define ur_datatype(c)
Access the UrlanDataType that a UCellDatatype represents.
Definition urlan.h:711
@ UR_ERR_SCRIPT
General script evaluation error.
Definition urlan.h:126
@ UR_ERR_INTERNAL
Fatal internal problem.
Definition urlan.h:129
@ UR_ERR_TYPE
Invalid argument/parameter datatype.
Definition urlan.h:125
void ur_arrFree(UBuffer *)
Free array data.
Definition array.c:79
void ur_arrInit(UBuffer *, int size, int count)
Initialize array buffer.
Definition array.c:47
@ UR_BIND_THREAD
Bound to buffer in thread dataStore.
Definition urlan.h:88
@ UR_BIND_USER
Start of user defined bindings.
Definition urlan.h:93
@ UR_BIND_ENV
Bound to buffer in shared env dataStore.
Definition urlan.h:89
int32_t UIndex
This is an index into an array.
Definition urlan.h:150
void ur_arrReserve(UBuffer *, int count)
Allocates enough memory to hold count elements.
Definition array.c:98