YAP 7.1.0
absmi.c
Go to the documentation of this file.
1/*************************************************************************
2 * *
3 * Yap Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: absmi.c *
12 * comments: Portable abstract machine interpreter *
13 * Last rev: $Date: 2008-08-13 01:16:26 $,$Author: vsc $
14 **
15 * $Log: not supported by cvs2svn $
16 * Revision 1.246 2008/08/12 01:27:22 vsc
17 * *
18 * *
19 *************************************************************************/
20
68#define IN_ABSMI_C 1
69#define _INATIV
70
72#define HAS_CACHE_REGS 1
73
74#include "absmi.h"
75
76#include "heapgc.h"
77
78#if 0
79#define DEBUG_INTERRUPTS()
80#else
81/* to trace interrupt calls */
82extern long long vsc_count;
83#define DEBUG_INTERRUPTS() \
84 { fprintf(stderr, "%d %lx %s %d B=%p E=%p ASP=%p\n", \
85 worker_id, LOCAL_Signals,\
86 __FUNCTION__, __LINE__, B, ENV, ASP);}
87#endif
88
89#if YAP_JIT
90#include "IsGround.h"
91
92TraceContext **curtrace;
93yamop *curpreg;
94BlocksContext **globalcurblock;
95COUNT ineedredefinedest;
96yamop *headoftrace;
97
98NativeContext *NativeArea;
99IntermediatecodeContext *IntermediatecodeArea;
100
101CELL l;
102
103CELL nnexec;
104
105Environment *Yap_ExpEnvP, Yap_ExpEnv;
106
107void **Yap_ABSMI_ControlLabels;
108
109static Int traced_absmi(void) { return Yap_traced_absmi(); }
110
111#endif
112
113#ifndef YREG
114#define YREG YENV
115#endif
116
117void **Yap_ABSMI_OPCODES;
118
119#ifdef PUSH_X
120#else
121
122/* keep X as a global variable */
123
124Term Yap_XREGS[MaxTemps]; /* 29 */
125
126#endif
127
128#include "arith2.h"
129
130// #Include "print_preg.h"
131//#include "sprint_op.hpp"
132//#include "print_op.hpp"
133
134
135static Term save_goal(PredEntry *pe USES_REGS) {
136 BEGD(rc);
137 CELL *S_PT;
138 // printf("D %lx %p\n", LOCAL_ActiveSignals, P);
139 /* tell whether we can creep or not, this is hard because we will
140 lose the info RSN
141 */
142 arity_t arity;
143 /* if (pe->ModuleOfPred == PROLOG_MODULE) { */
144 /* if (CurrentModule == PROLOG_MODULE) */
145 /* HR[0] = TermProlog; */
146 /* else */
147 /* HR[0] = CurrentModule; */
148 /* } else { */
149 /* HR[0] = Yap_Module_Name(pe); */
150 /* } */
151 S_PT = HR;
152 HR += 3;
153 rc = AbsAppl(S_PT);
154 S_PT[0] = (CELL)FunctorModule;
155 S_PT[1] = (pe->ModuleOfPred ? pe->ModuleOfPred: TermProlog);
156 arity = pe->ArityOfPE;
157 if (arity == 0) {
158 S_PT[2] = MkAtomTerm((Atom)pe->FunctorOfPred);
159 } else {
160 int a;
161 S_PT[2] = AbsAppl(HR);
162 S_PT = HR;
163 S_PT[0] = (CELL)pe->FunctorOfPred;
164 HR += 1+arity;
165 /*
166 */
167 for (a=1; a<= arity; a++) {
168 S_PT[a] = MkGlobal(XREGS[a]);
169 }
170 /*
171 */
172 }
173 return rc;
174 ENDD(rc);
175}
176
177#if 0
178static void put_goal(PredEntry *pe, CELL *args USES_REGS) {
179 // printf("D %lx %p\n", LOCAL_ActiveSignals, P);
180 /* tell whether we can creep or not, this is hard because we will
181 lose the info RSN
182 */
183 /* if (pe->ModuleOfPred == PROLOG_MODULE) { */
184 /* if (CurrentModule == PROLOG_MODULE) */
185 /* HR[0] = TermProlog; */
186 /* else */
187 /* HR[0] = CurrentModule; */
188 /* } else { */
189 /* HR[0] = Yap_Module_Name(pe); */
190 /* } */
191 if (pe->ArityOfPE == 0)
192 return;
193 arity_t i;
194 for (i=0;i<pe->ArityOfPE;i++) {
195 XREGS[i+1] = *args++;
196 }
197q}
198
199
200/*
201 this one's called before gc or stack expansion. It generates a consistent
202 set of registers, so that they can be marked and assigned by the g collector.
203*/
204static arity_t live_regs( yamop *pco, PredEntry *pe) {
205 CACHE_REGS
206 if (pco->opc != Yap_opcode(_skip) &&
207 pco->opc != Yap_opcode(_move_back))
208 return pe->ArityOfPE;
209 CELL *lab = (CELL *)(pco->y_u.l.l);
210 arity_t max = lab[0]; // largest live register
211 CELL curr = lab[1]; // bitmap for 0-63 or 0-31
212 arity_t i;
213 lab += 2;
214 for (i = 0; i <= max; i++) {
215 //Process a group of N registers
216 if (i == 8 * CellSize) {
217 lab++;
218 }
219 if (curr & 1) {
220 continue;
221 } else {
222 /* dead register but let's store safe contents*/
223 XREGS[i] = MkIntegerTerm(i);
224 }
225
226 }
227 // this will be the new arity
228 return max;
229}
230#endif
231
232#if USE_THREADED_CODE && (defined(ANALYST) || defined(DEBUG))
233
234char *Yap_op_names[] = {
235#define OPCODE(OP, TYPE) #OP
236#include "YapOpcodes.h"
237#undef OPCODE
238};
239
240#endif
241
242static int check_alarm_fail_int(int CONT USES_REGS) {
243#if defined(_MSC_VER) || defined(__MINGW32__)
244 /* I need this for Windows and any system where SIGINT
245 is not proceesed by same thread as absmi */
246 if (LOCAL_PrologMode & (AbortMode | InterruptMode)) {
247 CalculateStackGap(PASS_REGS1);
248 }
249#endif
250 if (Yap_get_signal(YAP_FAIL_SIGNAL)) {
251 return INT_HANDLER_FAIL;
252 }
253 // fail even if there are more signals, they will have to be dealt later.
254 return INT_HANDLER_GO_ON;
255}
256
257static int stack_overflow(op_numbers op, yamop *pc, PredEntry **pt USES_REGS) {
258 gc_entry_info_t info;
259 if (Yap_get_signal(YAP_STOVF_SIGNAL) ||
260 Unsigned(YREG) - Unsigned(HR) < StackGap(PASS_REGS1)
261 ) {
262 PredEntry *pe = Yap_track_cpred( op, pc, 0, &info);
263 if (pt) *pt = pe;
264 // p should be past the enbironment mang Obpp
265 if (!Yap_gc(&info)) {
266 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, "stack overflow: gc failed");
267 }
268 return INT_HANDLER_RET_JMP;
269 }
270 return INT_HANDLER_GO_ON;
271
272 }
273
274static int code_overflow(CELL *yenv USES_REGS) {
275 if (Yap_get_signal(YAP_CDOVF_SIGNAL)) {
276 CELL cut_b = LCL0 - (CELL *)(yenv[E_CB]);
277
278 /* do a garbage collection first to check if we can recover memory */
279 if (!Yap_locked_growheap(false, 0, NULL)) {
280 Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
281 "malloc/mmap failed");
282 return INT_HANDLER_FAIL;
283 }
284 CACHE_A1();
285 if (yenv == ASP) {
286 yenv[E_CB] = (CELL)(LCL0 - cut_b);
287 }
288 return INT_HANDLER_RET_JMP;
289 }
290 return INT_HANDLER_GO_ON;
291}
292
293/*
294 Imagine we are interrupting the execution, say, because we have a spy
295 point or because we have goals to wake up. This routine saves the current
296 live temporary registers into a structure pointed to by register ARG1.
297 The registers are then recovered by a nasty builtin
298 called
299*/
300static Term save_xregs(yamop *pco) {
301 CACHE_REGS
302 CELL *lab = (CELL *)(pco->y_u.l.l), *start;
303 CELL max = lab[0];
304 CELL curr = lab[1];
305 Term tp = MkIntegerTerm((Int)pco);
306 Term tcp = MkIntegerTerm((Int)CP);
307 Term tenv = MkIntegerTerm((Int)(LCL0 - ENV));
308 Term tyenv = MkIntegerTerm((Int)(LCL0 - YENV));
309 start = HR;
310 HR++;
311 *HR++ = tp;
312 *HR++ = tcp;
313 *HR++ = tenv;
314 *HR++ = tyenv;
315
316 arity_t tot = 4;
317 {
318 CELL i;
319
320 lab += 2;
321 for (i = 0; i <= max; i++) {
322 if (curr) break;
323 if (i == 8 * CellSize) {
324 curr = lab[0];
325 lab++;
326 }
327 CELL ocurr = curr;
328 curr >>= 1;
329 if (ocurr & 1) {
330 CELL d1;
331
332 d1 = XREGS[i];
333 HR[0] = MkIntTerm(i);
334 HR+=2;
335 tot+=2; deref_head(d1, mkglobal_unk);
336 RESET_VARIABLE(HR - 1);
337 mkglobal_nonvar:
338 YapBind(HR-1,d1);
339 if (false)
340 {
341 CELL *pt0;
342 deref_body(d1, pt0, mkglobal_unk, mkglobal_nonvar);
343 /* bind it, in case it is a local variable */
344 if (pt0 > ASP) { /* variable is safe */
345 d1 = Unsigned(HR - 1);
346 Bind_Local(pt0, d1);
347 } else {
348 YapBind(HR-1,d1);
349 }
350 }
351 }
352 }
353 if (tot == 4)
354 return TermTrue;
355 *start = (CELL)Yap_MkFunctor(AtomTrue, tot);
356 return (AbsAppl(start));
357 }
358}
359
360static Term addgs(Term g, Term tg)
361{
362 Term ts[2];
363 if (g == TermTrue || g == 0) {
364 if (tg==0) return TermTrue;
365 return tg;
366 }
367 if (tg == TermTrue || tg == 0)
368 return g;
369 ts[0] = g;
370 ts[1] = tg;
371 return Yap_MkApplTerm(FunctorComma,2,ts);
372}
373
374
384 static PredEntry* interrupt_wake_up(PredEntry *pen, yamop *plab, Term cut_t USES_REGS) {
385 // printf("D %lx %p\n", LOCAL_ActiveSignals, P);
386 /* tell whether we can creep or not, this
387is hard because we will
388 lose the info RSN
389 */
390 bool wk = Yap_get_signal(YAP_WAKEUP_SIGNAL);
391 bool creep = Yap_get_signal(YAP_CREEP_SIGNAL);
392 bool sig = Yap_has_a_signal();
393 Term tg=cut_t ;
394
395 Term td = Yap_ReadTimedVar(LOCAL_WokenGoals);
396 if (pen && plab) {
397 td= save_xregs(plab PASS_REGS);
398 td = Yap_MkApplTerm(FunctorRestoreRegs1, 1, &td);
399 tg = addgs(td
400 ,tg);
401 }
402 if (wk) {
403 tg = addgs(td,tg);
404 Yap_UpdateTimedVar(LOCAL_WokenGoals, TermTrue);
405 }
406 if (creep) {
407 tg=Yap_MkApplTerm(FunctorCreep, 1, &tg);
408 }
409 if (sig) {
410 while ((td = Yap_next_signal(PASS_REGS1))) {
411 tg = addgs(Yap_MkApplTerm(FunctorSignalHandler, 1, &td),tg);
412 }
413 }
414 Yap_DebugPlWriteln(tg);
415 // Yap_DebugPlWriteln(tg);
416 Term mod = CurrentModule;
417 PredEntry *pe;
418 tg = Yap_YapStripModule(tg, &mod);
419 if (IsVarTerm(tg)) {
420 Yap_ThrowError(INSTANTIATION_ERROR, tg, "wake-up");
421 } else if (IsPairTerm(tg)) {
422 XREGS[1] = HeadOfTerm(tg);
423 XREGS[2] = TailOfTerm(tg);
424 pe = RepPredProp(Yap_GetPredPropByFunc(FunctorCsult, mod));
425 } else if (IsApplTerm(tg)) {
426 Functor f = FunctorOfTerm(tg);
427 arity_t i, n = ArityOfFunctor(f);
428 CELL *p = RepAppl(tg) + 1;
429 for (i = 0; i < n; i++) {
430 XREGS[i + 1] = p[i];
431 }
432 pe = RepPredProp(Yap_GetPredPropByFunc(f, mod));
433 } else if (IsAtomTerm(tg)) {
434 pe = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(tg), mod));
435 } else {
436 Yap_ThrowError(TYPE_ERROR_CALLABLE, tg, "wake-up");
437 }
438
439
440 CACHE_A1();
441 return pe;
442}
443
444
445
446static bool interrupt_main(op_numbers op, yamop *pc USES_REGS) {
447 bool late_creep = false;
448 gc_entry_info_t info;
449 if (PP) {
450 UNLOCK(PP);
451 PP =NULL;
452 }
453 int v;
454 PredEntry *pe;
455Yap_track_cpred( op, pc, 0, &info);
456 pe = info.callee;
457
458 SET_ASP(YENV,info.env_size);
459 if (LOCAL_PrologMode & InErrorMode) {
460 return true;
461 }
462 if ((v = code_overflow(YENV PASS_REGS)) != INT_HANDLER_GO_ON ) {
463 return v;
464 }
465
466 if ((v = stack_overflow(op, P, NULL PASS_REGS) !=
467 INT_HANDLER_GO_ON)) {
468
469 SET_ASP(info.env ,info.env_size);
470 return v; // restartx
471 }
472
473 /* if ((pe->PredFlags & (NoTracePredFlag | HiddenPredFlag)) */
474 /* ) { */
475 /* late_creep = true; */
476 /* } */
477 // at this pointap=interrupt_wake_up( pe, NULL, 0 PASS_REGS);
478 PredEntry *newp = interrupt_wake_up( pe, NULL, TermTrue PASS_REGS);
479 if (late_creep)
480 Yap_signal(YAP_CREEP_SIGNAL);
481 if (newp==NULL)
482 return true;
483 size_t sz = ((size_t)NEXTOP(((yamop*)NULL),Osbpp))/sizeof(CELL)+1;
484ASP -= sz;
485 yamop* buf = (yamop*)(ASP);
486 memcpy(buf, info.p, (size_t)NEXTOP(NEXTOP(((yamop*)NULL),Osbpp),l));
487 buf->y_u.Osbpp.p = newp;
488 yamop *next = NEXTOP(buf,Osbpp)
489 ;
490 next->y_u.l.l = NEXTOP(info.p,Osbpp);
491 switch (op) {
492 case _execute_cpred:
493 buf->opc = Yap_opcode(_execute);
494 buf->y_u.Osbpp.p = newp;
495 op = _execute;
496 break;
497 case _call_cpred:
498 buf->opc = Yap_opcode(_call);
499 buf->y_u.Osbpp.p = newp;
500 op = _call;
501 break;
502 case _dexecute:
503 buf->y_u.Osbpp.p = newp;
504 break;
505 case _execute:
506 buf->y_u.Osbpp.p = newp;
507 break;
508 case _p_execute:
509 buf->opc = Yap_opcode(_call);
510 buf->y_u.Osbpp.p = PredMetaCall;
511 break;
512 case _deallocate:
513 {
514 yamop *next = buf;
515 next->opc = Yap_opcode(_jump);
516 next->y_u.l.l = info.p;
517 }
518 break;
519 default:
520 return true;
521 }
522 CalculateStackGap(PASS_REGS1);
523 P = buf;
524 return true;
525}
526
527
528static bool interrupt_fail(USES_REGS1) {
529 DEBUG_INTERRUPTS();
530 if (LOCAL_PrologMode & InErrorMode) {
531 return false;
532 }
533 check_alarm_fail_int(false PASS_REGS);
534 /* don't do debugging and stack expansion here: space will
535 be recovered. automatically by fail, so
536 better wait.
537 */
538 bool creep = Yap_get_signal(YAP_CREEP_SIGNAL);
539 // interrupt_main( _op_fail, P PASS_REGS);
540 PredEntry *newp = interrupt_wake_up( PredFail, NULL, TermTrue PASS_REGS);
541 if (creep) Yap_signal(YAP_CREEP_SIGNAL);
542
543 // if (pe && pe != PredTrue) {
544 // Yap_execute_pred(pe, NULL, true);
545 //}
546 CalculateStackGap(PASS_REGS1);
547 if (newp) P = newp->CodeOfPred;
548 return newp != NULL;
549
550}
551
552static int interrupt_execute(USES_REGS1) {
553
554 DEBUG_INTERRUPTS();
555 return interrupt_main( _execute, P PASS_REGS);
556 }
557
558static int interrupt_executec(USES_REGS1) {
559 DEBUG_INTERRUPTS();
560 return interrupt_main(_execute_cpred, P PASS_REGS);
561}
562
563static int interrupt_c_call(USES_REGS1) {
564
565 DEBUG_INTERRUPTS();
566
567 return interrupt_main( _call_cpred, P PASS_REGS);
568}
569
570static int interrupt_user_call(USES_REGS1) {
571
572 DEBUG_INTERRUPTS();
573
574 return interrupt_main( _call_usercpred, P PASS_REGS);
575}
576
577
578static bool interrupt_call(USES_REGS1) {
579 DEBUG_INTERRUPTS();
580 return interrupt_main( _call, P PASS_REGS) != INT_HANDLER_FAIL;
581}
582
583
584static bool interrupt_dexecute(USES_REGS1) {
585 DEBUG_INTERRUPTS();
586
587 int rc = interrupt_main(_dexecute, P PASS_REGS);
588 return rc == INT_HANDLER_FAIL ? false : true;
589 }
590
591static bool interrupt_pexecute(USES_REGS1) {
592 DEBUG_INTERRUPTS();
593 return interrupt_main(_p_execute, P PASS_REGS);
594 return INT_HANDLER_FAIL ? false : true;
595 }
596
597
598
599static yamop* interrupt_prune(Term cut_t, yamop *p USES_REGS) {
600 int v;
601 DEBUG_INTERRUPTS();
602 if (LOCAL_PrologMode & InErrorMode) {
603
604 PP = P->y_u.Osbpp.p0;
605
606 return PP->CodeOfPred;
607 }
608 if ((v = check_alarm_fail_int(true PASS_REGS)) != INT_HANDLER_GO_ON) {
609 return FAILCODE;
610 }
611 Term tcut = Yap_MkApplTerm(FunctorCutBy, 1, &cut_t);
612 p = NEXTOP(p, Osblp);
613 interrupt_wake_up( NULL, p, tcut PASS_REGS);
614 return P;
615}
616
617static yamop * interrupt_cut(USES_REGS1) {
618 yamop *c = NEXTOP(NEXTOP(NEXTOP(P, s),Osbpp),l);
619 return interrupt_prune(MkIntTerm(LCL0-(CELL *)YENV[E_CB]), NEXTOP(P,s) PASS_REGS) == FAILCODE ?FAILCODE : c;
620}
621
622
623
624static yamop * interrupt_cut_t(USES_REGS1) {
625 yamop *c = NEXTOP(NEXTOP(NEXTOP(P, s),Osbpp),l);
626 return interrupt_prune(MkIntTerm(LCL0-(CELL *)YENV[E_CB]), NEXTOP(P,s) PASS_REGS) == FAILCODE ? FAILCODE : c;
627}
628
629static yamop * interrupt_cut_e(USES_REGS1) {
630 yamop *c = NEXTOP(NEXTOP(NEXTOP(P, s),Osbpp),l);
631 return interrupt_prune(MkIntTerm(LCL0-(CELL *)S[E_CB]), NEXTOP(P,s) PASS_REGS) == FAILCODE ? FAILCODE : c;
632}
633
634
635static yamop * interrupt_commit_y(USES_REGS1) {
636 yamop *c = NEXTOP(NEXTOP(NEXTOP(P, yps),Osbpp),l);
637 return interrupt_prune(YENV[P->y_u.yps.y], NEXTOP(P,s) PASS_REGS) == FAILCODE ? FAILCODE : c;
638
639}
640
641 static yamop * interrupt_commit_x(USES_REGS1) {
642 yamop *c = NEXTOP(NEXTOP(NEXTOP(P, xps),Osbpp),l);
643 return interrupt_prune(XREG(P->y_u.xps.x), NEXTOP(P,s) PASS_REGS) == FAILCODE ? FAILCODE : c;
644}
645
646static yamop * interrupt_soft_cut_y(USES_REGS1) {
647 yamop *c = NEXTOP(NEXTOP(NEXTOP(P, yps),Osbpp),l);
648 return interrupt_prune(YENV[P->y_u.yps.y], NEXTOP(P,s) PASS_REGS) == FAILCODE ? FAILCODE : c;
649
650}
651
652 static yamop * interrupt_soft_cut_x(USES_REGS1) {
653 yamop *c = NEXTOP(NEXTOP(NEXTOP(P, xps),Osbpp),l);
654 return interrupt_prune(XREG(P->y_u.xps.x), NEXTOP(P,s) PASS_REGS) == FAILCODE ? FAILCODE : c;
655}
656
657#if 0
658
659static int interrupt_either(USES_REGS1) {
660
661 int v;
662PredEntry *ap = P->y_u.Osblp.p0;
663// yamop *p = P;
664 DEBUG_INTERRUPTS();
665 if (PP) {
666 UNLOCKPE(1, PP);
667 PP = NULL;
668 }
669
670 if (LOCAL_PrologMode & InErrorMode) {
671 PP = ap;
672 return true;
673 }
674if ( (v=check_alarm_fail_int(true PASS_REGS)) != INT_HANDLER_GO_ON) {
675 if ( v != INT_HANDLER_FAIL) { PP = PredFail; return false; }
676 else {
677 PP = ap;
678 return true;
679 }
680 }
681 if (Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
682 PP = ap;
683 return true;
684 }
685 /* find something to fool S
686 if ((v = code_overflow(YENV PASS_REGS)) != INT_HANDLER_GO_ON) {
687 return v == INT_HANDLER_FAIL ? FailPred : ??;
688 }
689 */
690
691 PredEntry *pe =
692 interrupt_wake_up( ap, NULL, TermTrue PASS_REGS);
693 if ( pe == PredTrue) { PP=ap; return true; }
694 if ( pe == PredFail) { PP=PredFail; return false; }
695 if (!pe || Yap_execute_pred(pe, NULL, true ) ) {
696 PP = ap;
697 return true;
698 }
699 PP = PredFail;
700 return false;
701}
702
703#endif
704
705static void undef_goal(PredEntry *pe USES_REGS) {
706 /* avoid trouble with undefined dynamic procedures */
707 /* I assume they were not locked beforehand */
708 // Yap_DebugPlWriteln(Yap_PredicateToIndicator(pe));
709 BACKUP_MACHINE_REGS();
710 // first, in these cases we should never be here.
711 if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) {
712 #if defined(YAPOR) || defined(THREADS)
713 UNLOCKPE(19, PP);
714 PP = NULL;
715#endif
716 P = FAILCODE;
717 }
718#if defined(YAPOR) || defined(THREADS)
719 UNLOCKPE(19, PP);
720 PP = NULL;
721#endif
722 CalculateStackGap(PASS_REGS1);
723 LOCAL_DoingUndefp = false;
724 PredEntry *hook;
725 Term tg = save_goal(pe PASS_REGS);
726 // Check if we have something at user:unknown_predicate_handler/3 */
727 if ( UndefHook &&
728 UndefHook->OpcodeOfPred != UNDEF_OPCODE) {
729 // this case happens while booting,
730 //before we even declared the hook:
731 hook = UndefHook;
732 } else if (UndefHook0 &&
733 UndefHook0->OpcodeOfPred != UNDEF_OPCODE){
734 hook = UndefHook0;
735 } else {
736 hook= NULL;
737 }
738 if (hook) {
739 P = hook->CodeOfPred;
740 }
741
742 // control is done
743 ARG1 = tg;
744 // go forth to meet the handler.
745#if defined(YAPOR) || defined(THREADS)
746 UNLOCKPE(19, PP);
747 PP = NULL;
748#endif
749 CalculateStackGap(PASS_REGS1);
750 RECOVER_MACHINE_REGS();
751
752
753 return;
754}
755
756static void spy_goal(USES_REGS1) {
757 PredEntry *pe = PredFromDefCode(P);
758
759#if defined(YAPOR) || defined(THREADS)
760 if (!PP) {
761 PELOCK(14, pe);
762 PP = pe;
763 }
764#endif
765 if (!(pe->PredFlags & IndexedPredFlag) && pe->cs.p_code.NOfClauses > 1) {
766 /* update ASP before calling IPred */
767 SET_ASP(YREG, E_CB);
768 Yap_IPred(pe, 0, CP);
769 /* IPred can generate errors, it thus must get rid of the lock itself */
770 if (P == PredFail->CodeOfPred) {
771#if defined(YAPOR) || defined(THREADS)
772 if (PP && !(PP->PredFlags & LogUpdatePredFlag)) {
773 UNLOCKPE(20, pe);
774 PP = NULL;
775 }
776#endif
777 return;
778 }
779 }
780 /* first check if we need to increase the counter */
781 if ((pe->PredFlags & CountPredFlag)) {
782 LOCK(pe->StatisticsForPred->lock);
783 pe->StatisticsForPred->NOfEntries++;
784 UNLOCK(pe->StatisticsForPred->lock);
785 LOCAL_ReductionsCounter--;
786 if (LOCAL_ReductionsCounter == 0 && LOCAL_ReductionsCounterOn) {
787#if defined(YAPOR) || defined(THREADS)
788 if (PP) {
789 UNLOCKPE(20, pe);
790 PP = NULL;
791 }
792#endif
793 Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, "");
794 return;
795 }
796 LOCAL_PredEntriesCounter--;
797 if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
798#if defined(YAPOR) || defined(THREADS)
799 if (PP) {
800 UNLOCKPE(21, pe);
801 PP = NULL;
802 }
803#endif
804 Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
805 return;
806 }
807 if ((pe->PredFlags & (CountPredFlag | ProfiledPredFlag | SpiedPredFlag)) ==
808 CountPredFlag) {
809#if defined(YAPOR) || defined(THREADS)
810 if (PP) {
811 UNLOCKPE(22, pe);
812 PP = NULL;
813 }
814#endif
815 P = pe->cs.p_code.TrueCodeOfPred
816;
817 return;
818 }
819 }
820 /* standard profiler */
821 if ((pe->PredFlags & ProfiledPredFlag)) {
822 if (!pe->StatisticsForPred)
823 Yap_initProfiler(pe);
824 LOCK(pe->StatisticsForPred->lock);
825 pe->StatisticsForPred->NOfEntries++;
826 UNLOCK(pe->StatisticsForPred->lock);
827 if (!(pe->PredFlags & SpiedPredFlag)) {
828 P = pe->cs.p_code.TrueCodeOfPred
829;
830#if defined(YAPOR) || defined(THREADS)
831 if (PP) {
832 UNLOCKPE(23, pe);
833 PP = NULL;
834 }
835#endif
836 return;
837 }
838 }
839#if defined(YAPOR) || defined(THREADS)
840 if (PP) {
841 UNLOCKPE(25, pe);
842 PP = NULL;
843 }
844#endif
845 ARG1 = save_goal(pe PASS_REGS);
846
847 {
848 PredEntry *pt0;
849#if THREADS
850 LOCK(GLOBAL_ThreadHandlesLock);
851#endif
852 pt0 = SpyCode;
853 P_before_spy = P;
854 P = pt0->CodeOfPred;
855 /* for profiler */
856#if THREADS
857 UNLOCK(GLOBAL_ThreadHandlesLock);
858#endif
859#ifdef LOW_LEVEL_TRACER
860 if (Yap_do_low_level_trace)
861 low_level_trace(enter_pred, pt0, XREGS + 1);
862#endif /* LOW_LEVEL_TRACE */
863 }
864}
865
866Int Yap_absmi(int inp) {
867 CACHE_REGS
868#if BP_FREE
869 /* some function might be using bp for an internal variable, it is the
870 callee's responsability to save it */
871 yamop *PCBACKUP = P1REG;
872#endif
873
874#ifdef LONG_LIVED_REGISTERS
875 register CELL d0, d1;
876 register CELL *pt0, *pt1;
877
878#endif /* LONG_LIVED_REGISTERS */
879
880#ifdef SHADOW_P
881 register yamop *PREG = P;
882#endif /* SHADOW_P */
883
884#ifdef SHADOW_CP
885 register yamop *CPREG = CP;
886#endif /* SHADOW_CP */
887
888#ifdef SHADOW_HB
889 register CELL *HBREG = HB;
890#endif /* SHADOW_HB */
891
892#ifdef SHADOW_Y
893 register CELL *YREG = Yap_REGS.YENV_;
894#endif /* SHADOW_Y */
895
896#ifdef SHADOW_S
897 register CELL *SREG = Yap_REGS.S_;
898#else
899#endif /* SHADOW_S */
900
901 /* The indexing register so that we will not destroy ARG1 without
902 * reason */
903#define I_R (XREGS[0])
904
905#if YAP_JIT
906 Yap_ExpEnvP = &Yap_ExpEnv;
907 static void *control_labels[] = {
908 &&fail, &&NoStackCut, &&NoStackCommitY,
909 &&NoStackCutT, &&NoStackEithcer, &&NoStackExecute,
910 &&NoStackCall, &&NoStackDExecute, &&NoStackDeallocate,
911 &&notrailleft, &&NoStackFail, &&NoStackCommitX};
912 curtrace = NULL;
913 curpreg = NULL;
914 globalcurblock = NULL;
915 ineedredefinedest = 0;
916 NativeArea = (NativeContext *)malloc(sizeof(NativeContext));
917 NativeArea->area.p = NULL;
918 NativeArea->area.ok = NULL;
919 NativeArea->area.pc = NULL;
920#if YAP_STAT_PREDS
921 NativeArea->area.nrecomp = NULL;
922 NativeArea->area.compilation_time = NULL;
923 NativeArea->area.native_size_bytes = NULL;
924 NativeArea->area.trace_size_bytes = NULL;
925 NativeArea->success = NULL;
926 NativeArea->runs = NULL;
927 NativeArea->t_runs = NULL;
928#endif
929 NativeArea->n = 0;
930 IntermediatecodeArea =
931 (IntermediatecodeContext *)malloc(sizeof(IntermediatecodeContext));
932 IntermediatecodeArea->area.t = NULL;
933 IntermediatecodeArea->area.ok = NULL;
934 IntermediatecodeArea->area.isactive = NULL;
935 IntermediatecodeArea->area.lastblock = NULL;
936#if YAP_STAT_PREDS
937 IntermediatecodeArea->area.profiling_time = NULL;
938#endif
939 IntermediatecodeArea->n = 0;
940 nnexec = 0;
941 l = 0;
942#endif /* YAP_JIT */
943
944#if USE_THREADED_CODE
945 /************************************************************************/
946 /* Abstract Machine Instruction Address Table */
947 /* This must be declared inside the function. We use the asm directive */
948 /* to make it available outside this function */
949 /************************************************************************/
950 static void *OpAddress[] = {
951#define OPCODE(OP, TYPE) &&_##OP
952#include "YapOpcodes.h"
953#undef OPCODE
954 };
955
956#if YAP_JIT
957 ExpEnv.config_struc.TOTAL_OF_OPCODES =
958 sizeof(OpAddress) / (2 * sizeof(void *));
959#endif
960
961#endif /* USE_THREADED_CODE */
962
963 /*static void* (*nat_glist_valx)(yamop**,yamop**,CELL**,void**,int*);
964
965 if (nat_glist_valx == NULL) {
966 nat_glist_valx =
967 (void*(*)(yamop**,yamop**,CELL**,void**,int*))call_JIT_Compiler(J,
968 _glist_valx);
969 }*/
970
971#ifdef SHADOW_REGS
972
973 /* work with a local pointer to the registers */
974 register REGSTORE *regp = &Yap_REGS;
975
976#endif /* SHADOW_REGS */
977
978#if PUSH_REGS
979
980 /* useful on a X86 with -fomit-frame-pointer optimisation */
981 /* The idea is to push REGS onto the X86 stack frame */
982
983 /* first allocate local space */
984 REGSTORE absmi_regs;
985 REGSTORE *old_regs = Yap_regp;
986
987#endif /* PUSH_REGS */
988
989#ifdef BEAM
990 CELL OLD_B = B;
991 extern PredEntry *bpEntry;
992 if (inp == -9000) {
993#if PUSH_REGS
994 old_regs = &Yap_REGS;
995 init_absmi_regs(&absmi_regs);
996#if THREADS
997 regcache = Yap_regp LOCAL_PL_local_data_p->reg_cache = regcache;
998#else
999 Yap_regp = &absmi_regs;
1000#endif
1001#endif
1002 CACHE_A1();
1003 PREG = bpEntry->CodeOfPred;
1004 JMPNext(); /* go execute instruction at PREG */
1005 }
1006
1007#endif
1008
1009#if USE_THREADED_CODE
1010 /* absmadr */
1011 if (inp > 0) {
1012 Yap_ABSMI_OPCODES = OpAddress;
1013#if YAP_JIT
1014 Yap_ABSMI_ControlLabels = control_labels;
1015#endif
1016#if BP_FREE
1017 P1REG = PCBACKUP;
1018#endif
1019 return (0);
1020 }
1021#endif /* USE_THREADED_CODE */
1022
1023#if PUSH_REGS /* */
1024 old_regs = &Yap_REGS; /* */
1025
1026 /* done, let us now initialize this space */
1027 init_absmi_regs(&absmi_regs);
1028
1029 /* the registers are all set up, let's swap */
1030#ifdef THREADS
1031 pthread_setspecific(Yap_yaamregs_key, (const void *)&absmi_regs);
1032 LOCAL_ThreadHandle.current_yaam_regs = &absmi_regs;
1033 regcache = &absmi_regs;
1034 // LOCAL_PL_local_data_p->reg_cache = regcache;
1035#else
1036 Yap_regp = &absmi_regs;
1037#endif
1038#undef Yap_REGS
1039#define Yap_REGS absmi_regs
1040
1041#endif /* PUSH_REGS */
1042
1043#ifdef SHADOW_REGS
1044
1045 /* use regp as a copy of REGS */
1046 regp = &Yap_REGS;
1047
1048#ifdef REGS
1049#undef REGS
1050#endif
1051#define REGS (*regp)
1052
1053#endif /* SHADOW_REGS */
1054
1055 setregs();
1056
1057 CACHE_A1();
1058
1059 reset_absmi:
1060
1061 SP = SP0;
1062
1063#if USE_THREADED_CODE
1064 //___androidlog_print(ANDROID_LOG_INFO, "YAP ", "%s",
1065 // Yap_op_names[Yap_op_from_opcode(PREG->opc)]);
1066
1067 JMPNext(); /* go execute instruction at P */
1068
1069#else
1070 /* when we start we are not in write mode */
1071
1072 {
1073 op_numbers opcode = _Ystop;
1074 op_numbers old_op;
1075#ifdef DEBUG_XX
1076 unsigned long ops_done;
1077#endif
1078
1079 goto nextop;
1080
1081 nextop_write:
1082
1083 old_op = opcode;
1084 opcode = PREG->y_u.o.opcw;
1085 goto op_switch;
1086
1087 nextop:
1088
1089 old_op = opcode;
1090 opcode = PREG->opc;
1091
1092 op_switch:
1093
1094#ifdef ANALYST
1095 GLOBAL_opcount[opcode]++;
1096 GLOBAL_2opcount[old_op][opcode]++;
1097#ifdef DEBUG_XX
1098 ops_done++;
1099 /* if (B->cp_b > 0x103fff90)
1100 fprintf(stderr,"(%ld) doing %s, done %s, B is %p, HB is %p, H is %p\n",
1101 ops_done,Yap_op_names[opcode],Yap_op_names[old_op],B,B->cp_h,HR);*/
1102#endif
1103#endif /* ANALYST */
1104
1105 switch (opcode) {
1106#endif /* USE_THREADED_CODE */
1107
1108#if !OS_HANDLES_TR_OVERFLOW
1109 notrailleft:
1110 /* if we are within indexing code, the system may have to
1111 * update a S */
1112 {
1113 CELL cut_b;
1114
1115#ifdef SHADOW_S
1116 S = SREG;
1117#endif
1118 /* YREG was pointing to where we were going to build the
1119 * next choice-point. The stack shifter will need to know this
1120 * to move the local stack */
1121 SET_ASP(YREG, E_CB);
1122 cut_b = LCL0 - (CELL *)(ASP[E_CB]);
1123 saveregs();
1124 if (!Yap_growtrail(0, false)) {
1125 Yap_ThrowError(RESOURCE_ERROR_TRAIL,
1126 TermNil,
1127 "YAP failed to reserve %ld bytes in growtrail",
1128 sizeof(CELL) * K16);
1129 setregs();
1130 FAIL();
1131 }
1132 setregs();
1133#ifdef SHADOW_S
1134 SREG = S;
1135#endif
1136 if (SREG == ASP) {
1137 SREG[E_CB] = (CELL)(LCL0 - cut_b);
1138 }
1139 }
1140 goto reset_absmi;
1141
1142#endif /* OS_HANDLES_TR_OVERFLOW */
1143
1144 // move instructions to separate file
1145 // so that they are easier to analyse.
1146
1147 #include "absmi_insts.h"
1148
1149#if !USE_THREADED_CODE
1150 default:
1151 saveregs();
1152 Yap_Error(SYSTEM_ERROR_INTERNAL, MkIntegerTerm(opcode),
1153 "trying to execute invalid YAAM instruction %d", opcode);
1154 setregs();
1155 FAIL();
1156 }
1157 }
1158#else
1159
1160#if PUSH_REGS
1161 restore_absmi_regs(old_regs);
1162
1163#endif
1164
1165#if BP_FREE
1166 P1REG = PCBACKUP;
1167#endif
1168
1169 return (0);
1170#endif
1171}
1172
1173/* dummy function that is needed for profiler */
1174int Yap_absmiEND(void) { return 1; }
1175
gc_entry_info
Definition: heapgc.h:272
pred_entry
Definition: Yatom.h:544
regstore_t
Definition: Regs.h:94
yami
Definition: amidefs.h:264