Boron 2.1.0
eval.c
1/*
2 Boron Evaluator
3 Copyright 2016-2019,2023-2025 Karl Robillard
4*/
5
6
7#include <assert.h>
8#include <string.h>
9#include "boron.h"
10#include "i_parse_blk.c"
11#include "mem_util.h"
12
13//#define REPORT_EVAL
14
15
32
33
34#define UT(ptr) ((UThread*) ptr)
35#define PTR_I (void*)(intptr_t)
36#define cp_error (void*)(intptr_t) ur_error
37
38
39enum FuncArgumentOpcodes
40{
41 // Instruction Data Description
42 // -------------------------------------------------------------------
43 FO_clearLocal, // n Set locals on stack to UT_NONE.
44 FO_fetchArg, // Push _eval1 result onto stack.
45 FO_litArg, // Push UCell at current pc onto stack.
46 FO_checkType, // t Check last argument type.
47 FO_checkTypeMask, // w u16 .. Check last argument type mask.
48 FO_optionRecord, // Push options record cell.
49 FO_variant, // n Push variant int! onto stack.
50 FO_end // End function program.
51};
52
53// 16-bit alignment pad.
54#define CHECK_TYPE_PAD 0x10
55
56
57enum ArgRuleId
58{
59 AR_WORD, AR_TYPE, AR_LITW, AR_OPT, AR_LOCAL, AR_VARIANT
60};
61
62
63#define BAR 1 // compileAtoms[1] "|"
64#define LOCAL 2 // compileAtoms[2] "local"
65#define EXTERN 3 // compileAtoms[3] "extern"
66#define NOTRACE 4 // compileAtoms[4] "no-trace"
67
68// _argRules offsets
69#define LWORD 46
70#define LOCAL_OPT LWORD+8
71#define FIND_LOCAL LWORD+16
72
73static const uint8_t _argRules[ 76 ] =
74{
75 PB_SomeR, 3, PB_End,
76
77 PB_Next, 6,
78 PB_Rule, LOCAL_OPT, PB_AnyTs, LWORD, PB_ReportEnd, AR_LOCAL,
79
80 PB_Next, 4,
81 PB_Type, UT_WORD, PB_ReportEnd, AR_WORD,
82
83 PB_Next, 4,
84 PB_Type, UT_DATATYPE, PB_ReportEnd, AR_TYPE,
85
86 PB_Next, 4,
87 PB_Type, UT_LITWORD, PB_ReportEnd, AR_LITW,
88
89 PB_Next, 6,
90 PB_Type, UT_OPTION, PB_AnyTs, LWORD, PB_ReportEnd, AR_OPT,
91
92 PB_Next, 4,
93 PB_Type, UT_INT, PB_ReportEnd, AR_VARIANT,
94
95 PB_Type, UT_STRING, PB_End, // Ignore comment string!
96
97 // LWORD word!/lit-word!/set-word! (set-word! only needed by funct)
98 0x00,0xE0,0x00,0x00,0x00,0x00,0x00,0x00,
99
100 // LOCAL_OPT
101 PB_Next, 3,
102 PB_LitWord, BAR, PB_End,
103 PB_LitWord, LOCAL, PB_End,
104
105 // FIND_LOCAL
106 PB_Next, 3,
107 PB_ToLitWord, BAR, PB_End,
108 PB_ToLitWord, LOCAL, PB_End
109};
110
111
112typedef struct
113{
114 UIndex atom;
115 uint8_t optionIndex;
116 uint8_t argCount;
117 uint8_t programOffset;
118 uint8_t _pad;
119}
120OptionEntry;
121
122
123typedef struct
124{
125 uint16_t progOffset;
126 uint8_t funcFlags;
127 uint8_t optionCount;
128 OptionEntry opt[ 1 ];
129}
130ArgProgHeader;
131
132
133#define OPTION_FLAGS id.ext
134#define MAX_OPTIONS 8
135
136typedef struct
137{
138 UBlockParser bp;
139 UBuffer sval; // Context of stack value bindings.
140 UBuffer localWords; // Array of atoms.
141 UBuffer externWords; // Array of atoms.
142 UBuffer* bin;
143 UIndex stackMapN;
144 int origUsed;
145 int argEndPc;
146 int funcArgCount;
147 int optionCount;
148 OptionEntry opt[ MAX_OPTIONS ];
149}
150ArgCompiler;
151
152
153int boron_copyWordValue( UThread* ut, const UCell* wordC, UCell* res )
154{
155 const UCell* cell;
156 if( ! (cell = ur_wordCell( ut, wordC )) )
157 return UR_THROW;
158 *res = *cell;
159 return UR_OK;
160}
161
162
163static void _defineArg( UBuffer* ctx, int binding, UIndex stackMapN,
164 UIndex atom, UIndex index, int16_t optArgN )
165{
166 UCell* cell;
167 ur_ctxAppendWord( ctx, atom );
168 cell = ctx->ptr.cell + ctx->used - 1;
169 ur_setId( cell, UT_WORD );
170 ur_binding(cell) = binding;
171 cell->word.ctx = stackMapN;
172 cell->word.atom = atom;
173 cell->word.index = index;
174 cell->word.sel[1] = optArgN;
175}
176
177
178#define EMIT(op) prog->ptr.b[ prog->used++ ] = op
179
180static void _argRuleHandler( UBlockParser* par, int rule,
181 const UCell* it, const UCell* end )
182{
183 ArgCompiler* ap = (ArgCompiler*) par;
184 UBuffer* prog = ap->bin;
185 int op;
186
187 // TODO: Ensure all words in spec. are unique.
188
189 //printf( "KR arg rule %d (used %d)\n", rule, prog->used );
190 switch( rule )
191 {
192 case AR_WORD:
193 if( it->word.atom < UT_MAX )
194 {
195 EMIT( FO_checkType );
196 EMIT( it->word.atom );
197 break;
198 }
199 op = FO_fetchArg;
200 goto emit_arg;
201
202 case AR_TYPE:
203 if( ur_datatype(it) == UT_TYPEMASK )
204 {
205 UIndex wpos;
206 int which = 0;
207 int wbit;
208 int64_t mask = (((int64_t) it->datatype.mask1) << 32) |
209 it->datatype.mask0;
210
211 // Type masks are not part of estimatedSize so they need
212 // a dedicated reserve.
213 ur_binReserve( prog, prog->used + 12 );
214
215 EMIT( FO_checkTypeMask );
216 wpos = prog->used;
217 EMIT( 0 );
218 if( prog->used & 1 )
219 {
220 which |= CHECK_TYPE_PAD;
221 EMIT( 0 );
222 }
223
224 for( wbit = 1; wbit <= 4; wbit <<= 1 )
225 {
226 if( mask & 0xffff )
227 {
228 which |= wbit;
229 *((uint16_t*) (prog->ptr.b + prog->used)) = mask;
230 prog->used += 2;
231 }
232 mask >>= 16;
233 }
234
235 prog->ptr.b[ wpos ] = which;
236 }
237 else
238 {
239 EMIT( FO_checkType );
240 EMIT( ur_datatype(it) );
241 }
242 break;
243
244 case AR_LITW:
245 op = FO_litArg;
246emit_arg:
247 EMIT( op );
248 if( ! ap->optionCount )
249 ++ap->funcArgCount;
250 if( ap->stackMapN )
251 _defineArg( &ap->sval, BOR_BIND_FUNC, ap->stackMapN,
252 it->word.atom, ap->sval.used, 0 );
253 break;
254
255 case AR_OPT:
256 if( it->word.atom == par->atoms[ EXTERN ] )
257 {
258 for( ++it; it != end; ++it )
259 ur_arrAppendInt32( &ap->externWords, it->word.atom );
260 break;
261 }
262 else if( it->word.atom == par->atoms[ NOTRACE ] )
263 {
264 par->rflag |= FUNC_FLAG_NOTRACE;
265 break;
266 }
267
268 if( ap->optionCount < MAX_OPTIONS )
269 {
270 OptionEntry* ent;
271 int n;
272 int argCount = 0;
273
274 if( ap->stackMapN )
275 _defineArg( &ap->sval, BOR_BIND_OPTION, ap->stackMapN,
276 it->word.atom, ap->optionCount, 0 );
277
278 if( ! ap->optionCount )
279 {
280 ap->argEndPc = prog->used;
281 EMIT( FO_end ); // Terminate args.
282 EMIT( FO_end ); // Reserve space for FO_clearLocal.
283 }
284
285 ent = &ap->opt[ ap->optionCount++ ];
286 ent->atom = it->word.atom;
287 ent->optionIndex = ap->optionCount;
288 ent->programOffset = 0;
289 ent->_pad = 0;
290 ++it;
291 n = end - it;
292 if( n )
293 {
294 ent->programOffset = prog->used - ap->origUsed;
295 for( ; it != end; ++it )
296 {
297 if( it->word.atom < UT_MAX )
298 {
299 EMIT( FO_checkType );
300 EMIT( it->word.atom );
301 }
302 else
303 {
304 EMIT(ur_is(it,UT_LITWORD) ? FO_litArg:FO_fetchArg);
305 if( ap->stackMapN )
306 {
307 _defineArg( &ap->sval, BOR_BIND_OPTION_ARG,
308 ap->stackMapN, it->word.atom,
309 ap->optionCount - 1, argCount );
310 }
311 ++argCount;
312 }
313 // TODO: Handle lit-word!
314 }
315 EMIT( FO_end );
316 }
317 ent->argCount = argCount;
318 }
319 break;
320
321 case AR_LOCAL:
322 for( ++it; it != end; ++it )
323 ur_arrAppendInt32( &ap->localWords, it->word.atom );
324 break;
325
326 case AR_VARIANT:
327 EMIT( FO_variant );
328 EMIT( ur_int(it) );
329 break;
330 }
331}
332
333
334#define AUTO_LOCALS
335#ifdef AUTO_LOCALS
336static void _appendSetWords( UThread* ut, UBuffer* buf, const UCell* blkC,
337 const UBuffer* argCtx )
338{
339 UBlockIt bi;
340 ur_blockIt( ut, &bi, blkC );
341 ur_foreach( bi )
342 {
343 int type = ur_type(bi.it);
344 if( type == UT_SETWORD )
345 {
346 if( ur_ctxLookup( argCtx, ur_atom(bi.it) ) < 0 )
347 ur_arrAppendInt32( buf, bi.it->word.atom );
348 }
349 else if( type == UT_BLOCK || type == UT_PAREN )
350 _appendSetWords( ut, buf, bi.it, argCtx );
351 }
352}
353#endif
354
355
356static void _zeroDuplicateU32( UBuffer* a )
357{
358 uint32_t* it = a->ptr.u32;
359 uint32_t* end = it + a->used;
360 for( ; it != (end - 1); ++it )
361 {
362 if( find_uint32_t( it + 1, end, *it ) )
363 *it = 0;
364 }
365}
366
367
368static void _zeroDiffU32( UBuffer* a, const UBuffer* b )
369{
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 )
375 {
376 if( find_uint32_t( bIt, bEnd, *it ) )
377 *it = 0;
378 }
379}
380
381
382static void _removeValueU32( UBuffer* buf, uint32_t val )
383{
384 uint32_t* it = buf->ptr.u32;
385 uint32_t* end = it + buf->used;
386 uint32_t* out;
387
388 it = (uint32_t*) find_uint32_t( it, end, val );
389 if( ! it )
390 return;
391 for( out = it++; it != end; ++it )
392 {
393 if( *it != 0 )
394 *out++ = *it;
395 }
396 buf->used = out - buf->ptr.u32;
397}
398
399
400extern const UAtom* boron_compileAtoms( BoronThread* );
401
402/*
403 Compile function argument fetching program.
404
405 \param specC Cell of specification UT_BLOCK slice.
406 \param prog Program is appended to this UT_BINARY buffer.
407 \param bodyN Buffer index of code block or 0 for cfunc!.
408 \param sigFlags Contents set to non-zero if /no-trace used in spec. block.
409
410 The spec. block must only contain the following patterns:
411 word!/lit-word!
412 option! any word!/lit-word!
413 '| any word!
414
415 If bodyN is not zero, all argument and local words in the block will be
416 bound to it.
417
418 During evaluation the following cells can be placed on the UThread stack:
419
420 [ opt-record ][ arguments ][ locals ][ opt args ][ optN args ]
421 ^
422 a1
423
424 The stack map (or a1 CFUNC argument) points to the first argument cell.
425
426 The option record indicates which options were evaluated and holds offsets to
427 the optional agruments. This is a single cell of type UT_UNSET. Optional
428 argument values are only present on the stack if the associated option was
429 used and are ordered according to how the options occur in the invoking path!.
430*/
431void boron_compileArgProgram( BoronThread* bt, const UCell* specC,
432 UBuffer* prog, UIndex bodyN, int* sigFlags )
433{
434 UThread* ut = UT(bt);
435 ArgCompiler ac;
436 ArgProgHeader* head;
437 const int headerSize = 4;
438 int estimatedSize;
439 int localCount = 0; // Local values (no arguments).
440
441
442 ac.origUsed = prog->used;
443 ac.argEndPc = 0;
444 ac.funcArgCount = 0;
445 ac.optionCount = 0;
446 ur_blockIt( ut, (UBlockIt*) &ac.bp.it, specC );
447
448 estimatedSize = ac.bp.end - ac.bp.it;
449 estimatedSize += (estimatedSize / 2) + 2; // FO_checkType + FO_clearLocal
450 estimatedSize = (estimatedSize + 3) & ~3; // 32-bit align
451
452 ur_binReserve( prog, prog->used + headerSize + estimatedSize);
453 prog->used += headerSize; // Reserve space for start of ArgProgHeader.
454
455 //dumpBuf(ut, specC->series.buf);
456 //printf("KR compile arg %ld (est %d bytes)\n",
457 // ac.bp.end - ac.bp.it, estimatedSize);
458
459 if( ac.bp.it != ac.bp.end )
460 {
461 ac.bp.ut = ut;
462 ac.bp.atoms = boron_compileAtoms(bt);
463 ac.bp.rules = _argRules;
464 ac.bp.report = _argRuleHandler;
465 ac.bp.rflag = 0;
466 ac.bin = prog;
467 ac.stackMapN = bodyN;
468 ur_ctxInit( &ac.sval, 0 );
469 ur_arrInit( &ac.localWords, sizeof(uint32_t), 0 );
470 ur_arrInit( &ac.externWords, sizeof(uint32_t), 0 );
471
472 {
473 const UCell* start = ac.bp.it;
474 const UCell* end = ac.bp.end;
475 const UCell* local;
476 if( ur_parseBlockI( &ac.bp, _argRules + FIND_LOCAL, start ) )
477 local = ac.bp.end = ac.bp.it;
478 else
479 local = NULL;
480 ac.bp.it = start;
481 ur_parseBlockI( &ac.bp, ac.bp.rules, start );
482 if( local )
483 {
484 ac.bp.it = local;
485 ac.bp.end = end;
486 ur_parseBlockI( &ac.bp, ac.bp.rules, local );
487 }
488 }
489
490 if( bodyN )
491 {
492#ifdef AUTO_LOCALS
493 UCell tmp;
494 ur_initSeries( &tmp, UT_BLOCK, bodyN );
495 _appendSetWords( ut, &ac.localWords, &tmp, &ac.sval );
496#endif
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 );
502
503 if( ac.localWords.used )
504 {
505 const UIndex* ai = ac.localWords.ptr.i32;
506 const UIndex* ae = ai + ac.localWords.used;
507 int localIndex = ac.funcArgCount;
508
509 while( ai != ae )
510 {
511 //printf( "KR local %d %s\n", localIndex,
512 // ur_atomCStr(ut, *ai) );
513 _defineArg( &ac.sval, BOR_BIND_FUNC, bodyN,
514 *ai++, localIndex++, 0 );
515 }
516 localCount = ac.localWords.used;
517 }
518
519 if( ac.sval.used )
520 {
521 const UBuffer* body = ur_bufferEnv(ut, bodyN);
522 // ur_bindCopy uses UR_BIND_USER+2.
523 assert(BOR_BIND_OPTION_ARG == UR_BIND_USER+2);
524
525 ur_ctxSort( &ac.sval );
526 ur_bindCopy( ut, &ac.sval,
527 body->ptr.cell, body->ptr.cell + body->used );
528 }
529 }
530 ur_ctxFree( &ac.sval );
531 ur_arrFree( &ac.localWords );
532 ur_arrFree( &ac.externWords );
533
534 // Insert OptionEntry table & FO_optionRecord.
535 if( ac.optionCount )
536 {
537 OptionEntry* ent;
538 OptionEntry* ee;
539 const int optRecSize = 1;
540 int tsize = ac.optionCount * sizeof(OptionEntry) + optRecSize;
541 int newUsed = prog->used + tsize;
542
543 ur_binReserve( prog, newUsed + 3 ); // +3 for alignment pad.
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;
550
551 for( ; ent != ee; ++ent )
552 {
553 if( ent->programOffset )
554 ent->programOffset += tsize;
555 }
556
557 *((uint8_t*) ent) = FO_optionRecord;
558
559 if( localCount )
560 {
561 uint8_t* endArg = prog->ptr.b + ac.argEndPc + tsize;
562 *endArg++ = FO_clearLocal;
563 *endArg = localCount;
564 }
565 }
566
567 *sigFlags = ac.bp.rflag;
568 }
569 else
570 {
571 *sigFlags = 0;
572 }
573
574 if( ! ac.optionCount )
575 {
576 if( localCount )
577 {
578 EMIT( FO_clearLocal );
579 EMIT( localCount );
580 }
581 else
582 EMIT( FO_end );
583 }
584
585 // Pad to 32-bit align OptionEntry table when programs are concatenated.
586 while( prog->used & 3 )
587 EMIT( FO_end );
588
589
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;
594
595 if (bodyN && (ac.optionCount || ac.funcArgCount || localCount))
596 head->funcFlags |= FUNC_FLAG_NEEDSTACK;
597}
598
599
600#if 0
601extern void datatype_toString(UThread*, const UCell*, UBuffer* str, int depth);
602
603void boron_argProgramToStr( UThread* ut, const void* prog, UBuffer* str )
604{
605 ArgProgHeader* head = (ArgProgHeader*) prog;
606 const uint8_t* pc = ((const uint8_t*) head) + head->progOffset;
607 int op;
608 int start = 1;
609
610 if (head->optionCount) {
611 ur_strAppendInt(str, head->optionCount);
612 ur_strAppendChar(str, ' ');
613 }
614
615 ur_strAppendChar( str, '[' );
616 while( (op = *pc++) < FO_end )
617 {
618 if (start)
619 start = 0;
620 else
621 ur_strAppendChar(str, ' ');
622
623 switch( op )
624 {
625 case FO_clearLocal:
626 op = *pc++;
627 ur_strAppendChar( str, 'L' );
628 ur_strAppendChar( str, op+'0' );
629 break;
630
631 case FO_fetchArg:
632 ur_strAppendChar( str, 'a' );
633 break;
634
635 case FO_litArg:
636 ur_strAppendCStr( str, "'a" );
637 break;
638
639 case FO_checkType:
640 op = *pc++;
641 ur_strAppendCStr( str, ur_atomCStr(ut, op) );
642 break;
643
644 case FO_checkTypeMask:
645 {
646 UCell dt;
647 int64_t mask = 0;
648 int which = *pc++;
649 if( which & CHECK_TYPE_PAD )
650 ++pc;
651 if( which & 1 )
652 {
653 mask |= *((uint16_t*) pc);
654 pc += 2;
655 }
656 if( which & 2 )
657 {
658 mask |= ((int64_t) *((uint16_t*) pc)) << 16;
659 pc += 2;
660 }
661 if( which & 4 )
662 {
663 mask |= ((int64_t) *((uint16_t*) pc)) << 32;
664 pc += 2;
665 }
666 ur_setId(&dt, UT_DATATYPE);
668 dt.datatype.mask0 = mask;
669 dt.datatype.mask1 = mask >> 32;
670 datatype_toString( ut, &dt, str, 0 );
671 }
672 break;
673
674 case FO_optionRecord:
675 ur_strAppendChar( str, 'R' );
676 break;
677
678 case FO_variant:
679 ur_strAppendInt( str, *pc++ );
680 break;
681 }
682 }
683 ur_strAppendChar( str, ']' );
684}
685#endif
686
687
696UStatus boron_badArg( UThread* ut, UIndex atom, int argN )
697{
698 return ur_error( ut, UR_ERR_TYPE, "Unexpected %s for argument %d",
699 ur_atomCStr(ut, atom), argN + 1 );
700}
701
702
703/*
704 Reuse the top EvalFrame (which must be EOP_CALL_CFUNC).
705
706 \param extraFrames Number of extra frames to use.
707 \param keepStack Store the UThread stack.used level from before the call.
708 If NULL then stack.used is immediately reset to its
709 pre-call level.
710
711 \return First uninitialized frame.
712*/
713EvalFrame* boron_reuseFrame(UThread* ut, int extraFrames, int* keepStack)
714{
715 UBuffer* buf = &BT->evalOp;
716 EvalFrame* ef = ur_ptr(EvalFrame, buf) + buf->used - 1;
717 assert(ef->block.eop == EOP_CALL_CFUNC);
718
719 if (keepStack)
720 *keepStack = ef->call.origStack;
721 else
722 ut->stack.used = ef->call.origStack;
723
724 if (ef[-1].block.eop == EOP_OPTION_IT)
725 {
726 --buf->used;
727 --ef;
728 }
729
730 if (extraFrames)
731 {
732 buf->used += extraFrames;
733 if (buf->used > ur_avail(buf))
734 {
735 ur_error(ut, UR_ERR_INTERNAL, "EvalFrame overflow");
736 return NULL;
737 }
738 }
739 return ef;
740}
741
742
743void boron_initEvalCatch(EvalFrame* ef,
744 UStatus (*handler)(UThread*, EvalFrame*),
745 int origStack, UCell* result)
746{
747 ef->invoke.eop = EOP_CATCH;
748 ef->invoke.state = 1; // opCount
749 ef->invoke.origStack = origStack;
750 ef->invoke.dat.catchf = handler;
751 ef->invoke.result = result;
752}
753
754
763{
764 UIndex top = BT->evalOp.used;
765 EvalFrame* ef = boron_pushEvalFrame(ut);
766 if (ef) {
767 ef->invoke.eop = EOP_RUN_RECURSE;
768 ef->invoke.state = 1; // opCount
769 ef->invoke.origStack = ut->stack.used;
770 ef->invoke.dat.catchf = NULL;
771 ef->invoke.result = result;
772 }
773 return top;
774}
775
776
783{
784 BT->evalOp.used = top;
785}
786
787
788void boron_initEvalBlock(EvalFrame* ef, UThread* ut, UIndex blkN, UCell* result)
789{
790 const UBuffer* buf = ur_bufferEnv(ut, blkN);
791
792 ef->block.eop = EOP_DO_BLOCK;
793 ef->block.funcFlags = 0;
794 ef->block.origStack = ut->stack.used;
795 ef->block.codeBlk = blkN;
796 ef->block.it = buf->ptr.cell;
797 ef->block.end = buf->ptr.cell + buf->used;
798 ef->block.result = result;
799}
800
801
802EvalFrame* boron_pushEvalFrame(UThread* ut)
803{
804 UBuffer* buf = &BT->evalOp;
805 if (buf->used < ur_avail(buf))
806 {
807 EvalFrame* ef = ur_ptr(EvalFrame, buf) + buf->used;
808 ++buf->used;
809 return ef;
810 }
811 return NULL;
812}
813
814
815int boron_resetEvalFrame(UThread* ut, const EvalFrame* end)
816{
817 UBuffer* buf = &BT->evalOp;
818 buf->used = end - ur_ptr(EvalFrame, buf);
819 return CFUNC_REFRAMED;
820}
821
822
823EvalFrame* boron_findEvalFrame(UThread* ut, int op)
824{
825 UBuffer* buf = &BT->evalOp;
826 EvalFrame* start = ur_ptr(EvalFrame, buf);
827 EvalFrame* ef = start + buf->used - 1;
828 for (; ef != start; --ef)
829 {
830 if (ef->block.eop == op)
831 return ef;
832 }
833 return NULL;
834}
835
836
837/*
838 Reuse the top EvalFrame (which must be EOP_CALL_CFUNC) and reset the
839 UThread stack.used to its level before the call.
840*/
841static EvalFrame* _reuseFrame(BoronThread* bt, int eop)
842{
843 UBuffer* buf = &bt->evalOp;
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;
847
848 if (ef[-1].block.eop == EOP_OPTION_IT)
849 {
850 --buf->used;
851 --ef;
852 }
853 ef->block.eop = eop;
854 return ef;
855}
856
857
858static EvalFrame* _pushEvalFrame(BoronThread* bt, int eop)
859{
860 UBuffer* buf = &bt->evalOp;
861 if (buf->used < ur_avail(buf))
862 {
863 EvalFrame* ef = ur_ptr(EvalFrame, buf) + buf->used;
864 ++buf->used;
865 ef->block.eop = eop;
866 return ef;
867 }
868 return NULL;
869}
870
871
872static void _initEvalBlock( EvalFrame* ef, UThread* ut, UIndex blkN,
873 int stackPad, UCell* result )
874{
875 const UBuffer* buf = ur_bufferEnv(ut, blkN);
876 ef->block.funcFlags = 0;
877 ef->block.origStack = ut->stack.used - stackPad;
878 ef->block.codeBlk = blkN;
879 ef->block.it = buf->ptr.cell;
880 ef->block.end = buf->ptr.cell + buf->used;
881 ef->block.result = result;
882}
883
884
885static void _initEvalReduce( EvalFrame* ef, UThread* ut, const UCell* blkC,
886 UIndex resBlkN )
887{
888 ef->reduce.origStack = ut->stack.used;
889 ef->reduce.codeBlk = blkC->series.buf;
890 ur_blockIt(ut, (UBlockIt*) &ef->reduce.it, blkC);
891 ef->reduce.resBlk = resBlkN;
892}
893
894
895#define CALL_TRACE_NA -1
896#define CALL_TRACE_SKIP -2
897
898// EOP_CALL_CFUNC
899static void _initEvalCallC( EvalFrame* ef, UThread* ut, const UCell* cfunc,
900 int origStack, UCell* result )
901{
902 EvalFrame* pf;
903 const UBuffer* blk;
904 const ArgProgHeader* head = (const ArgProgHeader*)
905 (ur_bufferSer(cfunc)->ptr.b +
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;
913
914 pf = ef - 1;
915 if (pf->block.eop == EOP_OPTION_IT)
916 {
917 pf->block.result = (UCell*) head;
918 --pf;
919 }
920
921 if (ur_flags(cfunc, FUNC_FLAG_NOTRACE))
922 ef->call.tracePos = CALL_TRACE_SKIP;
923 else
924 {
925 while ((1<<pf->block.eop & MASK_EOP_DO) == 0)
926 --pf;
927 blk = ur_bufferEnv(ut, pf->block.codeBlk);
928 ef->call.tracePos = pf->block.it - blk->ptr.cell;
929 }
930}
931
932
933// EOP_CALL_FUNC
934static void _initEvalCallF( EvalFrame* ef, UThread* ut, const UCell* func,
935 int origStack, UCell* result )
936{
937 const UBuffer* blk = ur_bufferSer(func);
938 const ArgProgHeader* head = (const ArgProgHeader*)
939 ur_bufferSer(blk->ptr.cell)->ptr.v;
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;
947
948 if (ef[-1].block.eop == EOP_OPTION_IT)
949 ef[-1].block.result = (UCell*) head;
950}
951
952
964int boron_reframeDoBlock( UThread* ut, UIndex blkN, UCell* res, int flags )
965{
966 int pad = 0;
967 EvalFrame* ef = _reuseFrame(BT, EOP_DO_BLOCK);
968#if 0
969 pad = ur_isShared(blkN) ? 0 : 1;
970 if (pad)
971 ur_pushCell(ut, blkC); // Hold code block.
972#endif
973 if (! res) {
974 res = ur_push(ut, UT_UNSET);
975 pad = 1;
976 }
977 _initEvalBlock(ef, ut, blkN, pad, res);
978 ef->block.funcFlags = flags;
979 return CFUNC_REFRAMED;
980}
981
982
995int boron_reframeDoBlock1(UThread* ut, UIndex blkN,
996 UStatus (*valueFunc)(UThread*, EvalFrameInvoke*),
997 UCell* res)
998{
999 int origStack;
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;
1007
1008 ++ef;
1009 ef->block.eop = EOP_DO_BLOCK1;
1010 _initEvalBlock(ef, ut, blkN, 0, res);
1011 return CFUNC_REFRAMED;
1012}
1013
1014
1015int boron_breakDoBlock1(UThread* ut, EvalFrameInvoke* ef)
1016{
1017 UBuffer* evalOp = &BT->evalOp;
1018 ut->stack.used = ef->origStack;
1019 evalOp->used -= 2;
1020 return CFUNC_REFRAMED;
1021}
1022
1023
1033EvalFrame* boron_reframeReduce(UThread* ut, const UCell* blkC, UCell* res,
1034 UStatus (*complete)(UThread*, EvalFrameInvoke*))
1035{
1036 int origStack;
1037 EvalFrame* ef;
1038 UIndex blkN = ur_makeBlock(ut, 0);
1039 ur_initSeries(res, UT_BLOCK, blkN);
1040
1041 ef = boron_reuseFrame(ut, 1, &origStack);
1042 ef->invoke.eop = EOP_INVOKE;
1043 //ef->invoke.state
1044 ef->invoke.origStack = origStack;
1045 ef->invoke.userBuf = blkN;
1046 ef->invoke.func = complete;
1047 //ef->invoke.dat
1048 ef->invoke.result = res;
1049
1050 ++ef;
1051 ef->invoke.eop = EOP_REDUCE;
1052 _initEvalReduce(ef, ut, blkC, blkN);
1053 return ef - 1;
1054}
1055
1056
1057/*
1058 Push EOP_DO_BLOCK EvalFrame onto evalOp stack.
1059*/
1060void boron_startFibre( UThread* ut, UIndex blkN, UCell* res )
1061{
1062 EvalFrame* ef = _pushEvalFrame(BT, EOP_DO_BLOCK);
1063 assert(ef);
1064 _initEvalBlock(ef, ut, blkN, 0, res);
1065}
1066
1067
1068/*
1069void boron_endFibre( UThread* ut )
1070{
1071 (void) ut;
1072}
1073*/
1074
1075
1076#ifdef REPORT_EVAL
1077#define REPORT(msg,...) printf(msg,__VA_ARGS__)
1078#else
1079#define REPORT(msg,...)
1080#endif
1081
1082int ur_pathResolve( UThread*, UBlockIt* pi, UCell* tmp, UCell** lastCell );
1083const UCell* ur_pathSelect( UThread* ut, const UCell* selC, UCell* tmp,
1084 UCell** expand );
1085
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)) ) \
1092 return NULL;
1093
1094const UCell* boron_eval1F(UThread* ut, const UCell* it, const UCell* end,
1095 UCell* res)
1096{
1097 EvalFrame* ef;
1098 const UCell* cell;
1099 int origStack;
1100
1101eval_again:
1102 switch( ur_type(it) )
1103 {
1104 case UT_WORD:
1105 INLINE_WORDVAL(it)
1106 ++it;
1107 if( ur_is(cell, UT_CFUNC) )
1108 {
1109 REPORT("%s cfunc!\n", ur_wordCStr(it-1));
1110 goto begin_cfunc;
1111 }
1112 if( ur_is(cell, UT_FUNC) )
1113 {
1114 REPORT("%s func!\n", ur_wordCStr(it-1));
1115 goto begin_func;
1116 }
1117 if( ur_is(cell, UT_UNSET) )
1118 return cp_error(ut, UR_ERR_SCRIPT, "Unset word '%s",
1119 ur_atomCStr(ut, it[-1].word.atom));
1120 *res = *cell;
1121 return it;
1122
1123 case UT_LITWORD:
1124 *res = *it++;
1125 ur_type(res) = UT_WORD;
1126 return it;
1127
1128 case UT_SETWORD:
1129 case UT_SETPATH:
1130 ef = _pushEvalFrame(BT, EOP_SET);
1131 if (! ef)
1132 goto overflow;
1133 ef->set.result = res;
1134 ef->set.it = it;
1135 ++it;
1136 while (it != end &&
1137 (ur_is(it, UT_SETWORD) || ur_is(it, UT_SETPATH)))
1138 ++it;
1139 ef->set.end = it;
1140 if (it == end)
1141 return cp_error(ut, UR_ERR_SCRIPT, "End of block");
1142 goto eval_again;
1143
1144 case UT_GETWORD:
1145 INLINE_WORDVAL(it)
1146 *res = *cell;
1147 return ++it;
1148
1149 case UT_PAREN:
1150 ef = _pushEvalFrame(BT, EOP_DO_BLOCK);
1151 if (! ef)
1152 goto overflow;
1153 _initEvalBlock(ef, ut, it->series.buf, 0, res);
1154 return ++it;
1155
1156 case UT_PATH:
1157 {
1158 UBlockIt path;
1159 const UCell* last;
1160 int headType;
1161
1162 if( it->word.selType )
1163 {
1164 UBuffer* stack = &ut->stack;
1165 path.it = path.end = stack->ptr.cell + stack->used;
1166 last = ur_pathSelect(ut, it++, res, (UCell**) &path.end);
1167 if( ! last )
1168 return NULL;
1169 if( ur_is(last, UT_CFUNC) || ur_is(last, UT_FUNC) ) {
1170 // Keep expanded path on the stack for option! iteration.
1171 origStack = path.it - stack->ptr.cell;
1172 stack->used = path.end - stack->ptr.cell;
1173 goto path_call;
1174 }
1175 }
1176 else
1177 {
1178 ur_blockIt( ut, &path, it++ );
1179 headType = ur_pathResolve( ut, &path, res, (UCell**) &last );
1180 if( headType == UR_THROW )
1181 return NULL; //goto traceError;
1182 if( headType == UT_WORD )
1183 {
1184 origStack = ut->stack.used;
1185path_call:
1186 if( ur_is(last, UT_CFUNC) )
1187 {
1188 ef = _pushEvalFrame(BT, EOP_OPTION_IT);
1189 ef->block.it = path.it;
1190 ef->block.end = path.end;
1191 cell = last;
1192 goto begin_cfunc_p;
1193 }
1194 else if( ur_is(last, UT_FUNC) )
1195 {
1196 cell = last;
1197 if (cell->series.it == 0) // No arguments (does).
1198 goto begin_does;
1199
1200 ef = _pushEvalFrame(BT, EOP_OPTION_IT);
1201 ef->block.it = path.it;
1202 ef->block.end = path.end;
1203 goto begin_func_p;
1204 }
1205 }
1206 }
1207 if( res != last )
1208 *res = *last;
1209 }
1210 return it;
1211
1212 case UT_LITPATH:
1213 *res = *it++;
1214 ur_type(res) = UT_PATH;
1215 return it;
1216
1217 case UT_CFUNC:
1218 cell = it;
1219 ++it;
1220begin_cfunc:
1221 origStack = ut->stack.used;
1222begin_cfunc_p:
1223 if (origStack > BT->stackLimit)
1224 goto stack_overflow;
1225 ef = boron_pushEvalFrame(ut);
1226 if (! ef)
1227 goto overflow;
1228 _initEvalCallC(ef, ut, cell, origStack, res);
1229 return it;
1230
1231 case UT_FUNC:
1232 cell = it;
1233 ++it;
1234begin_func:
1235 origStack = ut->stack.used;
1236begin_func_p:
1237 if (cell->series.it == 0) // No arguments (does).
1238 {
1239begin_does:
1240 ef = _pushEvalFrame(BT, EOP_FUNC_BODY);
1241 if (! ef)
1242 goto overflow;
1243 _initEvalBlock(ef, ut, cell->series.buf, 0, res);
1244 }
1245 else
1246 {
1247 if (origStack > BT->stackLimit)
1248 goto stack_overflow;
1249 ef = boron_pushEvalFrame(ut);
1250 if (! ef)
1251 goto overflow;
1252 _initEvalCallF(ef, ut, cell, origStack, res);
1253 }
1254 return it;
1255 }
1256
1257 *res = *it;
1258 return ++it;
1259
1260overflow:
1261 ur_error(ut, UR_ERR_INTERNAL, "EvalFrame overflow");
1262 return NULL;
1263
1264stack_overflow:
1265 ur_error(ut, UR_ERR_SCRIPT, "Stack overflow");
1266 return NULL;
1267}
1268
1269
1270static int64_t _funcCheckTypeMask(EvalFrame* ef, int type)
1271{
1272 int64_t mask = 0;
1273 const uint8_t* pc = ef->call.pc;
1274 int which = *pc++;
1275 if( which & CHECK_TYPE_PAD )
1276 ++pc;
1277 if( which & 1 )
1278 {
1279 mask |= *((uint16_t*) pc);
1280 pc += 2;
1281 }
1282 if( which & 2 )
1283 {
1284 mask |= ((int64_t) *((uint16_t*) pc)) << 16;
1285 pc += 2;
1286 }
1287 if( which & 4 )
1288 {
1289 mask |= ((int64_t) *((uint16_t*) pc)) << 32;
1290 pc += 2;
1291 }
1292 ef->call.pc = pc;
1293 return (1LL << type) & mask;
1294}
1295
1296
1297#define FETCH_OPT_ARG (UR_OK + 1)
1298
1299// Return argument program counter or...
1300static int _funcRecordOption(UThread* ut, EvalFrame* cf, EvalFrame* options)
1301{
1302next_option:
1303 while( options->block.it != options->block.end )
1304 {
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;
1310 int i;
1311 for( i = 0; i < count; ++i, ++ent )
1312 {
1313 if( ent->atom == oc->word.atom )
1314 {
1315 UCell* args = ut->stack.ptr.cell + cf->call.argsPos;
1316 args[-1].OPTION_FLAGS |= 1 << i;
1317 if( ent->programOffset )
1318 {
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;
1323 }
1324 goto next_option;
1325 }
1326 }
1327 return ur_error(ut, UR_ERR_SCRIPT, "Invalid option %s",
1328 ur_atomCStr(ut, oc->word.atom));
1329 }
1330 return UR_OK;
1331}
1332
1333
1334/*
1335 Evaluate a thread in isolation until it yields, throws an exception, or
1336 completes.
1337
1338 This can be called recursively if an EOP_RUN_RECURSE operation is pushed
1339 prior to the call and popped afterwards.
1340
1341 \return BoronFibreState
1342*/
1343int boron_runFibre( UThread* ut )
1344{
1345 EvalFrame* evalFrames;
1346 EvalFrame* ef;
1347 EvalFrame* df; // Most recent EOP_DO_BLOCK frame.
1348 const UCell* cell;
1349 UCell* r2 = NULL;
1350 UBuffer* stack = &ut->stack;
1351 UBuffer* evalOp = &BT->evalOp;
1352 UIndex callTrace;
1353 int op, efUsed;
1354
1355 evalFrames = ur_ptr(EvalFrame, evalOp);
1356
1357 while (evalOp->used)
1358 {
1359eval_top:
1360 ef = evalFrames + evalOp->used - 1;
1361 switch (ef->block.eop)
1362 {
1363 case EOP_DO_BLOCK:
1364 if (ef->block.it == ef->block.end)
1365 {
1366 stack->used = ef->block.origStack;
1367 --evalOp->used;
1368 break;
1369 }
1370eval_next:
1371 cell = boron_eval1F(ut, ef->block.it, ef->block.end,
1372 ef->block.result);
1373 if (! cell)
1374 goto except;
1375 ef->block.it = cell;
1376 break;
1377
1378 case EOP_DO_BLOCK1:
1379 df = ef - 1;
1380 if (df->invoke.state == DO_BLOCK1_VALUE)
1381 {
1382 op = df->invoke.func(ut, &df->invoke);
1383 if (op == CFUNC_REFRAMED)
1384 goto eval_top;
1385 if (op == UR_THROW)
1386 goto except;
1387 }
1388 else
1389 df->invoke.state = DO_BLOCK1_VALUE;
1390
1391 if (ef->block.it != ef->block.end)
1392 goto eval_next;
1393
1394 stack->used = df->invoke.origStack;
1395 evalOp->used -= 2;
1396 df->invoke.state = DO_BLOCK1_COMPLETE;
1397 if (df->invoke.func(ut, &df->invoke) == UR_THROW)
1398 goto except;
1399 break;
1400
1401 case EOP_FUNC_BODY:
1402 // Same as EOP_DO_BLOCK except for funcFlags stack map pop.
1403 if (ef->block.it != ef->block.end)
1404 goto eval_next;
1405func_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;
1410 break;
1411
1412 case EOP_SET:
1413 for (cell = ef->set.it; cell != ef->set.end; ++cell)
1414 {
1415 if (ur_is(cell, UT_SETWORD))
1416 {
1417 if (! ur_setWord(ut, cell, ef->set.result))
1418 goto except;
1419 }
1420 else
1421 {
1422 if (! ur_setPath(ut, cell, ef->set.result))
1423 goto except;
1424 }
1425 }
1426 --evalOp->used;
1427 break;
1428
1429 case EOP_REDUCE:
1430 if (ef->reduce.it == ef->reduce.end)
1431 {
1432 stack->used = ef->reduce.origStack;
1433 --evalOp->used;
1434 break;
1435 }
1436 {
1437 UBuffer* blk = ur_buffer(ef->reduce.resBlk);
1438 cell = boron_eval1F(ut, ef->reduce.it, ef->reduce.end,
1439 ur_blkAppendNew(blk, UT_UNSET));
1440 }
1441 if (! cell)
1442 goto except;
1443 ef->reduce.it = cell;
1444 break;
1445
1446 case EOP_BLOCK_ITER:
1447 --evalOp->used; // NOP
1448 break;
1449
1450 case EOP_CATCH:
1451catch_pop:
1452 stack->used = ef->invoke.origStack;
1453 evalOp->used -= ef->invoke.state;
1454 break;
1455
1456 case EOP_RUN_RECURSE:
1457 // Keep this recurse operation on the evalOp stack so
1458 // boron_runFibre() can be used multiple times.
1459 // The caller is expected to use boron_popEvalRecurse().
1460 return BOR_FIBRE_DONE;
1461
1462 case EOP_INVOKE_LOOP:
1463 op = ef->invoke.func(ut, &ef->invoke);
1464 if (op == UR_THROW)
1465 goto except;
1466 if (op == UR_OK)
1467 goto catch_pop;
1468 break;
1469
1470 case EOP_INVOKE:
1471 if (ef->invoke.func(ut, &ef->invoke) == UR_THROW)
1472 goto except;
1473 stack->used = ef->invoke.origStack;
1474 --evalOp->used;
1475 break;
1476
1477 //case EOP_OPTION_IT:
1478
1479 case EOP_CALL_CFUNC:
1480 case EOP_CALL_FUNC:
1481arg_prog:
1482 df = ef - 1;
1483 while ((1 << df->block.eop & MASK_EOP_DO) == 0)
1484 --df;
1485 while( (op = *ef->call.pc++) < FO_end )
1486 {
1487 switch( op )
1488 {
1489 case FO_clearLocal: // Only for func!.
1490 op = *ef->call.pc++;
1491 {
1492 UCell* ls = stack->ptr.cell + stack->used;
1493 UCell* lend = ls + op;
1494 for( ; ls != lend; ++ls )
1495 ur_setId(ls, UT_NONE);
1496 }
1497 stack->used += op;
1498 goto fetch_done;
1499
1500 case FO_fetchArg:
1501 if( df->block.it == df->block.end )
1502 goto func_short;
1503 r2 = stack->ptr.cell + stack->used;
1504 ++stack->used;
1505 ur_setId(r2, UT_NONE);
1506 efUsed = evalOp->used;
1507 cell = boron_eval1F(ut, df->block.it, df->block.end,r2);
1508 if (! cell)
1509 {
1510 ef = df;
1511 goto except;
1512 }
1513 df->block.it = cell;
1514 if (evalOp->used > efUsed)
1515 goto eval_top;
1516 break;
1517
1518 case FO_litArg:
1519 if (df->block.it == df->block.end)
1520 goto func_short;
1521 stack->ptr.cell[ stack->used ] = *df->block.it++;
1522 ++stack->used;
1523 break;
1524
1525 case FO_checkType:
1526 op = *ef->call.pc++;
1527 r2 = stack->ptr.cell + stack->used - 1;
1528 if (ur_type(r2) != op)
1529 goto bad_arg;
1530 break;
1531
1532 case FO_checkTypeMask:
1533 r2 = stack->ptr.cell + stack->used - 1;
1534 if (! _funcCheckTypeMask(ef, ur_type(r2)))
1535 goto bad_arg;
1536 break;
1537
1538 case FO_optionRecord:
1539 r2 = stack->ptr.cell + stack->used;
1540 ++stack->used;
1541 ef->call.argsPos = stack->used;
1542 ur_setId(r2, UT_UNSET);
1543 break;
1544
1545 case FO_variant: // Only for cfunc!.
1546 r2 = stack->ptr.cell + stack->used;
1547 ++stack->used;
1548 ur_setId(r2, UT_INT);
1549 ur_int(r2) = *ef->call.pc++;
1550 break;
1551 }
1552 }
1553fetch_done:
1554 df = ef - 1;
1555 if (df->block.eop == EOP_OPTION_IT)
1556 {
1557 switch (_funcRecordOption(ut, ef, df)) {
1558 case UR_THROW:
1559 goto except;
1560 case FETCH_OPT_ARG:
1561 goto arg_prog;
1562 }
1563 }
1564
1565 if (ef->call.eop == EOP_CALL_CFUNC)
1566 {
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);
1570
1571 op = ((const UCellFunc*) ef->call.funC)->m.func(ut,
1572 stack->ptr.cell + ef->call.argsPos,
1573 ef->call.result);
1574 if (op == CFUNC_REFRAMED)
1575 break;
1576 if (op == UR_THROW)
1577 goto except;
1578 stack->used = ef->call.origStack;
1579 evalOp->used -= (ef[-1].block.eop == EOP_OPTION_IT) ? 2 : 1;
1580#ifdef CONFIG_FIBRE
1581 if (op == CFUNC_YIELD)
1582 return BOR_FIBRE_YIELD;
1583#endif
1584 }
1585 else
1586 {
1587 const UCell* funC = ef->call.funC;
1588 if (ef->call.funcFlags & FUNC_FLAG_NEEDSTACK)
1589 {
1590 UIndex* fi;
1591 UBuffer* smap = &BT->frames;
1592 UIndex newUsed = smap->used + 2;
1593 if (newUsed > ur_avail(smap))
1594 ur_arrReserve(smap, newUsed);
1595 fi = smap->ptr.i32 + smap->used;
1596 smap->used = newUsed;
1597 fi[0] = funC->series.buf;
1598 fi[1] = ef->call.argsPos;
1599 }
1600
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);
1604
1605 // Replace EOP_CALL_FUNC entry with EOP_FUNC_BODY.
1606 // The funcFlags, origStack, & result members sit in the
1607 // same place.
1608 {
1609 const UBuffer* body = ur_bufferEnv(ut, funC->series.buf);
1610 ef->block.eop = EOP_FUNC_BODY;
1611 //ef->block.funcFlags
1612 //ef->block.origStack
1613 ef->block.codeBlk = funC->series.buf;
1614 ef->block.it = body->ptr.cell + funC->series.it;
1615 ef->block.end = body->ptr.cell + body->used;
1616 //ef->block.result = ef->call.result;
1617 }
1618 }
1619 break;
1620
1621 default:
1622 ur_error(ut, UR_ERR_INTERNAL, "Invalid eval opcode");
1623 return BOR_FIBRE_EXCEPTION;
1624 }
1625 }
1626 return BOR_FIBRE_DONE;
1627
1628except:
1629 r2 = ur_exception(ut);
1630 efUsed = ur_is(r2, UT_WORD) ? ur_atom(r2) : 0;
1631 if (! ur_is(r2, UT_ERROR))
1632 r2 = NULL;
1633 callTrace = CALL_TRACE_NA;
1634
1635 // Catch exception and trace error! location.
1636 for (df = ef; df >= evalFrames; --df)
1637 {
1638 switch (df->invoke.eop)
1639 {
1640 case EOP_CATCH:
1641 case EOP_INVOKE_LOOP:
1642 op = df->invoke.dat.catchf(ut, df);
1643 if (op != UR_THROW)
1644 {
1645 if (op == UR_OK)
1646 {
1647 stack->used = df->invoke.origStack;
1648 evalOp->used = (df - evalFrames) - (df->invoke.state - 1);
1649 }
1650 goto eval_top;
1651 }
1652 break;
1653
1654 case EOP_FUNC_BODY:
1655 if (efUsed == UR_ATOM_RETURN)
1656 {
1657 evalOp->used = (df - evalFrames) + 1;
1658 ef = df;
1659 goto func_end;
1660 }
1661 // Fall through...
1662 /* FALLTHRU */
1663
1664 case EOP_DO_BLOCK:
1665 case EOP_DO_BLOCK1:
1666 case EOP_REDUCE:
1667 if (r2)
1668 {
1669 const UCell* doPos;
1670
1671 // Check FUNC_FLAG_NOTRACE.
1672 if ((1 << df->invoke.eop & MASK_EOP_FFLAGS) &&
1673 (df->block.funcFlags & FUNC_FLAG_NOTRACE))
1674 {
1675 callTrace = CALL_TRACE_SKIP;
1676 continue;
1677 }
1678
1679 if (callTrace >= 0)
1680 {
1681 doPos = ur_bufferEnv(ut, df->block.codeBlk)->ptr.cell +
1682 callTrace;
1683 callTrace = CALL_TRACE_NA;
1684 }
1685 else if (callTrace == CALL_TRACE_SKIP)
1686 {
1687 callTrace = CALL_TRACE_NA;
1688 continue;
1689 }
1690 else
1691 doPos = df->block.it;
1692
1693 ur_traceError(ut, r2, df->block.codeBlk, doPos);
1694 }
1695 break;
1696
1697 case EOP_RUN_RECURSE:
1698 // evalOp->used is reset by the code that pushed EOP_RUN_RECURSE.
1699 return BOR_FIBRE_EXCEPTION;
1700
1701 case EOP_CALL_CFUNC:
1702 if (callTrace == CALL_TRACE_NA)
1703 callTrace = df->call.tracePos;
1704 break;
1705 }
1706 }
1707 return BOR_FIBRE_EXCEPTION;
1708
1709bad_arg:
1710 boron_badArg(ut, ur_type(r2), stack->used - 1 - ef->call.argsPos);
1711 goto except;
1712
1713func_short:
1714 ur_error(ut, UR_ERR_SCRIPT, "End of block");
1715 goto except;
1716}
1717
1718
1719/*
1720 -cf-
1721 do
1722 value
1723 return: Result of value.
1724 group: eval
1725*/
1726CFUNC_PUB( cfunc_do )
1727{
1728 EvalFrame* ef = NULL;
1729 int origStack = 0;
1730
1731 switch( ur_type(a1) )
1732 {
1733 case UT_WORD:
1734 {
1735 const UCell* cell;
1736 if (! (cell = ur_wordCell(ut, a1)))
1737 return UR_THROW;
1738
1739 if (ur_is(cell, UT_CFUNC) || ur_is(cell, UT_FUNC))
1740 {
1741 boron_reuseFrame(ut, -1, NULL); // Pop EOP_CALL_CFUNC.
1742 if (! boron_eval1F(ut, cell, cell+1, res))
1743 return UR_THROW;
1744 return CFUNC_REFRAMED;
1745 }
1746 *res = *cell;
1747 }
1748 break;
1749
1750 case UT_LITWORD:
1751 *res = *a1;
1752 ur_type(res) = UT_WORD;
1753 break;
1754
1755 case UT_GETWORD:
1756 return boron_copyWordValue(ut, a1, res);
1757
1758 case UT_STRING:
1759 {
1760 USeriesIter si;
1761
1762 ur_seriesSlice(ut, &si, a1);
1763 if (si.it == si.end)
1764 ur_setId(res, UT_UNSET);
1765 else if (ur_strIsUcs2(si.buf))
1766 return ur_error(ut, UR_ERR_INTERNAL,
1767 "FIXME: Cannot do ucs2 string!");
1768 else
1769 {
1770 UCell* newBlk = ur_push(ut, UT_UNSET);
1771 UIndex blkN;
1772
1773 blkN = ur_tokenize(ut, si.buf->ptr.c + si.it,
1774 si.buf->ptr.c + si.end, newBlk); // gc!
1775 if (! blkN)
1776 {
1777 ur_pop(ut);
1778 return UR_THROW;
1779 }
1780
1781 boron_bindDefault(ut, blkN);
1782
1783 ef = _reuseFrame(BT, EOP_DO_BLOCK);
1784 ur_pushCell(ut, newBlk);
1785 _initEvalBlock(ef, ut, blkN, 1, res);
1786 return CFUNC_REFRAMED;
1787 }
1788 }
1789 break;
1790
1791 case UT_FILE:
1792 if (cfunc_load(ut, a1, res) == UR_THROW)
1793 return UR_THROW;
1794 if (res->id.type != UT_BLOCK)
1795 break;
1796 a1 = res;
1797 // Fall through to block...
1798 /* FALLTHRU */
1799
1800 case UT_BLOCK:
1801 case UT_PAREN:
1802 ef = _reuseFrame(BT, EOP_DO_BLOCK);
1803 _initEvalBlock(ef, ut, a1->series.buf, 0, res);
1804 return CFUNC_REFRAMED;
1805
1806 case UT_PATH:
1807 {
1808 UBlockIt path;
1809 UCell* last;
1810 int ok;
1811
1812 if( a1->word.selType )
1813 {
1814 UBuffer* stack = &ut->stack;
1815 path.it = path.end = stack->ptr.cell + stack->used;
1816 last = (UCell*) ur_pathSelect(ut, a1, res, (UCell**) &path.end);
1817 if( ! last )
1818 return UR_THROW;
1819 if( ur_is(last, UT_CFUNC) || ur_is(last, UT_FUNC) ) {
1820 // boron_reuseFrame below will keep any expanded path on
1821 // the stack for option! iteration.
1822 stack->used = path.end - stack->ptr.cell;
1823 goto path_call;
1824 }
1825 }
1826 else
1827 {
1828 ur_blockIt(ut, &path, a1);
1829 ok = ur_pathResolve(ut, &path, res, &last);
1830 if( ok == UR_THROW )
1831 return UR_THROW;
1832 if( ok == UT_WORD )
1833 {
1834path_call:
1835 if( ur_is(last, UT_CFUNC) )
1836 {
1837 ef = boron_reuseFrame(ut, 1, &origStack);
1838 if (! ef )
1839 return UR_THROW;
1840 ef->block.eop = EOP_OPTION_IT;
1841 ef->block.it = path.it;
1842 ef->block.end = path.end;
1843 ++ef;
1844 a1 = last;
1845 goto do_cfunc;
1846 }
1847 else if( ur_is(last, UT_FUNC) )
1848 {
1849 a1 = last;
1850 if (last->series.it == 0) // No arguments (does).
1851 goto do_does;
1852
1853 ef = boron_reuseFrame(ut, 1, &origStack);
1854 if (! ef )
1855 return UR_THROW;
1856 ef->block.eop = EOP_OPTION_IT;
1857 ef->block.it = path.it;
1858 ef->block.end = path.end;
1859 ++ef;
1860 goto do_func;
1861 }
1862 }
1863 }
1864 if (res != last)
1865 *res = *last;
1866 return UR_OK;
1867 }
1868
1869 case UT_LITPATH:
1870 *res = *a1;
1871 ur_type(res) = UT_PATH;
1872 break;
1873
1874 case UT_CFUNC:
1875 // Keep a1 on stack to hold cfunc! cell.
1876 ef = boron_reuseFrame(ut, 0, &origStack);
1877 if (! ef )
1878 return UR_THROW;
1879do_cfunc:
1880 _initEvalCallC(ef, ut, a1, origStack, res);
1881 return CFUNC_REFRAMED;
1882
1883 case UT_FUNC:
1884 // Keep a1 on stack to hold func! cell.
1885do_does:
1886 ef = boron_reuseFrame(ut, 0, &origStack);
1887 if (! ef )
1888 return UR_THROW;
1889 if (a1->series.it == 0) // No arguments (does).
1890 {
1891 ef->block.eop = EOP_FUNC_BODY;
1892 _initEvalBlock(ef, ut, a1->series.buf,
1893 ut->stack.used - origStack, res);
1894 }
1895 else
1896 {
1897do_func:
1898 //if (ut->stack.used > BT->stackLimit)
1899 // goto stack_overflow;
1900 _initEvalCallF(ef, ut, a1, origStack, res);
1901 }
1902 return CFUNC_REFRAMED;
1903
1904 default:
1905 *res = *a1;
1906 break;
1907 }
1908 return UR_OK;
1909}
1910
1911
1912/*-cf-
1913 reduce
1914 value
1915 return: Reduced value.
1916 group: data
1917
1918 If value is a block then a new block is created with values set to the
1919 evaluated results of the original.
1920*/
1921CFUNC(cfunc_reduce)
1922{
1923 if( ur_is(a1, UT_BLOCK) )
1924 {
1925 UIndex blkN = ur_makeBlock(ut, 0);
1926 ur_initSeries(res, UT_BLOCK, blkN);
1927
1928 EvalFrame* ef = _reuseFrame(BT, EOP_REDUCE);
1929 _initEvalReduce(ef, ut, a1, blkN);
1930 return CFUNC_REFRAMED;
1931 }
1932
1933 *res = *a1;
1934 return UR_OK;
1935}
1936
1937
1938extern int context_make( UThread* ut, const UCell* from, UCell* res );
1939extern UDatatype dt_context;
1940
1941static int context_make_override( UThread* ut, const UCell* from, UCell* res )
1942{
1943 if( ! context_make( ut, from, res ) )
1944 return UR_THROW;
1945 if( ur_is(from, UT_BLOCK) )
1946 {
1947 EvalFrame* ef = _reuseFrame(BT, EOP_DO_BLOCK);
1948 _initEvalBlock(ef, ut, from->series.buf, 1, ur_push(ut, UT_UNSET));
1949 return CFUNC_REFRAMED;
1950 }
1951 return UR_OK;
1952}
1953
1954
1955static void _bindDefaultB( UThread* ut, UIndex blkN )
1956{
1957 UBlockIterM bi;
1958 int type;
1959 int wrdN;
1960 UBuffer* threadCtx = ur_threadContext(ut);
1961 UBuffer* envCtx = ur_envContext(ut);
1962
1963 bi.buf = ur_buffer( blkN );
1964 bi.it = bi.buf->ptr.cell;
1965 bi.end = bi.it + bi.buf->used;
1966
1967 ur_foreach( bi )
1968 {
1969 type = ur_type(bi.it);
1970 if( ur_isWordType(type) )
1971 {
1972as_word:
1973 if( threadCtx->used )
1974 {
1975 wrdN = ur_ctxLookup( threadCtx, ur_atom(bi.it) );
1976 if( wrdN > -1 )
1977 goto assign;
1978 }
1979
1980 if( type == UT_SETWORD )
1981 {
1982 wrdN = ur_ctxAppendWord( threadCtx, ur_atom(bi.it) );
1983 if( envCtx )
1984 {
1985 // Lift default value of word from environment.
1986 int ewN = ur_ctxLookup( envCtx, ur_atom(bi.it) );
1987 if( ewN > -1 )
1988 *ur_ctxCell(threadCtx, wrdN) = *ur_ctxCell(envCtx, ewN);
1989 }
1990 }
1991 else
1992 {
1993 if( envCtx )
1994 {
1995 wrdN = ur_ctxLookup( envCtx, ur_atom(bi.it) );
1996 if( wrdN > -1 )
1997 {
1998 // TODO: Have ur_freezeEnv() remove unset words.
1999 if( ! ur_is( ur_ctxCell(envCtx, wrdN), UT_UNSET ) )
2000 {
2001 ur_setBinding( bi.it, UR_BIND_ENV );
2002 bi.it->word.ctx = -UR_MAIN_CONTEXT;
2003 bi.it->word.index = wrdN;
2004 continue;
2005 }
2006 }
2007 }
2008 wrdN = ur_ctxAppendWord( threadCtx, ur_atom(bi.it) );
2009 }
2010assign:
2011 ur_setBinding( bi.it, UR_BIND_THREAD );
2012 bi.it->word.ctx = UR_MAIN_CONTEXT;
2013 bi.it->word.index = wrdN;
2014 }
2015 else if( ur_isBlockType(type) )
2016 {
2017as_block:
2018 if( ! ur_isShared( bi.it->series.buf ) )
2019 _bindDefaultB( ut, bi.it->series.buf );
2020 }
2021 else if( ur_isPathType(type) )
2022 {
2023 if( bi.it->word.selType )
2024 goto as_word;
2025 goto as_block;
2026 }
2027 /*
2028 else if( type >= UT_BI_COUNT )
2029 {
2030 ut->types[ type ]->bind( ut, it, bt );
2031 }
2032 */
2033 }
2034}
2035
2036
2037extern UBuffer* ur_ctxSortU( UBuffer*, int unsorted );
2038
2043{
2044 ur_ctxSortU( ur_threadContext( ut ), 16 );
2045 _bindDefaultB( ut, blkN );
2046}
2047
2048
2049#ifdef CONFIG_FIBRE
2050// Unlink from fibre list.
2051static void boron_unlinkFibre(BoronThread* start, BoronThread* toRemove)
2052{
2053 BoronThread* fib;
2054 BoronThread* it = start;
2055
2056 while (1) {
2057 fib = it->nextFibre;
2058 if (fib == toRemove) {
2059 it->nextFibre = fib->nextFibre;
2060 break;
2061 }
2062 if (fib == start)
2063 break;
2064 it = fib;
2065 }
2066}
2067
2068
2069extern UThread* boron_waitFibre(UThread*);
2070extern void thread_writeFibreResult(UThread*);
2071#endif
2072
2073UStatus boron_evalBlock(UThread* ut, UIndex blkN, UCell* res)
2074{
2075#ifdef CONFIG_FIBRE
2076 UThread* evalThread = ut;
2077 UThread* cur;
2078 int fstate;
2079
2080 boron_startFibre(ut, blkN, res);
2081 while (1) {
2082 fstate = boron_runFibre(ut);
2083 if (fstate == BOR_FIBRE_YIELD) {
2084wait:
2085 ut = boron_waitFibre(ut);
2086 } else {
2087 if (ut == evalThread)
2088 return (fstate == BOR_FIBRE_EXCEPTION) ? UR_THROW : UR_OK;
2089
2090 if (fstate == BOR_FIBRE_EXCEPTION) {
2091 UBuffer str;
2092 ur_strInit(&str, UR_ENC_UTF8, 0);
2093 ur_toText(ut, ur_exception(ut), &str);
2094 ur_strTermNull(&str);
2095 puts(str.ptr.c);
2096 ur_strFree(&str);
2097 }
2098
2099 cur = ut;
2100 ut = (UThread*) (BT->nextFibre);
2101 boron_unlinkFibre((BoronThread*) evalThread, (BoronThread*) cur);
2102 thread_writeFibreResult(cur);
2103 ur_destroyThread(cur);
2104
2105 if (BT->timeout || BT->waitPorts)
2106 goto wait;
2107 }
2108 }
2109#else
2110 boron_startFibre(ut, blkN, res);
2111 return (boron_runFibre(ut) == BOR_FIBRE_EXCEPTION) ? UR_THROW : UR_OK;
2112#endif
2113}
2114
2115
2127UCell* boron_evalUtf8( UThread* ut, const char* script, int len )
2128{
2129 UCell* res;
2130 UIndex bufN; // Code block.
2131
2132 if( len < 0 )
2133 len = strlen(script);
2134
2135 boron_reset(ut);
2136 res = ur_stackTop(ut);
2137 bufN = ur_tokenize(ut, script, script + len, res); // gc!
2138 if (! bufN)
2139 return NULL;
2140
2141 boron_bindDefault(ut, bufN);
2142
2143 res = ur_push(ut, UT_UNSET);
2144 if (! boron_evalBlock(ut, bufN, res))
2145 res = NULL;
2146 return res;
2147}
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