YAP 7.1.0
amasm.c
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: amasm.c *
12* comments: abstract machine assembler *
13* *
14* Last rev: $Date: 2008-08-12 01:27:22 $
15**
16* $Log: not supported by cvs2svn $
17* Revision 1.103 2008/08/07 20:51:16 vsc
18* more threadin fixes
19*
20* Revision 1.102 2008/07/11 17:02:07 vsc
21* fixes by Bart and Tom: mostly libraries but nasty one in indexing
22* compilation.
23*
24* Revision 1.101 2008/04/01 22:28:41 vsc
25* put YAPOR back to life.
26*
27* Revision 1.100 2008/03/25 16:45:52 vsc
28* make or-parallelism compile again
29*
30* Revision 1.99 2008/01/23 17:57:44 vsc
31* valgrind it!
32* enable atom garbage collection.
33*
34* Revision 1.98 2007/11/26 23:43:07 vsc
35* fixes to support threads and assert correctly, even if inefficiently.
36*
37* Revision 1.97 2007/11/07 09:25:27 vsc
38* speedup meta-calls
39*
40* Revision 1.96 2007/11/06 17:02:09 vsc
41* compile ground terms away.
42*
43* Revision 1.95 2007/06/23 17:31:50 vsc
44* pin cluses with floats.
45*
46* Revision 1.94 2006/12/27 01:32:37 vsc
47* diverse fixes
48*
49* Revision 1.93 2006/12/13 16:10:14 vsc
50* several debugger and CLP(BN) improvements.
51*
52* Revision 1.92 2006/11/15 00:13:36 vsc
53* fixes for indexing code.
54*
55* Revision 1.91 2006/11/06 18:35:03 vsc
56* 1estranha
57*
58* Revision 1.90 2006/10/11 14:53:57 vsc
59* fix memory leak
60* fix overflow handling
61* VS: ----------------------------------------------------------------------
62*
63* Revision 1.89 2006/10/10 14:08:16 vsc
64* small fixes on threaded implementation.
65*
66* Revision 1.88 2006/09/20 20:03:51 vsc
67* improve indexing on floats
68* fix sending large lists to DB
69*
70* Revision 1.87 2006/03/24 17:13:41 rslopes
71* New update to BEAM engine.
72* BEAM now uses YAP Indexing (JITI)
73*
74* Revision 1.86 2006/01/02 02:16:17 vsc
75* support new interface between YAP and GMP, so that we don't rely on our own
76* allocation routines.
77* Several big fixes.
78*
79* Revision 1.85 2005/12/17 03:25:39 vsc
80* major changes to support online event-based profiling
81* improve error discovery and restart on scanner.
82*
83* Revision 1.84 2005/09/08 22:06:44 rslopes
84* BEAM for YAP update...
85*
86* Revision 1.83 2005/08/02 03:09:49 vsc
87* fix debugger to do well nonsource predicates.
88*
89* Revision 1.82 2005/07/06 15:10:02 vsc
90* improvements to compiler: merged instructions and fixes for ->
91*
92* Revision 1.81 2005/06/01 21:23:44 vsc
93* inline compare
94*
95* Revision 1.80 2005/06/01 20:25:23 vsc
96* == and \= should not need a choice-point in ->
97*
98* Revision 1.79 2005/06/01 16:42:30 vsc
99* put switch_list_nl back
100*
101* Revision 1.78 2005/06/01 14:02:47 vsc
102* get_rid of try_me?, retry_me? and trust_me? instructions: they are not
103* significantly used nowadays.
104*
105* Revision 1.77 2005/05/31 19:42:27 vsc
106* insert some more slack for indices in LU
107* Use doubly linked list for LU indices so that updating is less cumbersome.
108*
109* Revision 1.76 2005/05/30 05:33:43 vsc
110* get rid of annoying debugging message.
111*
112* Revision 1.75 2005/05/30 05:26:49 vsc
113* fix tabling
114* allow atom gc again for now.
115*
116* Revision 1.74 2005/05/25 21:43:32 vsc
117* fix compiler bug in 1 << X, found by Nuno Fonseca.
118* compiler internal errors get their own message.
119*
120* Revision 1.73 2005/04/10 04:01:09 vsc
121* bug fixes, I hope!
122*
123* Revision 1.72 2005/03/04 20:30:10 ricroc
124* bug fixes for YapTab support
125*
126* Revision 1.71 2005/01/28 23:14:34 vsc
127* move to Yap-4.5.7
128* Fix clause size
129*
130* Revision 1.70 2004/12/28 22:20:35 vsc
131* some extra bug fixes for trail overflows: some cannot be recovered that
132*easily,
133* some can.
134*
135* Revision 1.69 2004/12/20 21:44:56 vsc
136* more fixes to CLPBN
137* fix some Yap overflows.
138*
139* Revision 1.68 2004/12/07 16:54:57 vsc
140* fix memory overflow
141*
142* Revision 1.67 2004/12/05 05:01:23 vsc
143* try to reduce overheads when running with goal expansion enabled.
144* CLPBN fixes
145* Handle overflows when allocating big clauses properly.
146*
147* Revision 1.66 2004/11/19 22:08:41 vsc
148* replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever
149*appropriate.
150*
151* Revision 1.65 2004/10/26 20:15:48 vsc
152* More bug fixes for overflow handling
153*
154* Revision 1.64 2004/09/30 21:37:40 vsc
155* fixes for thread support
156*
157* Revision 1.63 2004/09/27 20:45:02 vsc
158* Mega clauses
159* Fixes to sizeof(expand_clauses) which was being overestimated
160* Fixes to profiling+indexing
161* Fixes to reallocation of memory after restoring
162* Make sure all clauses, even for C, end in _Ystop
163* Don't reuse space for Streams
164* Fix Stream_F on StreaNo+1
165*
166* Revision 1.62 2004/08/20 16:16:23 vsc
167* growheap was not checking some compiler instructions
168* source was getting confused in reconsult
169*
170* Revision 1.61 2004/04/29 03:45:50 vsc
171* fix garbage collection in execute_tail
172*
173* Revision 1.60 2004/04/22 20:07:04 vsc
174* more fixes for USE_SYSTEM_MEMORY
175*
176* Revision 1.59 2004/03/31 01:03:09 vsc
177* support expand group of clauses
178*
179* Revision 1.58 2004/03/10 14:59:55 vsc
180* optimise -> for type tests
181* *
182* *
183*************************************************************************/
184#ifdef SCCS
185static char SccsId[] = "@(#)amasm.c 1.3 3/15/90";
186
187#endif
188
189#include "Yap.h"
190#include "clause.h"
191#include "YapCompile.h"
192#include "yapio.h"
193
194#ifdef BEAM
195#include "eam.h"
196#endif
197#ifdef YAPOR
198#include "or.macros.h"
199#endif /* YAPOR */
200#if HAVE_STRING_H
201#include <string.h>
202#endif
203
204/* info on compare built-ins */
205#define TYPE_XX 0
206#define TYPE_CX 1
207#define TYPE_XC 2
208
209typedef struct cmp_op_info_struct {
210 wamreg x1_arg, x2_arg;
211 Int c_arg;
212 int c_type;
213 struct clause_info_struct *cl_info;
214} cmp_op_info;
215
216typedef struct clause_info_struct {
217 int alloc_found, dealloc_found;
218 struct pred_entry *CurrentPred;
219} clause_info;
220
221static OPREG Var_Ref(Ventry *, int);
222static wamreg emit_xreg(CELL);
223static yslot emit_yreg(CELL);
224static wamreg emit_x(CELL);
225static yslot emit_y(Ventry *);
226static yamop *emit_a(CELL);
227static CELL *emit_bmlabel(CELL, struct intermediates *);
228static yamop *emit_ilabel(CELL, struct intermediates *);
229static Functor emit_f(CELL);
230static CELL emit_c(CELL);
231static COUNT emit_count(CELL);
232static OPCODE emit_op(op_numbers);
233static yamop *a_cle(op_numbers, yamop *, int, struct intermediates *);
234static yamop *a_e(op_numbers, yamop *, int);
235static yamop *a_ue(op_numbers, op_numbers, yamop *, int);
236static yamop *a_v(op_numbers, op_numbers, yamop *, int, struct PSEUDO *);
237static yamop *a_uv(Ventry *, op_numbers, op_numbers, op_numbers, op_numbers,
238 yamop *, int);
239static yamop *a_vr(op_numbers, op_numbers, yamop *, int,
240 struct intermediates *);
241static yamop *a_rv(op_numbers, op_numbers, OPREG, yamop *, int,
242 struct PSEUDO *);
243static yamop *a_vv(op_numbers, op_numbers, yamop *, int,
244 struct intermediates *);
245static yamop *a_glist(int *, yamop *, int, struct intermediates *);
246static void a_pair(CELL *, int, struct intermediates *);
247static yamop *a_f(CELL, op_numbers, yamop *, int);
248static yamop *a_c(CELL, op_numbers, yamop *, int);
249static yamop *a_uc(CELL, op_numbers, op_numbers, yamop *, int);
250static yamop *a_n(op_numbers, int, yamop *, int);
251static yamop *a_un(op_numbers, op_numbers, int, yamop *, int);
252static yamop *a_nc(CELL, op_numbers, int, yamop *, int);
253static yamop *a_unc(CELL, op_numbers, op_numbers, int, yamop *, int);
254static yamop *a_r(CELL, op_numbers, yamop *, int);
255static yamop *a_p(op_numbers, clause_info *, yamop *, int,
256 struct intermediates *);
257static yamop *a_pl(op_numbers, PredEntry *, yamop *, int);
258static yamop *a_l(CELL, op_numbers, yamop *, int, struct intermediates *);
259static yamop *a_hx(op_numbers, union clause_obj *, int, yamop *, int,
260 struct intermediates *);
261static yamop *a_if(op_numbers, union clause_obj *, int, yamop *, int,
262 struct intermediates *cip);
263static yamop *a_cut(clause_info *, yamop *, int, struct intermediates *);
264#ifdef YAPOR
265static yamop *a_try(op_numbers, CELL, CELL, int, int, yamop *, int,
266 struct intermediates *);
267static yamop *a_either(op_numbers, CELL, CELL, int, yamop *, int,
268 struct intermediates *);
269#else
270static yamop *a_try(op_numbers, CELL, CELL, yamop *, int,
271 struct intermediates *);
272static yamop *a_either(op_numbers, CELL, CELL, yamop *, int,
273 struct intermediates *);
274#endif /* YAPOR */
275static yamop *a_gl(op_numbers, yamop *, int, struct PSEUDO *,
276 struct intermediates *CACHE_TYPE);
277static COUNT compile_cmp_flags(unsigned char *);
278static yamop *a_igl(CELL, op_numbers, yamop *, int, struct intermediates *);
279static yamop *a_xigl(op_numbers, yamop *, int, struct PSEUDO *);
280static yamop *a_ucons(int *, compiler_vm_op, yamop *, int,
281 struct intermediates *);
282static yamop *a_uvar(yamop *, int, struct intermediates *);
283static yamop *a_wvar(yamop *, int, struct intermediates *);
284static yamop *do_pass(int, yamop **, int, int *, int *, struct intermediates *,
285 UInt CACHE_TYPE);
286#ifdef DEBUG_OPCODES
287static void DumpOpCodes(void);
288#endif
289#ifdef SFUNC
290static void a_vsf(int, yamop *, int, struct PSEUDO *);
291static void a_asf(int, yamop *, int, struct PSEUDO *);
292#endif
293static yamop *check_alloc(clause_info *, yamop *, int, struct intermediates *);
294static yamop *a_deallocate(clause_info *, yamop *, int, struct intermediates *);
295static yamop *a_bmap(yamop *, int, struct PSEUDO *);
296static void a_fetch_vv(cmp_op_info *, int, struct intermediates *);
297static void a_fetch_cv(cmp_op_info *, int, struct intermediates *);
298static void a_fetch_vc(cmp_op_info *, int, struct intermediates *);
299static yamop *a_f2(cmp_op_info *, yamop *, int, struct intermediates *);
300
301profile_data *Yap_initProfiler(PredEntry *p) {
302 profile_data *ptr;
303 if (p->StatisticsForPred)
304 return p->StatisticsForPred;
305 if ((ptr = (profile_data *)Yap_AllocCodeSpace(sizeof(profile_data))) ==
306 NULL) {
307 return NULL;
308 }
309 INIT_LOCK(ptr->lock);
310 ptr->NOfEntries = 0;
311 ptr->NOfHeadSuccesses = 0;
312 ptr->NOfRetries = 0;
313 p->StatisticsForPred = ptr;
314 return ptr;
315}
316
317#define GONEXT(TYPE) code_p = ((yamop *)(&(code_p->y_u.TYPE.next)))
318
319inline static yslot emit_y(Ventry *ve) {
320#if MSHIFTOFFS
321 return (-FixedEnvSize - ((ve->NoOfVE) & MaskVarAdrs) - 1);
322#else
323 return (-FixedEnvSize - (((ve->NoOfVE) & MaskVarAdrs) * CELLSIZE) - CELLSIZE);
324#endif
325}
326
327inline static OPREG Var_Ref(Ventry *ve, int is_y_var) {
328 if (is_y_var) {
329#if MSHIFTOFFS
330 return -FixedEnvSize - ((ve->NoOfVE) & MaskVarAdrs) - 1;
331#else
332 return -FixedEnvSize - (((ve->NoOfVE) & MaskVarAdrs) * CELLSIZE) - CELLSIZE;
333#endif
334 } else {
335#if PRECOMPUTE_REGADDRESS
336 return (CELL)(XREGS + ((ve->NoOfVE) & MaskVarAdrs));
337#else
338#if MSHIFTOFFS
339 return ((ve->NoOfVE) & MaskVarAdrs);
340#else
341 return CELLSIZE * ((ve->NoOfVE) & MaskVarAdrs);
342#endif
343#endif /* PRECOMPUTE_REGADDRESS */
344 }
345}
346
347#define is_void_var() (((Ventry *)(cip->cpc->rnd1))->KindOfVE == VoidVar)
348#define is_a_void(X) (((Ventry *)(X))->KindOfVE == VoidVar)
349
350#define is_temp_var() (((Ventry *)(cip->cpc->rnd1))->KindOfVE == TempVar)
351#define is_atemp_var(p) (((Ventry *)(p->rnd1))->KindOfVE == TempVar)
352
353#define no_ref_var() (((Ventry *)(cip->cpc->rnd1))->NoOfVE == 1)
354#define no_ref(X) (((Ventry *)(X))->NoOfVE == 1)
355
356inline static yamop *fill_a(CELL a, yamop *code_p, int pass_no) {
357 CELL *ptr = ((CELL *)(code_p));
358
359 if (pass_no)
360 *ptr = a;
361 return (yamop *)(++ptr);
362}
363
364inline static wamreg emit_xreg(CELL w) { return (wamreg)w; }
365
366inline static yslot emit_yreg(CELL w) { return (yslot)w; }
367
368inline static wamreg emit_x(CELL xarg) {
369#if PRECOMPUTE_REGADDRESS
370 return (emit_xreg((CELL)(XREGS + xarg)));
371#else
372#if MSHIFTOFFS
373 return (emit_xreg(xarg));
374#else
375 return (emit_xreg(CELLSIZE * (xarg)));
376#endif
377#endif /* PRECOMPUTE_REGADDRESS */
378}
379
380wamreg Yap_emit_x(CELL xarg) { return emit_x(xarg); }
381
382inline static yamop *emit_a(CELL a) { return ((yamop *)(a)); }
383
384inline static struct pred_entry *emit_pe(struct pred_entry *a) { return a; }
385
386inline static yamop *emit_ilabel(register CELL addr,
387 struct intermediates *cip) {
388 if (addr & 1)
389 return (emit_a(Unsigned(cip->code_addr) + cip->label_offset[addr]));
390 else {
391 return (emit_a(addr));
392 }
393}
394
395inline static CELL *emit_bmlabel(register CELL addr,
396 struct intermediates *cip) {
397 return (CELL *)(emit_a(Unsigned(cip->code_addr) + cip->label_offset[addr]));
398}
399
400inline static Functor emit_f(CELL a) { return (Functor)(a); }
401
402inline static CELL emit_c(CELL a) { return a; }
403
404static inline COUNT emit_count(CELL count) { return count; }
405
406#ifdef DEBUG_OPCODES
407inline static void DumpOpCodes(void) {
408 int i = 0, j;
409
410 while (i < 30) {
411 for (j = i; j <= _std_top; j += 25)
412 fprintf(GLOBAL_stderr, "%5d %6lx", j, absmadr(j));
413 fputc('\n', GLOBAL_stderr);
414 ++i;
415 }
416}
417#endif
418
419static inline OPCODE emit_op(op_numbers op) { return absmadr((Int)op); }
420
421static OPCODE opcode(op_numbers op) { return (emit_op(op)); }
422
423OPCODE
424Yap_opcode(op_numbers op) { return opcode(op); }
425
426static void add_clref(CELL clause_code, int pass_no) {
427 if (pass_no) {
428 LogUpdClause *cl = ClauseCodeToLogUpdClause(clause_code);
429 cl->ClRefCount++;
430 }
431}
432
433static void add_to_dbtermsl(struct intermediates *cip, Term t) {
434 DBTerm *dbt = TermToDBTerm(t);
435 dbt->ag.NextDBT = cip->dbterml->dbterms;
436 cip->dbterml->dbterms = dbt;
437}
438
439static yamop *a_lucl(op_numbers opcode, yamop *code_p, int pass_no,
440 struct intermediates *cip, clause_info *cla) {
441 if (pass_no) {
442 LogUpdIndex *lcl = (LogUpdIndex *)cip->code_addr;
443 code_p->opc = emit_op(opcode);
444 code_p->y_u.Illss.I = lcl;
445 cip->cpc->rnd4 = (CELL)code_p;
446 cip->current_try_lab = &code_p->y_u.Illss.l1;
447 cip->current_trust_lab = &code_p->y_u.Illss.l2;
448 code_p->y_u.Illss.l1 = NULL;
449 code_p->y_u.Illss.l2 = NULL;
450 code_p->y_u.Illss.s = cip->cpc->rnd3;
451 code_p->y_u.Illss.e = 0;
452 }
453 GONEXT(Illss);
454 return code_p;
455}
456
457static yamop *a_cle(op_numbers opcode, yamop *code_p, int pass_no,
458 struct intermediates *cip) {
459 if (pass_no) {
460 LogUpdClause *cl = (LogUpdClause *)cip->code_addr;
461
462 code_p->opc = emit_op(opcode);
463 code_p->y_u.L.ClBase = cl;
464 cl->ClExt = code_p;
465 cl->ClFlags |= LogUpdRuleMask;
466 }
467 GONEXT(L);
468 return code_p;
469}
470
471inline static yamop *a_e(op_numbers opcode, yamop *code_p, int pass_no) {
472 if (pass_no) {
473 code_p->opc = emit_op(opcode);
474 }
475 GONEXT(e);
476 return code_p;
477}
478
479inline static yamop *a_p0(op_numbers opcode, yamop *code_p, int pass_no,
480 PredEntry *p0) {
481 if (pass_no) {
482 code_p->opc = emit_op(opcode);
483 code_p->y_u.p.p = p0;
484 }
485 GONEXT(p);
486 return code_p;
487}
488
489inline static yamop *a_lp(op_numbers opcode, yamop *code_p, int pass_no,
490 struct intermediates *cip) {
491 if (pass_no) {
492 code_p->opc = emit_op(opcode);
493 code_p->y_u.lp.p = (PredEntry *)cip->cpc->rnd1;
494 code_p->y_u.lp.l = (yamop *)cip->cpc->rnd2;
495 }
496 GONEXT(lp);
497 return code_p;
498}
499
500inline static yamop *a_ue(op_numbers opcode, op_numbers opcodew, yamop *code_p,
501 int pass_no) {
502 if (pass_no) {
503 code_p->opc = emit_op(opcode);
504 code_p->y_u.o.opcw = emit_op(opcodew);
505 }
506 GONEXT(o);
507 return code_p;
508}
509
510inline static yamop *emit_fail(struct intermediates *cip) {
511 if (cip->failure_handler) {
512 return emit_a(Unsigned(cip->code_addr) +
513 cip->label_offset[cip->failure_handler]);
514 } else {
515 return FAILCODE;
516 }
517}
518
519inline static yamop *a_v(op_numbers opcodex, op_numbers opcodey, yamop *code_p,
520 int pass_no, struct PSEUDO *cpc) {
521 Ventry *ve = (Ventry *)cpc->rnd1;
522 OPREG var_offset;
523 int is_y_var = (ve->KindOfVE == PermVar);
524
525 var_offset = Var_Ref(ve, is_y_var);
526 if (is_y_var) {
527 if (pass_no) {
528 code_p->opc = emit_op(opcodey);
529 code_p->y_u.y.y = emit_yreg(var_offset);
530 }
531 GONEXT(y);
532 } else {
533 if (pass_no) {
534 code_p->opc = emit_op(opcodex);
535 code_p->y_u.x.x = emit_xreg(var_offset);
536 }
537 GONEXT(x);
538 }
539 return code_p;
540}
541
542inline static yamop *a_vp(op_numbers opcodex, op_numbers opcodey, yamop *code_p,
543 int pass_no, struct PSEUDO *cpc,
544 clause_info *clinfo) {
545 Ventry *ve = (Ventry *)cpc->rnd1;
546 OPREG var_offset;
547 int is_y_var = (ve->KindOfVE == PermVar);
548
549 var_offset = Var_Ref(ve, is_y_var);
550 if (is_y_var) {
551 if (pass_no) {
552 code_p->opc = emit_op(opcodey);
553 code_p->y_u.yps.y = emit_yreg(var_offset);
554 code_p->y_u.yps.p0 = clinfo->CurrentPred;
555 code_p->y_u.yps.s = -Signed(RealEnvSize) - CELLSIZE * cpc->rnd2;
556 }
557 GONEXT(yps);
558 } else {
559 if (pass_no) {
560 code_p->opc = emit_op(opcodex);
561 code_p->y_u.xps.x = emit_xreg(var_offset);
562 code_p->y_u.xps.p0 = clinfo->CurrentPred;
563 code_p->y_u.xps.s = -Signed(RealEnvSize) - CELLSIZE * cpc->rnd2;
564 }
565 GONEXT(xps);
566 }
567 return code_p;
568}
569
570inline static yamop *a_uv(Ventry *ve, op_numbers opcodex, op_numbers opcodexw,
571 op_numbers opcodey, op_numbers opcodeyw,
572 yamop *code_p, int pass_no) {
573 OPREG var_offset;
574 int is_y_var = (ve->KindOfVE == PermVar);
575
576 var_offset = Var_Ref(ve, is_y_var);
577 if (is_y_var) {
578 if (pass_no) {
579 code_p->opc = emit_op(opcodey);
580 code_p->y_u.oy.opcw = emit_op(opcodeyw);
581 code_p->y_u.oy.y = emit_yreg(var_offset);
582 }
583 GONEXT(oy);
584 } else {
585 if (pass_no) {
586 code_p->opc = emit_op(opcodex);
587 code_p->y_u.ox.opcw = emit_op(opcodexw);
588 code_p->y_u.ox.x = emit_xreg(var_offset);
589 }
590 GONEXT(ox);
591 }
592 return code_p;
593}
594
595inline static yamop *a_vv(op_numbers opcode, op_numbers opcodew, yamop *code_p,
596 int pass_no, struct intermediates *cip) {
597 Ventry *ve = (Ventry *)cip->cpc->rnd1;
598 int is_y_var = (ve->KindOfVE == PermVar);
599
600 if (pass_no) {
601 OPREG var_offset = Var_Ref(ve, is_y_var);
602 code_p->opc = emit_op(opcode);
603 code_p->y_u.oxx.opcw = emit_op(opcodew);
604 code_p->y_u.oxx.xl = emit_xreg(var_offset);
605 }
606 cip->cpc = cip->cpc->nextInst;
607 if (pass_no) {
608 OPREG var_offset;
609 int is_y_var;
610
611 ve = (Ventry *)cip->cpc->rnd1;
612 is_y_var = (ve->KindOfVE == PermVar);
613 var_offset = Var_Ref(ve, is_y_var);
614 code_p->y_u.oxx.xr = emit_xreg(var_offset);
615 }
616 GONEXT(oxx);
617 return code_p;
618}
619
620inline static yamop *a_vr(op_numbers opcodex, op_numbers opcodey, yamop *code_p,
621 int pass_no, struct intermediates *cip) {
622 struct PSEUDO *cpc = cip->cpc;
623 Ventry *ve = (Ventry *)cpc->rnd1;
624 int is_y_var = (ve->KindOfVE == PermVar);
625
626 if (is_y_var) {
627 if (opcodey == _put_y_val) {
628 struct PSEUDO *ncpc = cpc->nextInst;
629 if (ncpc->op == put_val_op &&
630 ((Ventry *)ncpc->rnd1)->KindOfVE == PermVar) {
631 /* peephole! two put_y_vars in a row */
632 if (pass_no) {
633 OPREG var_offset;
634 OPREG var_offset2;
635 Ventry *ve2 = (Ventry *)ncpc->rnd1;
636
637 var_offset = Var_Ref(ve, is_y_var);
638 code_p->opc = emit_op(_put_y_vals);
639 code_p->y_u.yyxx.y1 = emit_yreg(var_offset);
640 code_p->y_u.yyxx.x1 = emit_x(cpc->rnd2);
641 var_offset2 = Var_Ref(ve2, is_y_var);
642 code_p->y_u.yyxx.y2 = emit_yreg(var_offset2);
643 code_p->y_u.yyxx.x2 = emit_x(ncpc->rnd2);
644 }
645 cip->cpc = ncpc;
646 GONEXT(yyxx);
647 return code_p;
648 /* simplify unification code */
649 } else if (FALSE && cpc->rnd2 == 0 && ncpc->op == get_var_op &&
650 ncpc->rnd2 == 0 &&
651 ((Ventry *)ncpc->rnd1)->KindOfVE != PermVar) {
652 if (pass_no) {
653 OPREG var_offset;
654 OPREG var_offset2;
655 Ventry *ve2 = (Ventry *)ncpc->rnd1;
656
657 code_p->opc = emit_op(_put_y_var);
658 var_offset = Var_Ref(ve, is_y_var);
659 var_offset2 = Var_Ref(ve2, !is_y_var);
660 code_p->y_u.yx.x = emit_xreg(var_offset2);
661 code_p->y_u.yx.y = emit_yreg(var_offset);
662 }
663 cip->cpc = ncpc;
664 GONEXT(yx);
665 return code_p;
666 }
667 } else if (opcodey == _get_y_var) {
668 struct PSEUDO *ncpc = cpc->nextInst;
669 if (ncpc->op == get_var_op &&
670 ((Ventry *)ncpc->rnd1)->KindOfVE == PermVar) {
671 /* peephole! two put_y_vars in a row */
672 if (pass_no) {
673 OPREG var_offset;
674 OPREG var_offset2;
675 Ventry *ve2 = (Ventry *)ncpc->rnd1;
676
677 var_offset = Var_Ref(ve, is_y_var);
678 code_p->opc = emit_op(_get_yy_var);
679 code_p->y_u.yyxx.y1 = emit_yreg(var_offset);
680 code_p->y_u.yyxx.x1 = emit_x(cpc->rnd2);
681 var_offset2 = Var_Ref(ve2, is_y_var);
682 code_p->y_u.yyxx.y2 = emit_yreg(var_offset2);
683 code_p->y_u.yyxx.x2 = emit_x(ncpc->rnd2);
684 }
685 cip->cpc = ncpc;
686 GONEXT(yyxx);
687 return code_p;
688 }
689 }
690 if (pass_no) {
691 OPREG var_offset;
692 var_offset = Var_Ref(ve, is_y_var);
693 code_p->opc = emit_op(opcodey);
694 code_p->y_u.yx.y = emit_yreg(var_offset);
695 code_p->y_u.yx.x = emit_x(cpc->rnd2);
696 }
697 GONEXT(yx);
698 return code_p;
699 }
700 if (opcodex == _put_x_val && cpc->nextInst) {
701 if (cpc->nextInst->op == put_val_op &&
702 !(((Ventry *)cpc->nextInst->rnd1)->KindOfVE == PermVar)) {
703 PInstr *ncpc = cpc->nextInst;
704 /* peephole! two put_x_vars in a row */
705 if (pass_no) {
706 OPREG var_offset;
707 OPREG var_offset2;
708 Ventry *ve2 = (Ventry *)ncpc->rnd1;
709
710 var_offset = Var_Ref(ve, is_y_var);
711 code_p->opc = emit_op(_put_xx_val);
712 code_p->y_u.xxxx.xl1 = emit_xreg(var_offset);
713 code_p->y_u.xxxx.xr1 = emit_x(cpc->rnd2);
714 var_offset2 = Var_Ref(ve2, is_y_var);
715 code_p->y_u.xxxx.xl2 = emit_xreg(var_offset2);
716 code_p->y_u.xxxx.xr2 = emit_x(ncpc->rnd2);
717 }
718 cip->cpc = ncpc;
719 GONEXT(xxxx);
720 return code_p;
721 /* simplify unification */
722 } else if (cpc->rnd2 == 0 && cpc->nextInst->rnd2 == 0) {
723 OPREG var_offset;
724 OPREG var_offset2;
725 Ventry *ve2;
726 int is_y_var2;
727 PInstr *ncpc;
728
729 ncpc = cpc->nextInst;
730 ve2 = (Ventry *)ncpc->rnd1;
731 is_y_var2 = (ve2->KindOfVE == PermVar);
732 /* put + get */
733 if (ncpc->op == get_var_op || ncpc->op == get_val_op) {
734 if (is_y_var2) {
735 if (pass_no) {
736 var_offset = Var_Ref(ve, is_y_var);
737 var_offset2 = Var_Ref(ve2, is_y_var2);
738 if (ncpc->op == get_var_op)
739 code_p->opc = emit_op(_get_y_var);
740 else
741 code_p->opc = emit_op(_get_y_val);
742 code_p->y_u.yx.x = emit_xreg(var_offset);
743 code_p->y_u.yx.y = emit_yreg(var_offset2);
744 }
745 GONEXT(yx);
746 cip->cpc = ncpc;
747 return code_p;
748 } else {
749 if (pass_no) {
750 var_offset = Var_Ref(ve, is_y_var);
751 var_offset2 = Var_Ref(ve2, is_y_var2);
752 code_p->y_u.xx.xl = emit_xreg(var_offset);
753 code_p->y_u.xx.xr = emit_xreg(var_offset2);
754 if (ncpc->op == get_var_op)
755 code_p->opc = emit_op(_put_x_val);
756 else {
757 code_p->opc = emit_op(_get_x_val);
758 }
759 }
760 GONEXT(xx);
761 cip->cpc = ncpc;
762 return code_p;
763 }
764 }
765 }
766 }
767 if (pass_no) {
768 OPREG var_offset;
769
770 var_offset = Var_Ref(ve, is_y_var);
771 code_p->opc = emit_op(opcodex);
772 code_p->y_u.xx.xl = emit_xreg(var_offset);
773 code_p->y_u.xx.xr = emit_x(cpc->rnd2);
774 /* a small trick, usualy the lower argument is the one bound */
775 if (opcodex == _get_x_val && code_p->y_u.xx.xl > code_p->y_u.xx.xr) {
776 wamreg x1 = code_p->y_u.xx.xl;
777 code_p->y_u.xx.xl = code_p->y_u.xx.xr;
778 code_p->y_u.xx.xr = x1;
779 }
780 }
781 GONEXT(xx);
782 return code_p;
783}
784
785inline static yamop *a_rv(op_numbers opcodex, op_numbers opcodey,
786 OPREG var_offset, yamop *code_p, int pass_no,
787 struct PSEUDO *cpc) {
788 Ventry *ve = (Ventry *)cpc->rnd1;
789 int is_y_var = (ve->KindOfVE == PermVar);
790
791 if (is_y_var) {
792 if (pass_no) {
793 code_p->opc = emit_op(opcodey);
794 code_p->y_u.yx.x = emit_x(cpc->rnd2);
795 code_p->y_u.yx.y = emit_yreg(var_offset);
796 }
797 GONEXT(yx);
798 } else {
799 if (pass_no) {
800 code_p->opc = emit_op(opcodex);
801 code_p->y_u.xx.xl = emit_x(cpc->rnd2);
802 code_p->y_u.xx.xr = emit_xreg(var_offset);
803 }
804 GONEXT(xx);
805 }
806 return code_p;
807}
808
809#ifdef SFUNC
810
811/* vsc: I don't understand these instructions */
812
813inline static void a_vsf(int opcode, yamop *code_p, int pass_no,
814 struct PSEUDO *cpc) {
815 Ventry *ve = (Ventry *)cpc->rnd1;
816 OPREG var_offset;
817 int is_y_var = (ve->KindOfVE == PermVar);
818
819 var_offset = Var_Ref(ve, is_y_var);
820 if (is_y_var) {
821 if (pass_no) {
822 code_p->opc = emit_op((op_numbers)((int)opcode + is_y_var));
823 code_p->y_u.fy.f = emit_f(cpc->rnd2);
824 code_p->y_u.fy.a = ArityOfFunctor(emit_f(cpc->rnd2));
825 code_p->y_u.fy.y = emit_yreg(var_offset);
826 }
827 GONEXT(fy);
828 } else {
829 if (pass_no) {
830 code_p->opc = emit_op((op_numbers)((int)opcode + is_y_var));
831 code_p->y_u.fx.f = emit_f(cpc->rnd2);
832 code_p->y_u.fx.a = ArityOfFunctor(emit_f(cpc->rnd2));
833 code_p->y_u.fx.x = emit_xreg(var_offset);
834 }
835 GONEXT(fx);
836 }
837 return code_p;
838}
839
840inline static void a_asf(int opcode, yamop *code_p, int pass_no,
841 struct PSEUDO *cpc) {
842 if (pass_no) {
843 code_p->opc = emit_op((op_numbers)((int)opcode + is_y_var));
844 code_p->y_u.fn.f = emit_f(cpc->rnd2);
845 code_p->y_u.fn.a = ArityOfFunctor(emit_f(cpc->rnd2));
846 code_p->y_u.fn.n = emit_count(cpc->rnd1);
847 }
848 GONEXT(fn);
849 return code_p;
850}
851#endif
852
853inline static void a_pair(CELL *seq_ptr, int pass_no,
854 struct intermediates *cip) {
855 if (pass_no) {
856 CELL lab, lab0 = seq_ptr[1];
857 lab = (CELL)emit_ilabel(lab0, cip);
858 seq_ptr[0] = (CELL)emit_a(seq_ptr[0]);
859 seq_ptr[1] = lab;
860 }
861}
862
863inline static yamop *a_n(op_numbers opcode, int count, yamop *code_p,
864 int pass_no) {
865 if (pass_no) {
866 code_p->opc = emit_op(opcode);
867 code_p->y_u.s.s = count;
868 }
869 GONEXT(s);
870 return code_p;
871}
872
873#ifdef BEAM
874inline static yamop *a_eam(op_numbers opcode, int pred, long cl, yamop *code_p,
875 int pass_no) {
876 if (pass_no) {
877 code_p->opc = emit_op(opcode);
878 code_p->y_u.os.opcw = cl;
879 code_p->y_u.os.s = pred;
880 }
881 GONEXT(os);
882 return code_p;
883}
884#endif
885
886inline static yamop *a_un(op_numbers opcode, op_numbers opcodew, int count,
887 yamop *code_p, int pass_no) {
888 if (pass_no) {
889 code_p->opc = emit_op(opcode);
890 code_p->y_u.os.opcw = emit_op(opcodew);
891 code_p->y_u.os.s = count;
892 }
893 GONEXT(os);
894 return code_p;
895}
896
897inline static yamop *a_f(CELL rnd1, op_numbers opcode, yamop *code_p,
898 int pass_no) {
899 if (pass_no) {
900 Functor f = emit_f(rnd1);
901
902 code_p->opc = emit_op(opcode);
903 code_p->y_u.fa.f = f;
904 code_p->y_u.fa.a = ArityOfFunctor(f);
905 }
906 GONEXT(fa);
907 return code_p;
908}
909
910inline static yamop *a_uf(CELL rnd1, op_numbers opcode, op_numbers opcodew,
911 yamop *code_p, int pass_no) {
912 if (pass_no) {
913 Functor f = emit_f(rnd1);
914
915 code_p->opc = emit_op(opcode);
916 code_p->y_u.ofa.opcw = emit_op(opcodew);
917 code_p->y_u.ofa.f = f;
918 code_p->y_u.ofa.a = ArityOfFunctor(f);
919 }
920 GONEXT(ofa);
921 return code_p;
922}
923
924inline static yamop *a_c(CELL rnd1, op_numbers opcode, yamop *code_p,
925 int pass_no) {
926 if (pass_no) {
927 code_p->opc = emit_op(opcode);
928 code_p->y_u.c.c = emit_c(rnd1);
929 }
930 GONEXT(c);
931 return code_p;
932}
933
934inline static yamop *a_uc(CELL rnd1, op_numbers opcode, op_numbers opcode_w,
935 yamop *code_p, int pass_no) {
936 if (pass_no) {
937 code_p->opc = emit_op(opcode);
938 code_p->y_u.oc.opcw = emit_op(opcode_w);
939 code_p->y_u.oc.c = emit_c(rnd1);
940 }
941 GONEXT(oc);
942 return code_p;
943}
944
945inline static yamop *a_wblob(CELL rnd1, op_numbers opcode,
946 int *clause_has_blobsp, yamop *code_p, int pass_no,
947 struct intermediates *cip) {
948 if (pass_no) {
949 code_p->opc = emit_op(opcode);
950 code_p->y_u.N.b =
951 AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
952 }
953 *clause_has_blobsp = TRUE;
954 GONEXT(N);
955 return code_p;
956}
957
958static yamop *a_ensure_space(op_numbers opcode, yamop *code_p, int pass_no,
959 struct intermediates *cip, clause_info *clinfo) {
960 if (cip->cpc->rnd1 > 4096) {
961 if (pass_no) {
962 code_p->opc = emit_op(opcode);
963 code_p->y_u.Osbpa.i = sizeof(CELL) * cip->cpc->rnd1;
964 code_p->y_u.Osbpa.p = clinfo->CurrentPred;
965 code_p->y_u.Osbpa.bmap = NULL;
966 code_p->y_u.Osbpa.s = emit_count(-Signed(RealEnvSize));
967 }
968 GONEXT(Osbpa);
969 }
970 return code_p;
971}
972
973inline static yamop *a_wdbt(CELL rnd1, op_numbers opcode,
974 int *clause_has_dbtermp, yamop *code_p, int pass_no,
975 struct intermediates *cip) {
976 if (pass_no) {
977 code_p->opc = emit_op(opcode);
978 code_p->y_u.D.D = rnd1;
979 add_to_dbtermsl(cip, cip->cpc->rnd1);
980 }
981 *clause_has_dbtermp = TRUE;
982 GONEXT(D);
983 return code_p;
984}
985
986inline static yamop *a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w,
987 int *clause_has_blobsp, yamop *code_p, int pass_no,
988 struct intermediates *cip) {
989 if (pass_no) {
990 code_p->opc = emit_op(opcode);
991 code_p->y_u.oN.opcw = emit_op(opcode_w);
992 code_p->y_u.oN.b =
993 AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
994 }
995 *clause_has_blobsp = TRUE;
996 GONEXT(oN);
997 return code_p;
998}
999
1000// strings are blobs
1001inline static yamop *a_ustring(CELL rnd1, op_numbers opcode,
1002 op_numbers opcode_w, int *clause_has_blobsp,
1003 yamop *code_p, int pass_no,
1004 struct intermediates *cip) {
1005 if (pass_no) {
1006 code_p->opc = emit_op(opcode);
1007 code_p->y_u.ou.opcw = emit_op(opcode_w);
1008 code_p->y_u.ou.ut =
1009 AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
1010 }
1011 *clause_has_blobsp = TRUE;
1012 GONEXT(ou);
1013 return code_p;
1014}
1015
1016inline static yamop *a_udbt(CELL rnd1, op_numbers opcode, op_numbers opcode_w,
1017 int *clause_has_dbtermp, yamop *code_p, int pass_no,
1018 struct intermediates *cip) {
1019 if (pass_no) {
1020 code_p->opc = emit_op(opcode);
1021 code_p->y_u.oD.opcw = emit_op(opcode_w);
1022 code_p->y_u.oD.D = cip->cpc->rnd1;
1023 add_to_dbtermsl(cip, cip->cpc->rnd1);
1024 }
1025 *clause_has_dbtermp = TRUE;
1026 GONEXT(oD);
1027 return code_p;
1028}
1029
1030inline static yamop *a_ud(op_numbers opcode, op_numbers opcode_w, yamop *code_p,
1031 int pass_no, struct PSEUDO *cpc) {
1032 if (pass_no) {
1033 code_p->opc = emit_op(opcode);
1034 code_p->y_u.od.opcw = emit_op(opcode_w);
1035 code_p->y_u.od.d[0] = (CELL)FunctorDouble;
1036 code_p->y_u.od.d[1] = RepAppl(cpc->rnd1)[1];
1037#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
1038 code_p->y_u.od.d[2] = RepAppl(cpc->rnd1)[2];
1039#endif
1040 }
1041 GONEXT(od);
1042 return code_p;
1043}
1044
1045inline static yamop *a_ui(op_numbers opcode, op_numbers opcode_w, yamop *code_p,
1046 int pass_no, struct PSEUDO *cpc) {
1047 if (pass_no) {
1048 code_p->opc = emit_op(opcode);
1049 code_p->y_u.oi.opcw = emit_op(opcode_w);
1050 code_p->y_u.oi.i[0] = (CELL)FunctorLongInt;
1051 code_p->y_u.oi.i[1] = RepAppl(cpc->rnd1)[1];
1052 }
1053 GONEXT(oi);
1054 return code_p;
1055}
1056
1057inline static yamop *a_wd(op_numbers opcode, yamop *code_p, int pass_no,
1058 struct PSEUDO *cpc) {
1059 if (pass_no) {
1060 code_p->opc = emit_op(opcode);
1061 code_p->y_u.d.d[0] = (CELL)FunctorDouble;
1062 code_p->y_u.d.d[1] = RepAppl(cpc->rnd1)[1];
1063#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
1064 code_p->y_u.d.d[2] = RepAppl(cpc->rnd1)[2];
1065#endif
1066 }
1067 GONEXT(d);
1068 return code_p;
1069}
1070
1071inline static yamop *a_wi(op_numbers opcode, yamop *code_p, int pass_no,
1072 struct PSEUDO *cpc) {
1073 if (pass_no) {
1074 code_p->opc = emit_op(opcode);
1075 code_p->y_u.i.i[0] = (CELL)FunctorLongInt;
1076 code_p->y_u.i.i[1] = RepAppl(cpc->rnd1)[1];
1077 }
1078 GONEXT(i);
1079 return code_p;
1080}
1081
1082inline static yamop *a_nc(CELL rnd1, op_numbers opcode, int i, yamop *code_p,
1083 int pass_no) {
1084 if (pass_no) {
1085 code_p->opc = emit_op(opcode);
1086 code_p->y_u.sc.s = i;
1087 code_p->y_u.sc.c = emit_c(rnd1);
1088 }
1089 GONEXT(sc);
1090 return code_p;
1091}
1092
1093inline static yamop *a_unc(CELL rnd1, op_numbers opcode, op_numbers opcodew,
1094 int i, yamop *code_p, int pass_no) {
1095 if (pass_no) {
1096 code_p->opc = emit_op(opcode);
1097 code_p->y_u.osc.opcw = emit_op(opcodew);
1098 code_p->y_u.osc.s = i;
1099 code_p->y_u.osc.c = emit_c(rnd1);
1100 }
1101 GONEXT(osc);
1102 return code_p;
1103}
1104
1105inline static yamop *a_rf(op_numbers opcode, yamop *code_p, int pass_no,
1106 struct PSEUDO *cpc) {
1107 if (pass_no) {
1108 code_p->opc = emit_op(opcode);
1109 code_p->y_u.xfa.x = emit_x(cpc->rnd2);
1110 code_p->y_u.xfa.f = emit_f(cpc->rnd1);
1111 code_p->y_u.xfa.a = ArityOfFunctor(emit_f(cpc->rnd1));
1112 }
1113 GONEXT(xfa);
1114 return code_p;
1115}
1116
1117inline static yamop *a_rd(op_numbers opcode, yamop *code_p, int pass_no,
1118 struct PSEUDO *cpc) {
1119 if (pass_no) {
1120 code_p->opc = emit_op(opcode);
1121 code_p->y_u.xd.x = emit_x(cpc->rnd2);
1122 code_p->y_u.xd.d[0] = (CELL)FunctorDouble;
1123 code_p->y_u.xd.d[1] = RepAppl(cpc->rnd1)[1];
1124#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
1125 code_p->y_u.xd.d[2] = RepAppl(cpc->rnd1)[2];
1126#endif
1127 }
1128 GONEXT(xd);
1129 return code_p;
1130}
1131
1132inline static yamop *a_ri(op_numbers opcode, yamop *code_p, int pass_no,
1133 struct PSEUDO *cpc) {
1134 if (pass_no) {
1135 code_p->opc = emit_op(opcode);
1136 code_p->y_u.xi.x = emit_x(cpc->rnd2);
1137 code_p->y_u.xi.i[0] = (CELL)FunctorLongInt;
1138 code_p->y_u.xi.i[1] = RepAppl(cpc->rnd1)[1];
1139 }
1140 GONEXT(xi);
1141 return code_p;
1142}
1143
1144static yamop *a_rc(op_numbers opcode, yamop *code_p, int pass_no,
1145 struct intermediates *cip) {
1146 if (cip->cpc->rnd2 == 1 && cip->cpc->nextInst->rnd2 == 2 &&
1147 (cip->cpc->nextInst->op == get_atom_op ||
1148 cip->cpc->nextInst->op == get_num_op)) {
1149 struct PSEUDO *next;
1150 next = cip->cpc->nextInst;
1151 if (next->nextInst->rnd2 == 3 && (next->nextInst->op == get_atom_op ||
1152 next->nextInst->op == get_num_op)) {
1153 struct PSEUDO *snext = next->nextInst;
1154
1155 if (snext->nextInst->rnd2 == 4 && (snext->nextInst->op == get_atom_op ||
1156 snext->nextInst->op == get_num_op)) {
1157 struct PSEUDO *s2next = snext->nextInst;
1158 if (s2next->nextInst->rnd2 == 5 &&
1159 (s2next->nextInst->op == get_atom_op ||
1160 s2next->nextInst->op == get_num_op)) {
1161 struct PSEUDO *s3next = s2next->nextInst;
1162 if (s3next->nextInst->rnd2 == 6 &&
1163 (s3next->nextInst->op == get_atom_op ||
1164 s3next->nextInst->op == get_num_op)) {
1165 if (pass_no) {
1166 code_p->opc = emit_op(_get_6atoms);
1167 code_p->y_u.cccccc.c1 = emit_c(cip->cpc->rnd1);
1168 code_p->y_u.cccccc.c2 = emit_c(next->rnd1);
1169 code_p->y_u.cccccc.c3 = emit_c(snext->rnd1);
1170 code_p->y_u.cccccc.c4 = emit_c(s2next->rnd1);
1171 code_p->y_u.cccccc.c5 = emit_c(s3next->rnd1);
1172 code_p->y_u.cccccc.c6 = emit_c(s3next->nextInst->rnd1);
1173 }
1174 cip->cpc = s3next->nextInst;
1175 GONEXT(cccccc);
1176 } else {
1177 if (pass_no) {
1178 code_p->opc = emit_op(_get_5atoms);
1179 code_p->y_u.ccccc.c1 = emit_c(cip->cpc->rnd1);
1180 code_p->y_u.ccccc.c2 = emit_c(next->rnd1);
1181 code_p->y_u.ccccc.c3 = emit_c(snext->rnd1);
1182 code_p->y_u.ccccc.c4 = emit_c(s2next->rnd1);
1183 code_p->y_u.ccccc.c5 = emit_c(s3next->rnd1);
1184 }
1185 cip->cpc = s3next;
1186 GONEXT(ccccc);
1187 }
1188 } else {
1189 if (pass_no) {
1190 code_p->opc = emit_op(_get_4atoms);
1191 code_p->y_u.cccc.c1 = emit_c(cip->cpc->rnd1);
1192 code_p->y_u.cccc.c2 = emit_c(next->rnd1);
1193 code_p->y_u.cccc.c3 = emit_c(snext->rnd1);
1194 code_p->y_u.cccc.c4 = emit_c(s2next->rnd1);
1195 }
1196 cip->cpc = s2next;
1197 GONEXT(cccc);
1198 }
1199 } else {
1200 if (pass_no) {
1201 code_p->opc = emit_op(_get_3atoms);
1202 code_p->y_u.ccc.c1 = emit_c(cip->cpc->rnd1);
1203 code_p->y_u.ccc.c2 = emit_c(next->rnd1);
1204 code_p->y_u.ccc.c3 = emit_c(snext->rnd1);
1205 }
1206 cip->cpc = snext;
1207 GONEXT(ccc);
1208 }
1209 } else {
1210 if (pass_no) {
1211 code_p->opc = emit_op(_get_2atoms);
1212 code_p->y_u.cc.c1 = emit_c(cip->cpc->rnd1);
1213 code_p->y_u.cc.c2 = emit_c(next->rnd1);
1214 }
1215 cip->cpc = next;
1216 GONEXT(cc);
1217 }
1218 } else {
1219 if (pass_no) {
1220 code_p->opc = emit_op(opcode);
1221 code_p->y_u.xc.x = emit_x(cip->cpc->rnd2);
1222 code_p->y_u.xc.c = emit_c(cip->cpc->rnd1);
1223 }
1224 GONEXT(xc);
1225 }
1226 return code_p;
1227}
1228
1229inline static yamop *a_rb(op_numbers opcode, int *clause_has_blobsp,
1230 yamop *code_p, int pass_no,
1231 struct intermediates *cip) {
1232 if (pass_no) {
1233 code_p->opc = emit_op(opcode);
1234 code_p->y_u.xN.x = emit_x(cip->cpc->rnd2);
1235 code_p->y_u.xN.b = AbsAppl(
1236 (CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
1237 }
1238 *clause_has_blobsp = TRUE;
1239 GONEXT(xN);
1240 return code_p;
1241}
1242
1243inline static yamop *a_rstring(op_numbers opcode, int *clause_has_blobsp,
1244 yamop *code_p, int pass_no,
1245 struct intermediates *cip) {
1246 if (pass_no) {
1247 code_p->opc = emit_op(opcode);
1248 code_p->y_u.xu.x = emit_x(cip->cpc->rnd2);
1249 code_p->y_u.xu.ut = AbsAppl(
1250 (CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
1251 }
1252 *clause_has_blobsp = TRUE;
1253 GONEXT(xu);
1254 return code_p;
1255}
1256
1257inline static yamop *a_dbt(op_numbers opcode, int *clause_has_dbtermp,
1258 yamop *code_p, int pass_no,
1259 struct intermediates *cip) {
1260 if (pass_no) {
1261 code_p->opc = emit_op(opcode);
1262 code_p->y_u.xD.x = emit_x(cip->cpc->rnd2);
1263 code_p->y_u.xD.D = cip->cpc->rnd1;
1264 add_to_dbtermsl(cip, cip->cpc->rnd1);
1265 }
1266 *clause_has_dbtermp = TRUE;
1267 GONEXT(xD);
1268 return code_p;
1269}
1270
1271inline static yamop *a_r(CELL arnd2, op_numbers opcode, yamop *code_p,
1272 int pass_no) {
1273 if (pass_no) {
1274 code_p->opc = emit_op(opcode);
1275 code_p->y_u.x.x = emit_x(arnd2);
1276 }
1277 GONEXT(x);
1278 return code_p;
1279}
1280
1281static yamop *check_alloc(clause_info *clinfo, yamop *code_p, int pass_no,
1282 struct intermediates *cip) {
1283 if (clinfo->alloc_found == 2) {
1284 if (clinfo->CurrentPred->PredFlags & LogUpdatePredFlag)
1285 code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip);
1286 code_p = a_e(_allocate, code_p, pass_no);
1287 clinfo->alloc_found = 1;
1288 }
1289 return code_p;
1290}
1291
1292static yamop *a_l(CELL rnd1, op_numbers opcode, yamop *code_p, int pass_no,
1293 struct intermediates *cip) {
1294 if (pass_no) {
1295 code_p->opc = emit_op(opcode);
1296 code_p->y_u.l.l =
1297 emit_a(Unsigned(cip->code_addr) + cip->label_offset[rnd1]);
1298 }
1299 GONEXT(l);
1300 return code_p;
1301}
1302
1303static yamop *a_il(CELL rnd1, op_numbers opcode, yamop *code_p, int pass_no,
1304 struct intermediates *cip) {
1305 if (pass_no) {
1306 code_p->opc = emit_op(opcode);
1307 code_p->y_u.l.l = emit_ilabel(rnd1, cip);
1308 }
1309 GONEXT(l);
1310 return code_p;
1311}
1312
1313static yamop *
1314a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no,
1315 struct intermediates *cip) { /* emit opcode & predicate code address */
1316 Prop fe = (Prop)(cip->cpc->rnd1);
1317 CELL Flags = RepPredProp(fe)->PredFlags;
1318 if (Flags & AsmPredFlag) {
1319 op_numbers op;
1320 int is_test = FALSE;
1321
1322 switch (Flags & 0x7f) {
1323 case _equal:
1324 op = _p_equal;
1325 break;
1326#if INLINE_BIG_COMPARISONS
1327 case _dif:
1328 op = _p_dif;
1329 is_test = true;
1330 break;
1331 case _eq:
1332 op = _p_eq;
1333 is_test = true;
1334 break;
1335#endif
1336 case _functor:
1337 code_p = check_alloc(clinfo, code_p, pass_no, cip);
1338 op = _p_functor;
1339 break;
1340 default:
1341 // op = _p_equal; /* just to make some compilers happy */
1342 Yap_ThrowError(SYSTEM_ERROR_COMPILER, TermNil,
1343 "internal assembler error for built-in (%d)", (Flags & 0x7f));
1344 save_machine_regs();
1345 siglongjmp(cip->CompilerBotch, 1);
1346 }
1347 if (is_test) {
1348 UInt lab;
1349
1350 if ((lab = cip->failure_handler)) {
1351 return a_l(lab, op, code_p, pass_no, cip);
1352 } else {
1353 return a_il((CELL)FAILCODE, op, code_p, pass_no, cip);
1354 }
1355 } else {
1356 return a_e(op, code_p, pass_no);
1357 }
1358 }
1359 if (Flags & CPredFlag && opcode == _call) {
1360 code_p = check_alloc(clinfo, code_p, pass_no, cip);
1361 if (cip->failure_handler && (Flags & TestPredFlag)) {
1362 if (pass_no) {
1363 if (Flags & UserCPredFlag) {
1364 Yap_ThrowError(SYSTEM_ERROR_COMPILER, TermNil,
1365 "user defined predicate cannot be a test predicate");
1366 save_machine_regs();
1367 siglongjmp(cip->CompilerBotch, 1);
1368 } else
1369 code_p->opc = emit_op(_call_c_wfail);
1370 code_p->y_u.slpp.s =
1371 emit_count(-Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2);
1372 code_p->y_u.slpp.l = emit_fail(cip);
1373 code_p->y_u.slpp.p0 = clinfo->CurrentPred;
1374 code_p->y_u.slpp.p = emit_pe(RepPredProp(fe));
1375 }
1376 GONEXT(slpp);
1377 } else {
1378 if (pass_no) {
1379 code_p->y_u.Osbpp.p = RepPredProp(fe);
1380 if (Flags & UserCPredFlag) {
1381 code_p->opc = emit_op(_call_usercpred);
1382 } else {
1383 if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod) {
1384 code_p->y_u.Osbmp.mod = cip->cpc->rnd4;
1385 code_p->opc = emit_op(_p_execute);
1386 } else if (RepPredProp(fe)->FunctorOfPred == FunctorExecute2InMod) {
1387 code_p->opc = emit_op(_p_execute2);
1388 } else {
1389 code_p->opc = emit_op(_call_cpred);
1390 }
1391 }
1392 code_p->y_u.Osbpp.s =
1393 emit_count(-Signed(RealEnvSize) - CELLSIZE * (cip->cpc->rnd2));
1394 code_p->y_u.Osbpp.p0 = clinfo->CurrentPred;
1395 if (cip->cpc->rnd2) {
1396 code_p->y_u.Osbpp.bmap = emit_bmlabel(cip->cpc->arnds[1], cip);
1397 } else {
1398 /* there is no bitmap as there are no variables in the environment */
1399 code_p->y_u.Osbpp.bmap = NULL;
1400 }
1401 }
1402 GONEXT(Osbpp);
1403 }
1404 return code_p;
1405 }
1406
1407 if (opcode == _call && clinfo->alloc_found == 2) {
1408 if (clinfo->CurrentPred->PredFlags & LogUpdatePredFlag)
1409 code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip);
1410 if (pass_no) {
1411 code_p->opc = emit_op(_fcall);
1412 }
1413 clinfo->alloc_found = 1;
1414 } else {
1415 code_p = check_alloc(clinfo, code_p, pass_no, cip);
1416 if (pass_no)
1417 code_p->opc = emit_op(opcode);
1418 }
1419 if (opcode == _call) {
1420 if (pass_no) {
1421 code_p->y_u.Osbpp.s =
1422 emit_count(-Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2);
1423 code_p->y_u.Osbpp.p = RepPredProp(fe);
1424 code_p->y_u.Osbpp.p0 = clinfo->CurrentPred;
1425 if (cip->cpc->rnd2)
1426 code_p->y_u.Osbpp.bmap = emit_bmlabel(cip->cpc->arnds[1], cip);
1427 else
1428 /* there is no bitmap as there are no variables in the environment */
1429 code_p->y_u.Osbpp.bmap = NULL;
1430 }
1431 GONEXT(Osbpp);
1432 } else if (opcode == _execute || opcode == _dexecute) {
1433 if (pass_no) {
1434 if (Flags & CPredFlag) {
1435 code_p->opc = emit_op(_execute_cpred);
1436 }
1437 code_p->y_u.Osbpp.p = RepPredProp(fe);
1438 code_p->y_u.Osbpp.p0 = clinfo->CurrentPred;
1439 code_p->y_u.Osbpp.s = -Signed(RealEnvSize);
1440 code_p->y_u.Osbpp.bmap = NULL;
1441 }
1442 GONEXT(Osbpp);
1443 } else {
1444 if (pass_no)
1445 code_p->y_u.p.p = RepPredProp(fe);
1446 GONEXT(p);
1447 }
1448 return code_p;
1449}
1450
1451/*
1452 emit a false call so that the garbage collector and friends will find
1453 reasonable information on the stack.
1454*/
1455static yamop *a_empty_call(clause_info *clinfo, yamop *code_p, int pass_no,
1456 struct intermediates *cip) {
1457 if (clinfo->alloc_found == 1 && !clinfo->dealloc_found) {
1458 /* we have a solid environment under us, just trust it */
1459 if (pass_no)
1460 code_p->opc = emit_op(_call);
1461 } else {
1463 if (pass_no)
1464 code_p->opc = emit_op(_fcall);
1465 }
1466 if (pass_no) {
1467 PredEntry *pe = RepPredProp(Yap_GetPredPropByAtom(AtomTrue, 0));
1468 code_p->y_u.Osbpp.s =
1469 emit_count(-Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2);
1470 code_p->y_u.Osbpp.p = pe;
1471 code_p->y_u.Osbpp.p0 = clinfo->CurrentPred;
1472 if (cip->cpc->rnd2)
1473 code_p->y_u.Osbpp.bmap = emit_bmlabel(cip->cpc->rnd1, cip);
1474 else
1475 /* there is no bitmap as there are no variables in the environment */
1476 code_p->y_u.Osbpp.bmap = NULL;
1477 }
1478 GONEXT(Osbpp);
1479 return code_p;
1480}
1481
1482static yamop *a_pl(op_numbers opcode, PredEntry *pred, yamop *code_p,
1483 int pass_no) {
1484 if (pass_no) {
1485 code_p->opc = emit_op(opcode);
1486 code_p->y_u.p.p = pred;
1487 }
1488 GONEXT(p);
1489 return code_p;
1490}
1491
1492static COUNT
1493
1494compile_cmp_flags(unsigned char *s0) {
1495 char *s = (char *)s0;
1496 if (strcmp(s, "=<") == 0)
1497 return EQ_OK_IN_CMP | LT_OK_IN_CMP;
1498 if (strcmp(s, "is") == 0)
1499 return EQ_OK_IN_CMP;
1500 if (strcmp(s, "@=<") == 0)
1501 return EQ_OK_IN_CMP | LT_OK_IN_CMP;
1502 if (strcmp(s, "<") == 0)
1503 return LT_OK_IN_CMP;
1504 if (strcmp(s, "@<") == 0)
1505 return LT_OK_IN_CMP;
1506 if (strcmp(s, ">=") == 0)
1507 return EQ_OK_IN_CMP | GT_OK_IN_CMP;
1508 if (strcmp(s, "@>=") == 0)
1509 return EQ_OK_IN_CMP | GT_OK_IN_CMP;
1510 if (strcmp(s, ">") == 0)
1511 return GT_OK_IN_CMP;
1512 if (strcmp(s, "@>") == 0)
1513 return GT_OK_IN_CMP;
1514 if (strcmp(s, "=:=") == 0)
1515 return EQ_OK_IN_CMP;
1516 if (strcmp(s, "=\\=") == 0)
1517 return GT_OK_IN_CMP | LT_OK_IN_CMP;
1518 if (strcmp(s, "\\==") == 0)
1519 return GT_OK_IN_CMP | LT_OK_IN_CMP;
1520 Yap_ThrowError(SYSTEM_ERROR_COMPILER, TermNil,
1521 "internal assembler error, %s/2 not recognised as binary op", s);
1522 return 0;
1523}
1524
1525COUNT
1526Yap_compile_cmp_flags(PredEntry *pred) {
1527 return compile_cmp_flags(
1528 RepAtom(NameOfFunctor(pred->FunctorOfPred))->UStrOfAE);
1529}
1530
1531static yamop *a_bfunc(CELL a1, CELL a2, PredEntry *pred, clause_info *clinfo,
1532 yamop *code_p, int pass_no, struct intermediates *cip) {
1533 Ventry *ve1 = (Ventry *)a1;
1534 Ventry *ve2 = (Ventry *)a2;
1535 OPREG var_offset1;
1536 int is_y_var = (ve1->KindOfVE == PermVar);
1537
1538 var_offset1 = Var_Ref(ve1, is_y_var);
1539 if (ve1->KindOfVE == PermVar) {
1540 yslot v1 = emit_yreg(var_offset1);
1541 bool is_y_var2 = (ve2->KindOfVE == PermVar);
1542 OPREG var_offset2 = Var_Ref(ve2, is_y_var2);
1543 if (is_y_var2) {
1544 if (pass_no) {
1545 code_p->opc = emit_op(_call_bfunc_yy);
1546 code_p->y_u.plyys.p = pred;
1547 code_p->y_u.plyys.f = emit_fail(cip);
1548 code_p->y_u.plyys.y1 = v1;
1549 code_p->y_u.plyys.y2 = emit_yreg(var_offset2);
1550 code_p->y_u.plyys.flags = compile_cmp_flags(
1551 RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))
1552 ->UStrOfAE);
1553 }
1554 GONEXT(plyys);
1555 } else {
1556 if (pass_no) {
1557 code_p->opc = emit_op(_call_bfunc_yx);
1558 code_p->y_u.plxys.p = pred;
1559 code_p->y_u.plxys.f = emit_fail(cip);
1560 code_p->y_u.plxys.x = emit_xreg(var_offset2);
1561 code_p->y_u.plxys.y = v1;
1562 code_p->y_u.plxys.flags = compile_cmp_flags(
1563 RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))
1564 ->UStrOfAE);
1565 }
1566 GONEXT(plxys);
1567 }
1568 } else {
1569 wamreg x1 = emit_xreg(var_offset1);
1570 OPREG var_offset2;
1571
1572 bool is_y_var2 = (ve2->KindOfVE == PermVar);
1573 var_offset2 = Var_Ref(ve2, is_y_var2);
1574 if (is_y_var2) {
1575 if (pass_no) {
1576 code_p->opc = emit_op(_call_bfunc_xy);
1577 code_p->y_u.plxys.p = pred;
1578 code_p->y_u.plxys.f = emit_fail(cip);
1579 code_p->y_u.plxys.x = x1;
1580 code_p->y_u.plxys.y = emit_yreg(var_offset2);
1581 code_p->y_u.plxys.flags = compile_cmp_flags(
1582 RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))
1583 ->UStrOfAE);
1584 }
1585 GONEXT(plxys);
1586 } else {
1587 if (pass_no) {
1588 // printf(" %p --- %p\n", x1, emit_xreg(var_offset2) );
1589 code_p->opc = emit_op(_call_bfunc_xx);
1590 code_p->y_u.plxxs.p = pred;
1591 code_p->y_u.plxxs.f = emit_fail(cip);
1592 code_p->y_u.plxxs.x1 = x1;
1593 code_p->y_u.plxxs.x2 = emit_xreg(var_offset2);
1594 code_p->y_u.plxxs.flags = compile_cmp_flags(
1595 RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))
1596 ->UStrOfAE);
1597 }
1598 GONEXT(plxxs);
1599 }
1600 }
1601 return code_p;
1602}
1603
1604static yamop *a_igl(CELL rnd1, op_numbers opcode, yamop *code_p, int pass_no,
1605 struct intermediates *cip) {
1606 if (pass_no) {
1607 code_p->opc = emit_op(opcode);
1608 code_p->y_u.l.l = emit_ilabel(rnd1, cip);
1609 }
1610 GONEXT(l);
1611 return code_p;
1612}
1613
1614static yamop *a_xigl(op_numbers opcode, yamop *code_p, int pass_no,
1615 struct PSEUDO *cpc) {
1616 if (pass_no) {
1617 code_p->opc = emit_op(opcode);
1618 code_p->y_u.xll.x = emit_x(cpc->rnd2);
1619 code_p->y_u.xll.l1 = emit_a(cpc->rnd1);
1620 code_p->y_u.xll.l2 = NEXTOP(code_p, xll);
1621 }
1622 GONEXT(xll);
1623 return code_p;
1624}
1625
1626/* enable peephole optimisation for switch_on_term to switch_on_list */
1627static int is_switch_on_list(op_numbers opcode, struct intermediates *cip) {
1628 struct PSEUDO *cpc = cip->cpc, *ncpc, *n2cpc;
1629 CELL *if_table;
1630
1631 /* only do this is indexing code is stable */
1632 if (cip->CurrentPred->PredFlags & LogUpdatePredFlag)
1633 return FALSE;
1634 /* check if we are transforming a switch_on_type */
1635 if (opcode != _switch_on_type)
1636 return FALSE;
1637 /* should have two instructions next */
1638 if ((ncpc = cpc->nextInst) == NULL || (n2cpc = ncpc->nextInst) == NULL)
1639 return FALSE;
1640 /* one a label, the other an if_constant */
1641 if (ncpc->op != label_op || n2cpc->op != if_c_op)
1642 return FALSE;
1643 /* the label for the constant case should be the if_c label
1644 (this should always hold) */
1645 if (cpc->arnds[1] != ncpc->rnd1)
1646 return FALSE;
1647 if_table = (CELL *)(n2cpc->rnd2);
1648 /* the constant switch should only have the empty list */
1649 if (n2cpc->rnd1 != 1 || if_table[0] != TermNil)
1650 return FALSE;
1651 /*
1652 should be pointing to a clause so that we can push the clause opcode,
1653 this should be fixable;
1654 also, we need to go what's in there, so it cannot be suspend code!
1655 */
1656 if (cpc->arnds[0] & 1 ||
1657 (yamop *)(cpc->arnds[0]) ==
1658 (yamop *)(&(cip->CurrentPred->cs.p_code.ExpandCode)))
1659 return FALSE;
1660 /* Appl alternative should be pointing to same point as [] alternative,
1661 usually FAILCODE */
1662 if (if_table[3] != cpc->arnds[2])
1663 return FALSE;
1664 /* yesss!! */
1665 return TRUE;
1666}
1667
1668static yamop *a_4sw(op_numbers opcode, yamop *code_p, int pass_no,
1669 struct intermediates *cip) {
1670 CELL *seq_ptr;
1671
1672 if (is_switch_on_list(opcode, cip)) {
1673 if (pass_no) {
1674 CELL *ars = (CELL *)(cip->cpc->nextInst->nextInst->rnd2);
1675 code_p->opc = emit_op(_switch_list_nl);
1676 seq_ptr = cip->cpc->arnds;
1677 code_p->y_u.ollll.pop = ((yamop *)(seq_ptr[0]))->opc;
1678 code_p->y_u.ollll.l1 = emit_ilabel(seq_ptr[0], cip);
1679 code_p->y_u.ollll.l2 = emit_ilabel(ars[1], cip);
1680 code_p->y_u.ollll.l3 = emit_ilabel(seq_ptr[2], cip);
1681 code_p->y_u.ollll.l4 = emit_ilabel(seq_ptr[3], cip);
1682 if (cip->CurrentPred->PredFlags & LogUpdatePredFlag) {
1683 LogUpdIndex *icl = ClauseCodeToLogUpdIndex(ars);
1684
1685 Yap_LUIndexSpace_Tree -= icl->ClSize;
1686 Yap_FreeCodeSpace((char *)icl);
1687 } else {
1688 StaticIndex *icl = ClauseCodeToStaticIndex(ars);
1689
1690 Yap_IndexSpace_Tree -= icl->ClSize;
1691 Yap_FreeCodeSpace((char *)icl);
1692 }
1693 }
1694 GONEXT(ollll);
1695 /* skip if_cons */
1696 cip->cpc = cip->cpc->nextInst->nextInst;
1697 } else {
1698 if (pass_no) {
1699 code_p->opc = emit_op(opcode);
1700 seq_ptr = cip->cpc->arnds;
1701 code_p->y_u.llll.l1 = emit_ilabel(seq_ptr[0], cip);
1702 code_p->y_u.llll.l2 = emit_ilabel(seq_ptr[1], cip);
1703 code_p->y_u.llll.l3 = emit_ilabel(seq_ptr[2], cip);
1704 code_p->y_u.llll.l4 = emit_ilabel(seq_ptr[3], cip);
1705 }
1706 GONEXT(llll);
1707 }
1708 return code_p;
1709}
1710
1711static yamop *a_4sw_x(op_numbers opcode, yamop *code_p, int pass_no,
1712 struct intermediates *cip) {
1713 CELL *seq_ptr;
1714
1715 if (pass_no) {
1716 code_p->opc = emit_op(opcode);
1717 code_p->y_u.xllll.x = emit_x(cip->cpc->rnd2);
1718 cip->cpc = cip->cpc->nextInst;
1719 seq_ptr = cip->cpc->arnds;
1720 code_p->y_u.xllll.l1 = emit_ilabel(seq_ptr[0], cip);
1721 code_p->y_u.xllll.l2 = emit_ilabel(seq_ptr[1], cip);
1722 code_p->y_u.xllll.l3 = emit_ilabel(seq_ptr[2], cip);
1723 code_p->y_u.xllll.l4 = emit_ilabel(seq_ptr[3], cip);
1724 } else {
1725 /* skip one */
1726 cip->cpc = cip->cpc->nextInst;
1727 }
1728 GONEXT(xllll);
1729 return code_p;
1730}
1731
1732static yamop *a_4sw_s(op_numbers opcode, yamop *code_p, int pass_no,
1733 struct intermediates *cip) {
1734 CELL *seq_ptr;
1735
1736 if (pass_no) {
1737 code_p->opc = emit_op(opcode);
1738 code_p->y_u.sllll.s = cip->cpc->rnd2;
1739 cip->cpc = cip->cpc->nextInst;
1740 seq_ptr = cip->cpc->arnds;
1741 code_p->y_u.sllll.l1 = emit_ilabel(seq_ptr[0], cip);
1742 code_p->y_u.sllll.l2 = emit_ilabel(seq_ptr[1], cip);
1743 code_p->y_u.sllll.l3 = emit_ilabel(seq_ptr[2], cip);
1744 code_p->y_u.sllll.l4 = emit_ilabel(seq_ptr[3], cip);
1745 } else {
1746 /* skip one */
1747 cip->cpc = cip->cpc->nextInst;
1748 }
1749 GONEXT(sllll);
1750 return code_p;
1751}
1752
1753static void init_log_upd_table(LogUpdIndex *ic, union clause_obj *cl_u) {
1754 /* insert myself in the indexing code chain */
1755 ic->SiblingIndex = cl_u->lui.ChildIndex;
1756 if (ic->SiblingIndex) {
1757 ic->SiblingIndex->PrevSiblingIndex = ic;
1758 }
1759 cl_u->lui.ChildIndex = ic;
1760 ic->PrevSiblingIndex = NULL;
1761 ic->ChildIndex = NULL;
1762 ic->ClRefCount = 0;
1763 ic->ParentIndex = (LogUpdIndex *)cl_u;
1764 // INIT_LOCK(ic->ClLock);
1765 cl_u->lui.ChildIndex = ic;
1766 cl_u->lui.ClRefCount++;
1767}
1768
1769static void init_static_table(StaticIndex *ic, union clause_obj *cl_u) {
1770 /* insert myself in the indexing code chain */
1771 ic->SiblingIndex = cl_u->si.ChildIndex;
1772 ic->ChildIndex = NULL;
1773 cl_u->si.ChildIndex = ic;
1774}
1775
1776static yamop *a_hx(op_numbers opcode, union clause_obj *cl_u, int log_update,
1777 yamop *code_p, int pass_no, struct intermediates *cip) {
1778 register CELL i, imax;
1779 register CELL *seq_ptr = (CELL *)cip->cpc->rnd2;
1780 int j = 0;
1781
1782 imax = cip->cpc->rnd1;
1783 if (pass_no) {
1784 code_p->opc = emit_op(opcode);
1785 code_p->y_u.sssl.s = emit_c(imax);
1786 code_p->y_u.sssl.l = emit_a(cip->cpc->rnd2);
1787 if (log_update) {
1788 init_log_upd_table(ClauseCodeToLogUpdIndex(cip->cpc->rnd2), cl_u);
1789 } else {
1790 init_static_table(ClauseCodeToStaticIndex(cip->cpc->rnd2), cl_u);
1791 }
1792 }
1793 if (pass_no) {
1794 for (i = 0; i < imax; i++) {
1795 yamop *ipc = (yamop *)seq_ptr[1];
1796 a_pair(seq_ptr, pass_no, cip);
1797 if (ipc != FAILCODE) {
1798 j++;
1799 }
1800 seq_ptr += 2;
1801 }
1802 code_p->y_u.sssl.e = j;
1803 code_p->y_u.sssl.w = 0;
1804 }
1805 GONEXT(sssl);
1806 return code_p;
1807}
1808
1809static yamop *a_if(op_numbers opcode, union clause_obj *cl_u, int log_update,
1810 yamop *code_p, int pass_no, struct intermediates *cip) {
1811 register CELL i, imax;
1812 register CELL *seq_ptr = (CELL *)cip->cpc->rnd2;
1813
1814 imax = cip->cpc->rnd1;
1815 if (pass_no) {
1816 code_p->opc = emit_op(opcode);
1817 code_p->y_u.sssl.s = code_p->y_u.sssl.e = emit_count(imax);
1818 code_p->y_u.sssl.w = 0;
1819 code_p->y_u.sssl.l = emit_a(cip->cpc->rnd2);
1820 if (log_update) {
1821 init_log_upd_table(ClauseCodeToLogUpdIndex(cip->cpc->rnd2), cl_u);
1822 } else {
1823 init_static_table(ClauseCodeToStaticIndex(cip->cpc->rnd2), cl_u);
1824 }
1825 }
1826 GONEXT(sssl);
1827 if (pass_no) {
1828 CELL lab, lab0;
1829 for (i = 0; i < imax; i++) {
1830 a_pair(seq_ptr, pass_no, cip);
1831 seq_ptr += 2;
1832 }
1833 lab0 = seq_ptr[1];
1834 lab = (CELL)emit_ilabel(lab0, cip);
1835 seq_ptr[1] = lab;
1836 }
1837 return code_p;
1838}
1839
1840static yamop *a_ifnot(op_numbers opcode, yamop *code_p, int pass_no,
1841 struct intermediates *cip) {
1842 CELL *seq_ptr = cip->cpc->arnds;
1843 if (pass_no) {
1844 code_p->opc = emit_op(opcode);
1845 code_p->y_u.clll.c = seq_ptr[0]; /* tag */
1846 code_p->y_u.clll.l1 = emit_ilabel(seq_ptr[1], cip); /* success point */
1847 code_p->y_u.clll.l2 = emit_ilabel(seq_ptr[2], cip); /* fail point */
1848 code_p->y_u.clll.l3 = emit_ilabel(seq_ptr[3], cip); /* delay point */
1849 }
1850 GONEXT(clll);
1851 return code_p;
1852}
1853
1854static yamop *a_cut(clause_info *clinfo, yamop *code_p, int pass_no,
1855 struct intermediates *cip) {
1856 cip->clause_has_cut = TRUE;
1857 code_p = check_alloc(clinfo, code_p, pass_no, cip);
1858 if (clinfo->dealloc_found) {
1859 return a_n(_cut_e, -Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2, code_p,
1860 pass_no);
1861 } else if (clinfo->alloc_found == 1) {
1862 return a_n(_cut, -Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2, code_p,
1863 pass_no);
1864 } else {
1865 return a_n(_cut_t, -Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2, code_p,
1866 pass_no);
1867 }
1868}
1869
1870static yamop *
1871#ifdef YAPOR
1872a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut,
1873 yamop *code_p, int pass_no, struct intermediates *cip)
1874#else
1875a_try(op_numbers opcode, CELL lab, CELL opr, yamop *code_p, int pass_no,
1876 struct intermediates *cip)
1877#endif /* YAPOR */
1878{
1879 PredEntry *ap = cip->CurrentPred;
1880
1881 /* if predicates are logical do it in a different way */
1882 if (ap->PredFlags & LogUpdatePredFlag) {
1883 yamop *newcp;
1884 /* emit a special instruction and then a label for backpatching */
1885 if (pass_no) {
1886 UInt size = (UInt)NEXTOP((yamop *)NULL, OtaLl);
1887 if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
1888 /* OOOPS, got in trouble, must do a longjmp and recover space */
1889 save_machine_regs();
1890 siglongjmp(cip->CompilerBotch, 2);
1891 }
1892 Yap_inform_profiler_of_clause(newcp, (char *)(newcp) + size, ap,
1893 GPROF_INDEX);
1894 Yap_LUIndexSpace_CP += size;
1895#ifdef DEBUG
1896 Yap_NewCps++;
1897 Yap_LiveCps++;
1898#endif
1899 newcp->y_u.OtaLl.n = NULL;
1900 *cip->current_try_lab = newcp;
1901 if (opcode == _try_clause) {
1902 newcp->opc = emit_op(_try_logical);
1903 newcp->y_u.OtaLl.s = emit_count(opr);
1904 } else if (opcode == _retry) {
1905 if (ap->PredFlags & CountPredFlag)
1906 newcp->opc = emit_op(_count_retry_logical);
1907 else if (ap->PredFlags & ProfiledPredFlag) {
1908 if (!Yap_initProfiler(ap)) {
1909 return NULL;
1910 }
1911 newcp->opc = emit_op(_profiled_retry_logical);
1912 } else
1913 newcp->opc = emit_op(_retry_logical);
1914 newcp->y_u.OtaLl.s = emit_count(opr);
1915 } else {
1916 /* trust */
1917 if (ap->PredFlags & CountPredFlag) {
1918 newcp->opc = emit_op(_count_trust_logical);
1919 } else if (ap->PredFlags & ProfiledPredFlag) {
1920 if (!Yap_initProfiler(ap)) {
1921 return NULL;
1922 }
1923 newcp->opc = emit_op(_profiled_trust_logical);
1924 } else {
1925 newcp->opc = emit_op(_trust_logical);
1926 }
1927 newcp->y_u.OtILl.block = (LogUpdIndex *)(cip->code_addr);
1928 *cip->current_trust_lab = newcp;
1929 }
1930 newcp->y_u.OtaLl.d = ClauseCodeToLogUpdClause(emit_a(lab));
1931 cip->current_try_lab = &(newcp->y_u.OtaLl.n);
1932 }
1933 return code_p;
1934 }
1935#ifndef YAPOR
1936 switch (opr) {
1937 case 2:
1938 if (opcode == _try_clause) {
1939 if (pass_no) {
1940 code_p->opc = emit_op(_try_clause2);
1941 code_p->y_u.l.l = emit_a(lab);
1942 }
1943 GONEXT(l);
1944 return code_p;
1945 } else if (opcode == _retry) {
1946 if (pass_no) {
1947 code_p->opc = emit_op(_retry2);
1948 code_p->y_u.l.l = emit_a(lab);
1949 }
1950 GONEXT(l);
1951 return code_p;
1952 }
1953 case 3:
1954 if (opcode == _try_clause) {
1955 if (pass_no) {
1956 code_p->opc = emit_op(_try_clause3);
1957 code_p->y_u.l.l = emit_a(lab);
1958 }
1959 GONEXT(l);
1960 return code_p;
1961 } else if (opcode == _retry) {
1962 if (pass_no) {
1963 code_p->opc = emit_op(_retry3);
1964 code_p->y_u.l.l = emit_a(lab);
1965 }
1966 GONEXT(l);
1967 return code_p;
1968 }
1969 case 4:
1970 if (opcode == _try_clause) {
1971 if (pass_no) {
1972 code_p->opc = emit_op(_try_clause4);
1973 code_p->y_u.l.l = emit_a(lab);
1974 }
1975 GONEXT(l);
1976 return code_p;
1977 } else if (opcode == _retry) {
1978 if (pass_no) {
1979 code_p->opc = emit_op(_retry4);
1980 code_p->y_u.l.l = emit_a(lab);
1981 }
1982 GONEXT(l);
1983 return code_p;
1984 }
1985 }
1986#endif
1987 if (pass_no) {
1988 code_p->opc = emit_op(opcode);
1989 code_p->y_u.Otapl.d = emit_a(lab);
1990 code_p->y_u.Otapl.s = emit_count(opr);
1991 code_p->y_u.Otapl.p = ap;
1992#ifdef TABLING
1993 code_p->y_u.Otapl.te = ap->TableOfPred;
1994#endif
1995#ifdef YAPOR
1996 INIT_YAMOP_LTT(code_p, nofalts);
1997 if (cip->clause_has_cut)
1998 PUT_YAMOP_CUT(code_p);
1999 if (ap->PredFlags & SequentialPredFlag)
2000 PUT_YAMOP_SEQ(code_p);
2001#endif /* YAPOR */
2002 }
2003 GONEXT(Otapl);
2004 return code_p;
2005}
2006
2007static yamop *
2008#ifdef YAPOR
2009a_either(op_numbers opcode, CELL opr, CELL lab, int nofalts, yamop *code_p,
2010 int pass_no, struct intermediates *cip)
2011#else
2012a_either(op_numbers opcode, CELL opr, CELL lab, yamop *code_p, int pass_no,
2013 struct intermediates *cip)
2014#endif /* YAPOR */
2015{
2016 if (pass_no) {
2017 code_p->opc = emit_op(opcode);
2018 code_p->y_u.Osblp.s = emit_count(opr);
2019 code_p->y_u.Osblp.l = emit_a(lab);
2020 code_p->y_u.Osblp.p0 = cip->CurrentPred;
2021#ifdef YAPOR
2022 INIT_YAMOP_LTT(code_p, nofalts);
2023 if (cip->clause_has_cut)
2024 PUT_YAMOP_CUT(code_p);
2025 if (cip->CurrentPred->PredFlags & SequentialPredFlag)
2026 PUT_YAMOP_SEQ(code_p);
2027 if (opcode != _or_last) {
2028 code_p->y_u.Osblp.bmap = emit_bmlabel(cip->cpc->arnds[1], cip);
2029 }
2030#else
2031 code_p->y_u.Osblp.bmap = emit_bmlabel(cip->cpc->arnds[1], cip);
2032#endif /* YAPOR */
2033 }
2034 GONEXT(Osblp);
2035 return code_p;
2036}
2037
2038static yamop *a_gl(op_numbers opcode, yamop *code_p, int pass_no,
2039 struct PSEUDO *cpc, struct intermediates *cip USES_REGS) {
2040#ifdef YAPOR
2041 return a_try(opcode, cpc->rnd1, LOCAL_IPredArity, cpc->rnd2 >> 1,
2042 cpc->rnd2 & 1, code_p, pass_no, cip);
2043#else
2044 return a_try(opcode, cpc->rnd1, LOCAL_IPredArity, code_p, pass_no, cip);
2045#endif /* YAPOR */
2046}
2047
2048/*
2049 * optimizes several unify_cons for the same constant. It must be avoided for
2050 * the head of the first argument, because of indexing
2051 */
2052static yamop *a_ucons(int *do_not_optimise_uatomp, compiler_vm_op opcode,
2053 yamop *code_p, int pass_no, struct intermediates *cip) {
2054#if AGGREGATE_OPS
2055 PInstr *np = cip->cpc->nextInst;
2056 register int i = 0;
2057 CELL my_cons = cip->cpc->rnd1;
2058
2059 if (*do_not_optimise_uatomp) {
2060 *do_not_optimise_uatomp = FALSE;
2061 if (opcode == unify_atom_op)
2062 return a_uc(cip->cpc->rnd1, _unify_atom, _unify_atom_write, code_p,
2063 pass_no);
2064 else
2065 return a_c(cip->cpc->rnd1, _write_atom, code_p, pass_no);
2066 } else {
2067 while (np->op == opcode && np->rnd1 == my_cons) {
2068 i++;
2069 cip->cpc = np;
2070 np = np->nextInst;
2071 }
2072 if (i == 0) {
2073 if (opcode == unify_atom_op)
2074 return a_uc(cip->cpc->rnd1, _unify_atom, _unify_atom_write, code_p,
2075 pass_no);
2076 else
2077 return a_c(cip->cpc->rnd1, _write_atom, code_p, pass_no);
2078 } else {
2079 if (opcode == unify_atom_op)
2080 return a_unc(cip->cpc->rnd1, _unify_n_atoms, _unify_n_atoms_write,
2081 i + 1, code_p, pass_no);
2082 else
2083 return a_nc(cip->cpc->rnd1, _write_n_atoms, i + 1, code_p, pass_no);
2084 }
2085 }
2086#else
2087 *do_not_optimise_uatomp = FALSE;
2088 if (opcode == unify_atom_op)
2089 return a_uc(cip->cpc->rnd1, _unify_atom, _unify_atom_write, code_p);
2090 else
2091 return a_c(cip->cpc->rnd1, _write_atom, code_p);
2092#endif
2093}
2094
2095static yamop *a_uvar(yamop *code_p, int pass_no, struct intermediates *cip) {
2096 if (!is_void_var()) {
2097#if AGGREGATE_OPS
2098 if (is_temp_var()) {
2099 PInstr *np = cip->cpc->nextInst;
2100
2101 if (np->op == unify_var_op && is_atemp_var(np)) {
2102 return a_vv(_unify_x_var2, _unify_x_var2_write, code_p, pass_no, cip);
2103 } else if (np->op == unify_last_var_op && is_atemp_var(np)) {
2104 return a_vv(_unify_l_x_var2, _unify_l_x_var2_write, code_p, pass_no,
2105 cip);
2106 }
2107 }
2108#endif /* AGGREGATE_OPS */
2109 return a_uv((Ventry *)cip->cpc->rnd1, _unify_x_var, _unify_x_var_write,
2110 _unify_y_var, _unify_y_var_write, code_p, pass_no);
2111 } else {
2112#if AGGREGATE_OPS
2113 int i = 1;
2114 PInstr *np = cip->cpc->nextInst;
2115
2116 /* skip void vars */
2117 while (np->op == unify_var_op && is_a_void(np->rnd1)) {
2118 i++;
2119 cip->cpc = np;
2120 np = np->nextInst;
2121 }
2122 if (np->op == unify_last_var_op && is_a_void(np->rnd1)) {
2123 if (i == 0)
2124 code_p = a_ue(_unify_l_void, _unify_l_void_write, code_p, pass_no);
2125 else
2126 code_p = a_un(_unify_l_n_voids, _unify_l_n_voids_write, i + 1, code_p,
2127 pass_no);
2128 cip->cpc = np;
2129 } else if (i == 1)
2130 return a_ue(_unify_void, _unify_void_write, code_p, pass_no);
2131 else {
2132 return a_un(_unify_n_voids, _unify_n_voids_write, i, code_p, pass_no);
2133 }
2134#else
2135 return a_ue(_unify_void, _unify_void_write);
2136#endif
2137 }
2138 return code_p;
2139}
2140
2141static yamop *a_wvar(yamop *code_p, int pass_no, struct intermediates *cip) {
2142 if (!no_ref_var())
2143 return a_v(_write_x_var, _write_y_var, code_p, pass_no, cip->cpc);
2144 else {
2145#if AGGREGATE_OPS
2146 int i = 0;
2147 PInstr *np = cip->cpc->nextInst;
2148
2149 while (np->op == write_var_op && no_ref(np->rnd1)) {
2150 i++;
2151 cip->cpc = np;
2152 np = np->nextInst;
2153 }
2154 if (i == 0)
2155 return a_e(_write_void, code_p, pass_no);
2156 else {
2157 return a_n(_write_n_voids, i + 1, code_p, pass_no);
2158 }
2159#else
2160 return a_e(_write_void, pass_no);
2161#endif
2162 }
2163}
2164
2165static yamop *a_glist(int *do_not_optimise_uatomp, yamop *code_p, int pass_no,
2166 struct intermediates *cip) {
2167#if AGGREGATE_OPS
2168 PInstr *pnext = cip->cpc->nextInst;
2169
2170 if (cip->cpc->rnd2 != 1 && pnext->op == unify_val_op) {
2171 Ventry *ve = (Ventry *)pnext->rnd1;
2172 int is_y_var;
2173 OPREG var_offset;
2174
2175 pnext->rnd2 = cip->cpc->rnd2;
2176 cip->cpc = pnext;
2177 is_y_var = (ve->KindOfVE == PermVar);
2178 var_offset = Var_Ref(ve, is_y_var);
2179 return a_rv(_glist_valx, _glist_valy, var_offset, code_p, pass_no,
2180 cip->cpc);
2181 } else if (cip->cpc->rnd2 == 1 && pnext->op == unify_atom_op) {
2182 *do_not_optimise_uatomp = TRUE;
2183 return a_r(cip->cpc->rnd2, _get_list, code_p, pass_no);
2184 } else if (cip->cpc->rnd2 != 1 && pnext->op == unify_var_op &&
2185 is_a_void(pnext->rnd1)) {
2186 PInstr *ppnext = pnext->nextInst;
2187
2188 if (ppnext &&
2189 (ppnext->op == unify_last_var_op || ppnext->op == unify_last_val_op)) {
2190 Ventry *ve = (Ventry *)ppnext->rnd1;
2191 int is_y_var = (ve->KindOfVE == PermVar);
2192 OPREG var_offset;
2193
2194 ppnext->rnd2 = cip->cpc->rnd2;
2195 cip->cpc = ppnext;
2196 var_offset = Var_Ref(ve, is_y_var);
2197 if (cip->cpc->op == unify_last_var_op)
2198 return a_rv(_gl_void_varx, _gl_void_vary, var_offset, code_p, pass_no,
2199 cip->cpc);
2200 else
2201 return a_rv(_gl_void_valx, _gl_void_valy, var_offset, code_p, pass_no,
2202 cip->cpc);
2203 } else {
2204 return a_r(cip->cpc->rnd2, _get_list, code_p, pass_no);
2205 }
2206 } else
2207#endif /* AGGREGATE_OPS */
2208 return a_r(cip->cpc->rnd2, _get_list, code_p, pass_no);
2209}
2210
2211#define NEXTOPC (cip->cpc->nextInst->op)
2212
2213static yamop *a_deallocate(clause_info *clinfo, yamop *code_p, int pass_no,
2214 struct intermediates *cip) {
2215 if (clinfo->alloc_found == 1) {
2216 if (NEXTOPC == execute_op &&
2217 !(RepPredProp((Prop)(cip->cpc->nextInst->rnd1))->PredFlags &
2218 CPredFlag)) {
2219 cip->cpc = cip->cpc->nextInst;
2220 code_p = a_p(_dexecute, clinfo, code_p, pass_no, cip);
2221 } else
2222 code_p = a_p0(_deallocate, code_p, pass_no, cip->CurrentPred);
2223 clinfo->dealloc_found = TRUE;
2224 }
2225 return code_p;
2226}
2227
2228static yamop *a_bmap(yamop *code_p, int pass_no, struct PSEUDO *cpc) {
2229 /* how much space do we need to reserve */
2230 int i, max = (cpc->rnd1) / (8 * sizeof(CELL));
2231 for (i = 0; i <= max; i++)
2232 code_p = fill_a(cpc->arnds[i], code_p, pass_no);
2233 return code_p;
2234}
2235
2236static yamop *a_bregs(yamop *code_p, int pass_no, struct PSEUDO *cpc) {
2237 /* how much space do we need to reserve */
2238 int i, max = (cpc->rnd1) / (8 * sizeof(CELL));
2239 code_p = fill_a(cpc->rnd1, code_p, pass_no);
2240 for (i = 0; i <= max; i++)
2241 code_p = fill_a(cpc->arnds[i], code_p, pass_no);
2242 return code_p;
2243}
2244
2245static yamop *copy_blob(yamop *code_p, int pass_no, struct PSEUDO *cpc) {
2246 /* copy the blob to code space, making no effort to align if a double */
2247 int max = cpc->rnd1, i;
2248 for (i = 0; i < max; i++)
2249 code_p = fill_a(cpc->arnds[i], code_p, pass_no);
2250 return code_p;
2251}
2252
2253static yamop *copy_string(yamop *code_p, int pass_no, struct PSEUDO *cpc) {
2254 /* copy the blob to code space, making no effort to align if a double */
2255 int max = cpc->rnd1, i;
2256 for (i = 0; i < max; i++)
2257 code_p = fill_a(cpc->arnds[i], code_p, pass_no);
2258 return code_p;
2259}
2260
2261static void a_fetch_vv(cmp_op_info *cmp_info, int pass_no,
2262 struct intermediates *cip) {
2263 /* the next three instructions must be a get_val, get_val, and BIP */
2264 if (pass_no == 0) {
2265 PInstr *p = cip->cpc->nextInst;
2266 Ventry *ve;
2267 ve = (Ventry *)p->rnd1;
2268 if (ve->KindOfVE != PermVar && p->op != nop_op && p->op != put_var_op) {
2269 p->rnd2 = ve->NoOfVE & MaskVarAdrs;
2270 p->op = nop_op;
2271 }
2272 p = p->nextInst;
2273 ve = (Ventry *)p->rnd1;
2274 if (ve->KindOfVE != PermVar && p->op != nop_op && p->op != put_var_op) {
2275 p->rnd2 = ve->NoOfVE & MaskVarAdrs;
2276 p->op = nop_op;
2277 }
2278 } else {
2279 PInstr *p = cip->cpc->nextInst;
2280
2281 cmp_info->c_type = TYPE_XX;
2282 /* don't get rid of get_val_op */
2283 cmp_info->x1_arg = emit_x(p->rnd2);
2284 p = p->nextInst;
2285 cmp_info->x2_arg = emit_x(p->rnd2);
2286 }
2287}
2288
2289static void a_fetch_vc(cmp_op_info *cmp_info, int pass_no,
2290 struct intermediates *cip) {
2291 /* the next two instructions must be a get_val and BIP */
2292 if (pass_no == 0) {
2293 PInstr *p = cip->cpc->nextInst;
2294 Ventry *ve;
2295 ve = (Ventry *)p->rnd1;
2296 if (ve->KindOfVE != PermVar && p->op != nop_op && p->op != put_var_op) {
2297 p->rnd2 = ve->NoOfVE & MaskVarAdrs;
2298 p->op = nop_op;
2299 }
2300 } else {
2301 PInstr *p = cip->cpc->nextInst;
2302
2303 cmp_info->c_type = TYPE_XC;
2304 cmp_info->c_arg = cip->cpc->rnd1;
2305 cmp_info->x1_arg = emit_x(p->rnd2);
2306 }
2307}
2308
2309static void a_fetch_cv(cmp_op_info *cmp_info, int pass_no,
2310 struct intermediates *cip) {
2311 /* the next two instructions must be a get_val and BIP */
2312 if (pass_no == 0) {
2313 PInstr *p = cip->cpc->nextInst;
2314 Ventry *ve;
2315 ve = (Ventry *)p->rnd1;
2316 if (ve->KindOfVE != PermVar && p->op != nop_op && p->op != put_var_op) {
2317 p->rnd2 = ve->NoOfVE & MaskVarAdrs;
2318 p->op = nop_op;
2319 }
2320 } else {
2321 PInstr *p = cip->cpc->nextInst;
2322
2323 cmp_info->c_type = TYPE_CX;
2324 cmp_info->c_arg = cip->cpc->rnd1;
2325 cmp_info->x1_arg = emit_x(p->rnd2);
2326 }
2327}
2328
2329static yamop *a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no,
2330 struct intermediates *cip) {
2331 Int opc = cip->cpc->rnd2;
2332 Ventry *ve = (Ventry *)(cip->cpc->rnd1);
2333 int is_y_var = FALSE;
2334 Int xpos = 0;
2335
2336 if (ve) {
2337 is_y_var = (ve->KindOfVE == PermVar);
2338 xpos = ve->NoOfVE & MaskVarAdrs;
2339 }
2340
2341 if (opc <= _primitive) {
2342 if (is_y_var) {
2343 if (pass_no) {
2344 code_p->y_u.yl.y = emit_y(ve);
2345 switch (opc) {
2346 case _atom:
2347 code_p->opc = opcode(_p_atom_y);
2348 break;
2349 case _atomic:
2350 code_p->opc = opcode(_p_atomic_y);
2351 break;
2352 case _compound:
2353 code_p->opc = opcode(_p_compound_y);
2354 break;
2355 case _float:
2356 code_p->opc = opcode(_p_float_y);
2357 break;
2358 case _integer:
2359 code_p->opc = opcode(_p_integer_y);
2360 break;
2361 case _nonvar:
2362 code_p->opc = opcode(_p_nonvar_y);
2363 break;
2364 case _number:
2365 code_p->opc = opcode(_p_number_y);
2366 break;
2367 case _var:
2368 code_p->opc = opcode(_p_var_y);
2369 break;
2370 case _db_ref:
2371 code_p->opc = opcode(_p_db_ref_y);
2372 break;
2373 case _cut_by:
2374 Yap_ThrowError(SYSTEM_ERROR_COMPILER, TermNil,
2375 "internal assembler error: cut_by should be handled as ->");
2376 break;
2377 case _primitive:
2378 code_p->opc = opcode(_p_primitive_y);
2379 break;
2380 }
2381 code_p->y_u.yl.F = emit_fail(cip);
2382 }
2383 GONEXT(yl);
2384 return code_p;
2385 } else {
2386 if (pass_no) {
2387 code_p->y_u.xl.x = emit_x(xpos);
2388 switch (opc) {
2389 case _atom:
2390 code_p->opc = opcode(_p_atom_x);
2391 break;
2392 case _atomic:
2393 code_p->opc = opcode(_p_atomic_x);
2394 break;
2395 case _compound:
2396 code_p->opc = opcode(_p_compound_x);
2397 break;
2398 case _float:
2399 code_p->opc = opcode(_p_float_x);
2400 break;
2401 case _integer:
2402 code_p->opc = opcode(_p_integer_x);
2403 break;
2404 case _nonvar:
2405 code_p->opc = opcode(_p_nonvar_x);
2406 break;
2407 case _number:
2408 code_p->opc = opcode(_p_number_x);
2409 break;
2410 case _var:
2411 code_p->opc = opcode(_p_var_x);
2412 break;
2413 case _db_ref:
2414 code_p->opc = opcode(_p_db_ref_x);
2415 break;
2416 case _cut_by:
2417 Yap_ThrowError(SYSTEM_ERROR_COMPILER, TermNil,
2418 "internal assembler error: cut_by should be handled as ->");
2419 break;
2420 case _primitive:
2421 code_p->opc = opcode(_p_primitive_x);
2422 break;
2423 }
2424 code_p->y_u.xl.F = emit_fail(cip);
2425 }
2426 GONEXT(xl);
2427 return code_p;
2428 }
2429 }
2430 if (opc == _functor && (cip->cpc->nextInst->op == f_var_op ||
2431 cip->cpc->nextInst->op == f_0_op)) {
2432 Ventry *nve;
2433 int is_y_nvar = FALSE;
2434 Int nxpos = 0;
2435
2436 cip->cpc = cip->cpc->nextInst;
2437 nve = (Ventry *)(cip->cpc->rnd1);
2438 if (nve) {
2439 is_y_nvar = (nve->KindOfVE == PermVar);
2440 nxpos = nve->NoOfVE & MaskVarAdrs;
2441 }
2442 if (is_y_var) {
2443 if (is_y_nvar) {
2444 if (pass_no) {
2445 code_p->opc = emit_op(_p_func2f_yy);
2446 code_p->y_u.yyx.y1 = emit_y(ve);
2447 code_p->y_u.yyx.y2 = emit_y(nve);
2448 code_p->y_u.yyx.x = cmp_info->x1_arg;
2449 }
2450 GONEXT(yyx);
2451 return code_p;
2452 } else {
2453 if (pass_no) {
2454 code_p->opc = emit_op(_p_func2f_yx);
2455 code_p->y_u.yxx.y = emit_y(ve);
2456 code_p->y_u.yxx.x1 = emit_x(nxpos);
2457 code_p->y_u.yxx.x2 = cmp_info->x1_arg;
2458 }
2459 GONEXT(yxx);
2460 return code_p;
2461 }
2462 } else {
2463 if (is_y_nvar) {
2464 if (pass_no) {
2465 code_p->opc = emit_op(_p_func2f_xy);
2466 code_p->y_u.xxy.x1 = emit_x(xpos);
2467 code_p->y_u.xxy.y2 = emit_y(nve);
2468 code_p->y_u.xxy.x = cmp_info->x1_arg;
2469 }
2470 GONEXT(xxy);
2471 return code_p;
2472 } else {
2473 if (pass_no) {
2474 code_p->opc = emit_op(_p_func2f_xx);
2475 code_p->y_u.xxx.x1 = emit_x(xpos);
2476 code_p->y_u.xxx.x2 = emit_x(nxpos);
2477 code_p->y_u.xxx.x = cmp_info->x1_arg;
2478 }
2479 GONEXT(xxx);
2480 return code_p;
2481 }
2482 }
2483 }
2484 if (is_y_var) {
2485 switch (cmp_info->c_type) {
2486 case TYPE_XX:
2487 if (pass_no) {
2488 switch (opc) {
2489 case _plus:
2490 code_p->opc = emit_op(_p_plus_y_vv);
2491 break;
2492 case _minus:
2493 code_p->opc = emit_op(_p_minus_y_vv);
2494 break;
2495 case _times:
2496 code_p->opc = emit_op(_p_times_y_vv);
2497 break;
2498 case _div:
2499 code_p->opc = emit_op(_p_div_y_vv);
2500 break;
2501 case _and:
2502 code_p->opc = emit_op(_p_and_y_vv);
2503 break;
2504 case _or:
2505 code_p->opc = emit_op(_p_or_y_vv);
2506 break;
2507 case _sll:
2508 code_p->opc = emit_op(_p_sll_y_vv);
2509 break;
2510 case _slr:
2511 code_p->opc = emit_op(_p_slr_y_vv);
2512 break;
2513 case _arg:
2514 code_p->opc = emit_op(_p_arg_y_vv);
2515 break;
2516 case _functor:
2517 code_p->opc = emit_op(_p_func2s_y_vv);
2518 break;
2519 }
2520 code_p->y_u.yxx.y = emit_y(ve);
2521 code_p->y_u.yxx.x1 = cmp_info->x1_arg;
2522 code_p->y_u.yxx.x2 = cmp_info->x2_arg;
2523 }
2524 GONEXT(yxx);
2525 break;
2526 case TYPE_CX:
2527 if (pass_no) {
2528 switch (opc) {
2529 case _plus:
2530 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x1_arg,
2531 "internal assembler error CX for +/2 (should be XC)");
2532 save_machine_regs();
2533 siglongjmp(cip->CompilerBotch, 1);
2534 break;
2535 case _minus:
2536 code_p->opc = emit_op(_p_minus_y_cv);
2537 break;
2538 case _times:
2539 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x1_arg,
2540 "internal assembler error CX for */2 (should be XC)");
2541 save_machine_regs();
2542 siglongjmp(cip->CompilerBotch, 1);
2543 break;
2544 case _div:
2545 code_p->opc = emit_op(_p_div_y_cv);
2546 break;
2547 case _and:
2548 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x1_arg,
2549 "internal assembler error CX for /\\/2 (should be XC)");
2550 save_machine_regs();
2551 siglongjmp(cip->CompilerBotch, 1);
2552 break;
2553 case _or:
2554 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x1_arg,
2555 "internal assembler error CX for \\//2 (should be XC)");
2556 save_machine_regs();
2557 siglongjmp(cip->CompilerBotch, 1);
2558 break;
2559 case _sll:
2560 code_p->opc = emit_op(_p_sll_y_cv);
2561 break;
2562 case _slr:
2563 code_p->opc = emit_op(_p_slr_y_cv);
2564 break;
2565 case _arg:
2566 code_p->opc = emit_op(_p_arg_y_cv);
2567 break;
2568 case _functor:
2569 code_p->opc = emit_op(_p_func2s_y_cv);
2570 break;
2571 }
2572 code_p->y_u.yxn.y = emit_y(ve);
2573 code_p->y_u.yxn.c = cmp_info->c_arg;
2574 code_p->y_u.yxn.xi = cmp_info->x1_arg;
2575 }
2576 GONEXT(yxn);
2577 break;
2578 case TYPE_XC:
2579 if (pass_no) {
2580 switch (opc) {
2581 case _plus:
2582 code_p->opc = emit_op(_p_plus_y_vc);
2583 break;
2584 case _minus:
2585 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x2_arg,
2586 "internal assembler error XC for -/2");
2587 save_machine_regs();
2588 siglongjmp(cip->CompilerBotch, 1);
2589 break;
2590 case _times:
2591 code_p->opc = emit_op(_p_times_y_vc);
2592 break;
2593 case _div:
2594 code_p->opc = emit_op(_p_div_y_vc);
2595 break;
2596 case _and:
2597 code_p->opc = emit_op(_p_and_y_vc);
2598 break;
2599 case _or:
2600 code_p->opc = emit_op(_p_or_y_vc);
2601 break;
2602 case _sll:
2603 if ((Int)cmp_info->c_arg < 0) {
2604 code_p->opc = emit_op(_p_slr_y_vc);
2605 cmp_info->c_arg = -(Int)cmp_info->c_arg;
2606 } else {
2607 code_p->opc = emit_op(_p_sll_y_vc);
2608 }
2609 break;
2610 case _slr:
2611 if ((Int)cmp_info->c_arg < 0) {
2612 code_p->opc = emit_op(_p_sll_y_vc);
2613 cmp_info->c_arg = -(Int)cmp_info->c_arg;
2614 } else {
2615 code_p->opc = emit_op(_p_slr_y_vc);
2616 }
2617 break;
2618 case _arg:
2619 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x2_arg,
2620 "internal assembler error for arg/3");
2621 save_machine_regs();
2622 siglongjmp(cip->CompilerBotch, 1);
2623 break;
2624 case _functor:
2625 code_p->opc = emit_op(_p_func2s_y_vc);
2626 break;
2627 }
2628 code_p->y_u.yxn.y = emit_y(ve);
2629 code_p->y_u.yxn.c = cmp_info->c_arg;
2630 code_p->y_u.yxn.xi = cmp_info->x1_arg;
2631 }
2632 GONEXT(yxn);
2633 break;
2634 }
2635 } else {
2636 switch (cmp_info->c_type) {
2637 case TYPE_XX:
2638 if (pass_no) {
2639 switch (opc) {
2640 case _plus:
2641 code_p->opc = emit_op(_p_plus_vv);
2642 break;
2643 case _minus:
2644 code_p->opc = emit_op(_p_minus_vv);
2645 break;
2646 case _times:
2647 code_p->opc = emit_op(_p_times_vv);
2648 break;
2649 case _div:
2650 code_p->opc = emit_op(_p_div_vv);
2651 break;
2652 case _and:
2653 code_p->opc = emit_op(_p_and_vv);
2654 break;
2655 case _or:
2656 code_p->opc = emit_op(_p_or_vv);
2657 break;
2658 case _sll:
2659 code_p->opc = emit_op(_p_sll_vv);
2660 break;
2661 case _slr:
2662 code_p->opc = emit_op(_p_slr_vv);
2663 break;
2664 case _arg:
2665 code_p->opc = emit_op(_p_arg_vv);
2666 break;
2667 case _functor:
2668 code_p->opc = emit_op(_p_func2s_vv);
2669 break;
2670 }
2671 code_p->y_u.xxx.x = emit_x(xpos);
2672 code_p->y_u.xxx.x1 = cmp_info->x1_arg;
2673 code_p->y_u.xxx.x2 = cmp_info->x2_arg;
2674 }
2675 GONEXT(xxx);
2676 break;
2677 case TYPE_CX:
2678 if (pass_no) {
2679 switch (opc) {
2680 case _plus:
2681 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x1_arg,
2682 "internal assembler error CX for +/2");
2683 save_machine_regs();
2684 siglongjmp(cip->CompilerBotch, 1);
2685 break;
2686 case _minus:
2687 code_p->opc = emit_op(_p_minus_cv);
2688 break;
2689 case _times:
2690 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x1_arg,
2691 "internal assembler error CX for */2");
2692 save_machine_regs();
2693 siglongjmp(cip->CompilerBotch, 1);
2694 break;
2695 case _div:
2696 code_p->opc = emit_op(_p_div_cv);
2697 break;
2698 case _and:
2699 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x1_arg,
2700 "internal assembler error CX for /\\/2");
2701 save_machine_regs();
2702 siglongjmp(cip->CompilerBotch, 1);
2703 break;
2704 case _or:
2705 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x1_arg,
2706 "internal assembler error CX for \\//2");
2707 save_machine_regs();
2708 siglongjmp(cip->CompilerBotch, 1);
2709 break;
2710 case _sll:
2711 code_p->opc = emit_op(_p_sll_cv);
2712 break;
2713 case _slr:
2714 code_p->opc = emit_op(_p_slr_cv);
2715 break;
2716 case _arg:
2717 code_p->opc = emit_op(_p_arg_cv);
2718 break;
2719 case _functor:
2720 code_p->opc = emit_op(_p_func2s_cv);
2721 break;
2722 }
2723 code_p->y_u.xxn.x = emit_x(xpos);
2724 code_p->y_u.xxn.c = cmp_info->c_arg;
2725 code_p->y_u.xxn.xi = cmp_info->x1_arg;
2726 }
2727 GONEXT(xxn);
2728 break;
2729 case TYPE_XC:
2730 if (pass_no) {
2731 switch (opc) {
2732 case _plus:
2733 code_p->opc = emit_op(_p_plus_vc);
2734 break;
2735 case _minus:
2736 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x2_arg,
2737 "internal assembler error XC for -/2");
2738 save_machine_regs();
2739 siglongjmp(cip->CompilerBotch, 1);
2740 break;
2741 case _times:
2742 code_p->opc = emit_op(_p_times_vc);
2743 break;
2744 case _div:
2745 code_p->opc = emit_op(_p_div_vc);
2746 break;
2747 case _and:
2748 code_p->opc = emit_op(_p_and_vc);
2749 break;
2750 case _or:
2751 code_p->opc = emit_op(_p_or_vc);
2752 break;
2753 case _sll:
2754 if ((Int)cmp_info->c_arg < 0) {
2755 code_p->opc = emit_op(_p_slr_vc);
2756 cmp_info->c_arg = -(Int)cmp_info->c_arg;
2757 } else {
2758 code_p->opc = emit_op(_p_sll_vc);
2759 }
2760 break;
2761 case _slr:
2762 if ((Int)cmp_info->c_arg < 0) {
2763 code_p->opc = emit_op(_p_sll_vc);
2764 cmp_info->c_arg = -(Int)cmp_info->c_arg;
2765 } else {
2766 code_p->opc = emit_op(_p_slr_vc);
2767 }
2768 break;
2769 case _arg:
2770 Yap_ThrowError(SYSTEM_ERROR_COMPILER, cmp_info->x2_arg,
2771 "internal assembler error for arg/3");
2772 save_machine_regs();
2773 siglongjmp(cip->CompilerBotch, 1);
2774 break;
2775 case _functor:
2776 code_p->opc = emit_op(_p_func2s_vc);
2777 break;
2778 }
2779 code_p->y_u.xxn.x = emit_x(xpos);
2780 code_p->y_u.xxn.c = cmp_info->c_arg;
2781 code_p->y_u.xxn.xi = cmp_info->x1_arg;
2782 }
2783 GONEXT(xxn);
2784 break;
2785 }
2786 }
2787 return code_p;
2788}
2789
2790static yamop *a_special_label(yamop *code_p, int pass_no,
2791 struct intermediates *cip) {
2792 special_label_op lab_op = cip->cpc->rnd1;
2793 special_label_id lab_id = cip->cpc->rnd2;
2794 UInt lab_val = cip->cpc->rnd3;
2795
2796 switch (lab_op) {
2797 case SPECIAL_LABEL_INIT:
2798 switch (lab_id) {
2799 case SPECIAL_LABEL_EXCEPTION:
2800 cip->exception_handler = lab_val;
2801 break;
2802 case SPECIAL_LABEL_SUCCESS:
2803 cip->success_handler = lab_val;
2804 break;
2805 case SPECIAL_LABEL_FAILURE:
2806 cip->failure_handler = lab_val;
2807 break;
2808 }
2809 case SPECIAL_LABEL_SET:
2810 break;
2811 case SPECIAL_LABEL_CLEAR:
2812 switch (lab_id) {
2813 case SPECIAL_LABEL_EXCEPTION:
2814 cip->exception_handler = 0;
2815 break;
2816 case SPECIAL_LABEL_SUCCESS:
2817 cip->success_handler = 0;
2818 break;
2819 case SPECIAL_LABEL_FAILURE:
2820 cip->failure_handler = 0;
2821 break;
2822 }
2823 }
2824 return code_p;
2825}
2826
2827#ifdef YAPOR
2828#define TRYCODE(G, P) \
2829 a_try((G), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], \
2830 LOCAL_IPredArity, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, \
2831 pass_no, cip)
2832#define TABLE_TRYCODE(G) \
2833 a_try((G), (CELL)emit_ilabel(cip->cpc->rnd1, cip), LOCAL_IPredArity, \
2834 cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no, cip)
2835#else
2836#define TRYCODE(G, P) \
2837 a_try((G), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], \
2838 LOCAL_IPredArity, code_p, pass_no, cip)
2839#define TABLE_TRYCODE(G) \
2840 a_try((G), (CELL)emit_ilabel(cip->cpc->rnd1, cip), LOCAL_IPredArity, code_p, \
2841 pass_no, cip)
2842#endif /* YAPOR */
2843
2844static yamop *do_pass(int pass_no, yamop **entry_codep, int assembling,
2845 int *clause_has_blobsp, int *clause_has_dbtermp,
2846 struct intermediates *cip, UInt size USES_REGS) {
2847#ifdef YAPOR
2848#define MAX_DISJ_BRANCHES 256
2849 yamop *either_inst[MAX_DISJ_BRANCHES];
2850 int either_cont = 0;
2851#endif /* YAPOR */
2852 bool log_update;
2853 bool dynamic;
2854 bool tabled;
2855 int ystop_found = FALSE;
2856 union clause_obj *cl_u;
2857 yamop *code_p;
2858 cmp_op_info cmp_info;
2859 clause_info clinfo;
2860 int do_not_optimise_uatom;
2861
2862 code_p = cip->code_addr;
2863 cl_u = (union clause_obj *)code_p;
2864 cip->cpc = cip->CodeStart;
2865 clinfo.alloc_found = 0;
2866 clinfo.dealloc_found = FALSE;
2867 clinfo.CurrentPred = cip->CurrentPred;
2868 cip->current_try_lab = NULL;
2869 cip->exception_handler = 0;
2870 cip->success_handler = 0;
2871 cip->failure_handler = 0;
2872 cip->try_instructions = NULL;
2873 cmp_info.c_type = TYPE_XX;
2874 cmp_info.cl_info = &clinfo;
2875 do_not_optimise_uatom = FALSE;
2876
2877 /* Space while for the clause flags */
2878 log_update = cip->CurrentPred->PredFlags & LogUpdatePredFlag;
2879 dynamic = cip->CurrentPred->PredFlags & DynamicPredFlag;
2880 tabled = cip->CurrentPred->PredFlags & TabledPredFlag;
2881 if (assembling == ASSEMBLING_CLAUSE) {
2882 if (log_update) {
2883 if (pass_no) {
2884 cl_u->luc.Id = FunctorDBRef;
2885 cl_u->luc.ClFlags = LogUpdMask;
2886 if (cip->clause_has_cut)
2887 cl_u->luc.ClFlags |= HasCutMask;
2888 cl_u->luc.ClRefCount = 0;
2889 cl_u->luc.ClPred = cip->CurrentPred;
2890 /* Support for timestamps */
2891 if (cip->CurrentPred->LastCallOfPred != LUCALL_ASSERT) {
2892 if (cip->CurrentPred->TimeStampOfPred >= TIMESTAMP_RESET)
2893 Yap_UpdateTimestamps(cip->CurrentPred);
2894 ++cip->CurrentPred->TimeStampOfPred;
2895 /* fprintf(stderr,"+
2896 * %x--%d--%ul\n",cip->CurrentPred,cip->CurrentPred->TimeStampOfPred,cip->CurrentPred->ArityOfPE);*/
2897 cip->CurrentPred->LastCallOfPred = LUCALL_ASSERT;
2898 }
2899 cl_u->luc.ClTimeStart = cip->CurrentPred->TimeStampOfPred;
2900 cl_u->luc.ClTimeEnd = TIMESTAMP_EOT;
2901 if (*clause_has_blobsp) {
2902 cl_u->luc.ClFlags |= HasBlobsMask;
2903 }
2904 if (*clause_has_dbtermp) {
2905 cl_u->luc.ClFlags |= HasDBTMask;
2906 }
2907 cl_u->luc.ClExt = NULL;
2908 cl_u->luc.ClPrev = cl_u->luc.ClNext = NULL;
2909#if MULTIPLE_STACKS
2910 // INIT_LOCK(cl_u->luc.ClLock);
2911 INIT_CLREF_COUNT(&(cl_u->luc));
2912#endif
2913 }
2914 code_p = cl_u->luc.ClCode;
2915 } else if (dynamic) {
2916 if (pass_no) {
2917 cl_u->ic.ClFlags = DynamicMask;
2918 if (*clause_has_blobsp) {
2919 cl_u->ic.ClFlags |= HasBlobsMask;
2920 }
2921 if (*clause_has_dbtermp) {
2922 cl_u->ic.ClFlags |= HasDBTMask;
2923 }
2924 cl_u->ic.ClSize = size;
2925 cl_u->ic.ClRefCount = 0;
2926#if defined(YAPOR) || defined(THREADS)
2927 INIT_LOCK(cl_u->ic.ClLock);
2928#endif
2929#ifdef MULTIPLE_STACKS
2930 INIT_CLREF_COUNT(&(cl_u->ic));
2931#endif
2932 }
2933 code_p = cl_u->ic.ClCode;
2934 } else {
2935 /* static clause */
2936 if (pass_no) {
2937 cl_u->sc.ClFlags = StaticMask;
2938 if (cip->clause_has_cut)
2939 cl_u->sc.ClFlags |= HasCutMask;
2940 cl_u->sc.ClNext = NULL;
2941 cl_u->sc.ClSize = size;
2942 cl_u->sc.usc.ClLine = Yap_source_line_no();
2943 if (*clause_has_blobsp) {
2944 cl_u->sc.ClFlags |= HasBlobsMask;
2945 }
2946 if (*clause_has_dbtermp) {
2947 cl_u->sc.ClFlags |= HasDBTMask;
2948 }
2949 }
2950 code_p = cl_u->sc.ClCode;
2951 }
2952 LOCAL_IPredArity = cip->CurrentPred->ArityOfPE; /* number of args */
2953 *entry_codep = code_p;
2954 if (tabled) {
2955#if TABLING
2956#ifdef YAPOR
2957 code_p = a_try(_table_try_single, (CELL)NEXTOP(code_p, Otapl),
2958 LOCAL_IPredArity, 1, 0, code_p, pass_no, cip);
2959#else
2960 code_p = a_try(_table_try_single, (CELL)NEXTOP(code_p, Otapl),
2961 LOCAL_IPredArity, code_p, pass_no, cip);
2962#endif
2963#endif
2964 }
2965 if (dynamic) {
2966#ifdef YAPOR
2967 code_p = a_try(_try_me, 0, LOCAL_IPredArity, 1, 0, code_p, pass_no, cip);
2968#else
2969 code_p = a_try(_try_me, 0, LOCAL_IPredArity, code_p, pass_no, cip);
2970#endif /* YAPOR */
2971 }
2972#if THREADS || YAPOR
2973 if (log_update) {
2974 // separate from indexing code,
2975 // clauses are protected by time-stamps
2976 code_p = a_e(_unlock_lu, code_p, pass_no);
2977 }
2978#endif
2979 } else {
2980 /* index code */
2981 if (log_update) {
2982 if (pass_no) {
2983 cl_u->lui.ClFlags =
2984 LogUpdMask | IndexedPredFlag | IndexMask | SwitchRootMask;
2985 cl_u->lui.ChildIndex = NULL;
2986 cl_u->lui.SiblingIndex = NULL;
2987 cl_u->lui.PrevSiblingIndex = NULL;
2988 cl_u->lui.ClPred = cip->CurrentPred;
2989 cl_u->lui.ParentIndex = NULL;
2990 cl_u->lui.ClSize = size;
2991 cl_u->lui.ClRefCount = 0;
2992// INIT_LOCK(cl_u->lui.ClLock);
2993#if MULTIPLE_STACKS
2994 INIT_CLREF_COUNT(&(cl_u->lui));
2995#endif
2996 }
2997 code_p = cl_u->lui.ClCode;
2998 *entry_codep = code_p;
2999 } else {
3000 if (pass_no) {
3001 cl_u->si.ClSize = size;
3002 cl_u->si.ClFlags = IndexMask;
3003 cl_u->si.ChildIndex = NULL;
3004 cl_u->si.SiblingIndex = NULL;
3005 cl_u->si.ClPred = cip->CurrentPred;
3006 }
3007 code_p = cl_u->si.ClCode;
3008 *entry_codep = code_p;
3009 }
3010 }
3011 while (cip->cpc) {
3012 switch ((int)cip->cpc->op) {
3013#ifdef YAPOR
3014 case sync_op:
3015 code_p = a_try(_sync, cip->cpc->rnd1, cip->cpc->rnd2, 1, Zero, code_p,
3016 pass_no, cip);
3017 break;
3018#endif /* YAPOR */
3019#ifdef TABLING
3020 case table_new_answer_op:
3021 code_p = a_n(_table_new_answer, (int)cip->cpc->rnd2, code_p, pass_no);
3022 break;
3023 case table_try_single_op:
3024 code_p =
3025 a_gl(_table_try_single, code_p, pass_no, cip->cpc, cip PASS_REGS);
3026 break;
3027#endif /* TABLING */
3028#ifdef TABLING_INNER_CUTS
3029 case clause_with_cut_op:
3030 code_p = a_e(_clause_with_cut, code_p, pass_no);
3031 break;
3032#endif /* TABLING_INNER_CUTS */
3033#ifdef SFUNC
3034 case get_s_f_op:
3035 code_p = a_rf(_get_s_f, code_p, cip->cpc);
3036 break;
3037 case put_s_f_op:
3038 code_p = a_rf(_put_s_f, code_p, cip->cpc);
3039 break;
3040 case unify_s_f_op:
3041 code_p = a_d(_unify_s_f, code_p);
3042 break;
3043 case write_s_f_op:
3044 code_p = a_f(cip->cpc->rnd1, _write_s_f);
3045 break;
3046 case unify_s_var_op:
3047 code_p = a_vsf(_unify_s_xvar);
3048 break;
3049 case write_s_var_op:
3050 code_p = a_vsf(_write_s_xvar);
3051 break;
3052 case unify_s_val_op:
3053 code_p = a_vsf(_unify_s_xval);
3054 break;
3055 case write_s_val_op:
3056 code_p = a_vsf(_write_s_xval);
3057 break;
3058 case unify_s_a_op:
3059 code_p = a_asf(_unify_s_a);
3060 break;
3061 case write_s_a_op:
3062 code_p = a_asf(_write_s_a);
3063 break;
3064 case get_s_end_op:
3065 code_p = a_n(_get_s_end, Unsigned(0));
3066 break;
3067 case put_s_end_op:
3068 code_p = a_n(_put_s_end, Unsigned(0));
3069 break;
3070 case unify_s_end_op:
3071 code_p = a_n(_write_s_end, Unsigned(0));
3072 break;
3073 case write_s_end_op:
3074 code_p = a_n(_write_s_end, Unsigned(0));
3075 break;
3076#endif
3077 case get_var_op:
3078 code_p = a_vr(_get_x_var, _get_y_var, code_p, pass_no, cip);
3079 break;
3080 case put_var_op:
3081 code_p = a_vr(_put_x_var, _put_y_var, code_p, pass_no, cip);
3082 break;
3083 case get_val_op:
3084 code_p = a_vr(_get_x_val, _get_y_val, code_p, pass_no, cip);
3085 break;
3086 case put_val_op:
3087 code_p = a_vr(_put_x_val, _put_y_val, code_p, pass_no, cip);
3088 break;
3089 case get_num_op:
3090 case get_atom_op:
3091 code_p = a_rc(_get_atom, code_p, pass_no, cip);
3092 break;
3093 case get_float_op:
3094 *clause_has_blobsp = TRUE;
3095 code_p = a_rd(_get_float, code_p, pass_no, cip->cpc);
3096 break;
3097 case label_ctl_op:
3098 code_p = a_special_label(code_p, pass_no, cip);
3099 break;
3100 case get_longint_op:
3101 *clause_has_blobsp = TRUE;
3102 code_p = a_ri(_get_longint, code_p, pass_no, cip->cpc);
3103 break;
3104 case get_bigint_op:
3105 code_p = a_rb(_get_bigint, clause_has_blobsp, code_p, pass_no, cip);
3106 break;
3107 case get_string_op:
3108 code_p = a_rstring(_get_string, clause_has_blobsp, code_p, pass_no, cip);
3109 break;
3110 case get_dbterm_op:
3111 code_p = a_dbt(_get_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
3112 break;
3113 case put_num_op:
3114 case put_atom_op:
3115 code_p = a_rc(_put_atom, code_p, pass_no, cip);
3116 break;
3117 case put_float_op:
3118 *clause_has_blobsp = TRUE;
3119 code_p = a_rd(_put_float, code_p, pass_no, cip->cpc);
3120 break;
3121 case put_longint_op:
3122 *clause_has_blobsp = TRUE;
3123 code_p = a_ri(_put_longint, code_p, pass_no, cip->cpc);
3124 break;
3125 case put_bigint_op:
3126 code_p = a_rb(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
3127 break;
3128 case put_string_op:
3129 code_p = a_rstring(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
3130 break;
3131 case put_dbterm_op:
3132 code_p = a_dbt(_put_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
3133 break;
3134 case get_list_op:
3135 code_p = a_glist(&do_not_optimise_uatom, code_p, pass_no, cip);
3136 break;
3137 case put_list_op:
3138 code_p = a_r(cip->cpc->rnd2, _put_list, code_p, pass_no);
3139 break;
3140 case get_struct_op:
3141 code_p = a_rf(_get_struct, code_p, pass_no, cip->cpc);
3142 break;
3143 case put_struct_op:
3144 code_p = a_rf(_put_struct, code_p, pass_no, cip->cpc);
3145 break;
3146 case put_unsafe_op:
3147 code_p = a_vr(_put_unsafe, _put_unsafe, code_p, pass_no, cip);
3148 break;
3149 case unify_var_op:
3150 code_p = a_uvar(code_p, pass_no, cip);
3151 break;
3152 case unify_last_var_op:
3153 code_p =
3154 a_uv((Ventry *)cip->cpc->rnd1, _unify_l_x_var, _unify_l_x_var_write,
3155 _unify_l_y_var, _unify_l_y_var_write, code_p, pass_no);
3156 break;
3157 case write_var_op:
3158 code_p = a_wvar(code_p, pass_no, cip);
3159 break;
3160 case unify_local_op:
3161 code_p = a_uv((Ventry *)cip->cpc->rnd1, _unify_x_loc, _unify_x_loc_write,
3162 _unify_y_loc, _unify_y_loc_write, code_p, pass_no);
3163 break;
3164 case unify_val_op:
3165 code_p = a_uv((Ventry *)cip->cpc->rnd1, _unify_x_val, _unify_x_val_write,
3166 _unify_y_val, _unify_y_val_write, code_p, pass_no);
3167 break;
3168 case unify_last_local_op:
3169 code_p =
3170 a_uv((Ventry *)cip->cpc->rnd1, _unify_l_x_loc, _unify_l_x_loc_write,
3171 _unify_l_y_loc, _unify_l_y_loc_write, code_p, pass_no);
3172 break;
3173 case unify_last_val_op:
3174 code_p =
3175 a_uv((Ventry *)cip->cpc->rnd1, _unify_l_x_val, _unify_l_x_val_write,
3176 _unify_l_y_val, _unify_l_y_val_write, code_p, pass_no);
3177 break;
3178 case write_local_op:
3179 code_p = a_v(_write_x_loc, _write_y_loc, code_p, pass_no, cip->cpc);
3180 break;
3181 case write_val_op:
3182 code_p = a_v(_write_x_val, _write_y_val, code_p, pass_no, cip->cpc);
3183 break;
3184 case unify_num_op:
3185 case unify_atom_op:
3186 code_p =
3187 a_ucons(&do_not_optimise_uatom, unify_atom_op, code_p, pass_no, cip);
3188 break;
3189 case unify_float_op:
3190 *clause_has_blobsp = TRUE;
3191 code_p =
3192 a_ud(_unify_float, _unify_float_write, code_p, pass_no, cip->cpc);
3193 break;
3194 case unify_longint_op:
3195 *clause_has_blobsp = TRUE;
3196 code_p =
3197 a_ui(_unify_longint, _unify_longint_write, code_p, pass_no, cip->cpc);
3198 break;
3199 case unify_bigint_op:
3200 code_p = a_ublob(cip->cpc->rnd1, _unify_bigint, _unify_atom_write,
3201 clause_has_blobsp, code_p, pass_no, cip);
3202 break;
3203 case unify_string_op:
3204 code_p = a_ustring(cip->cpc->rnd1, _unify_string, _unify_atom_write,
3205 clause_has_blobsp, code_p, pass_no, cip);
3206 break;
3207 case unify_dbterm_op:
3208 code_p = a_udbt(cip->cpc->rnd1, _unify_dbterm, _unify_atom_write,
3209 clause_has_dbtermp, code_p, pass_no, cip);
3210 break;
3211 case unify_last_num_op:
3212 case unify_last_atom_op:
3213 code_p = a_uc(cip->cpc->rnd1, _unify_l_atom, _unify_l_atom_write, code_p,
3214 pass_no);
3215 break;
3216 case unify_last_float_op:
3217 *clause_has_blobsp = TRUE;
3218 code_p =
3219 a_ud(_unify_l_float, _unify_l_float_write, code_p, pass_no, cip->cpc);
3220 break;
3221 case unify_last_longint_op:
3222 *clause_has_blobsp = TRUE;
3223 code_p = a_ui(_unify_l_longint, _unify_l_longint_write, code_p, pass_no,
3224 cip->cpc);
3225 break;
3226 case unify_last_bigint_op:
3227 code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write,
3228 clause_has_blobsp, code_p, pass_no, cip);
3229 break;
3230 case unify_last_string_op:
3231 code_p = a_ustring(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write,
3232 clause_has_blobsp, code_p, pass_no, cip);
3233 break;
3234 case unify_last_dbterm_op:
3235 code_p = a_udbt(cip->cpc->rnd1, _unify_l_dbterm, _unify_l_atom_write,
3236 clause_has_dbtermp, code_p, pass_no, cip);
3237 break;
3238 case write_num_op:
3239 case write_atom_op:
3240 code_p =
3241 a_ucons(&do_not_optimise_uatom, write_atom_op, code_p, pass_no, cip);
3242 break;
3243 case write_float_op:
3244 *clause_has_blobsp = TRUE;
3245 code_p = a_wd(_write_float, code_p, pass_no, cip->cpc);
3246 break;
3247 case write_longint_op:
3248 *clause_has_blobsp = TRUE;
3249 code_p = a_wi(_write_longint, code_p, pass_no, cip->cpc);
3250 break;
3251 case write_bigint_op:
3252 code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p,
3253 pass_no, cip);
3254 break;
3255 case write_string_op:
3256 code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p,
3257 pass_no, cip);
3258 break;
3259 case write_dbterm_op:
3260 code_p = a_wdbt(cip->cpc->rnd1, _write_dbterm, clause_has_dbtermp, code_p,
3261 pass_no, cip);
3262 break;
3263 case unify_list_op:
3264 code_p = a_ue(_unify_list, _unify_list_write, code_p, pass_no);
3265 break;
3266 case unify_last_list_op:
3267 code_p = a_ue(_unify_l_list, _unify_l_list_write, code_p, pass_no);
3268 break;
3269 case write_list_op:
3270 code_p = a_e(_write_list, code_p, pass_no);
3271 break;
3272 case write_last_list_op:
3273 code_p = a_e(_write_l_list, code_p, pass_no);
3274 break;
3275 case unify_struct_op:
3276 code_p = a_uf(cip->cpc->rnd1, _unify_struct, _unify_struct_write, code_p,
3277 pass_no);
3278 break;
3279 case unify_last_struct_op:
3280 code_p = a_uf(cip->cpc->rnd1, _unify_l_struc, _unify_l_struc_write,
3281 code_p, pass_no);
3282 break;
3283 case write_struct_op:
3284 code_p = a_f(cip->cpc->rnd1, _write_struct, code_p, pass_no);
3285 break;
3286 case write_last_struct_op:
3287 code_p = a_f(cip->cpc->rnd1, _write_l_struc, code_p, pass_no);
3288 break;
3289 case save_b_op:
3290 case patch_b_op:
3291 code_p = a_v(_save_b_x, _save_b_y, code_p, pass_no, cip->cpc);
3292 break;
3293 case commit_b_op:
3294 cip->clause_has_cut = TRUE;
3295 code_p =
3296 a_vp(_commit_b_x, _commit_b_y, code_p, pass_no, cip->cpc, &clinfo);
3297 break;
3298 case soft_cut_b_op:
3299 cip->clause_has_cut = TRUE;
3300 code_p =
3301 a_vp(_soft_cut_b_x, _soft_cut_b_y, code_p, pass_no, cip->cpc, &clinfo);
3302 break;
3303 case save_pair_op:
3304 code_p = a_uv((Ventry *)cip->cpc->rnd1, _save_pair_x, _save_pair_x_write,
3305 _save_pair_y, _save_pair_y_write, code_p, pass_no);
3306 break;
3307 case save_appl_op:
3308 code_p = a_uv((Ventry *)cip->cpc->rnd1, _save_appl_x, _save_appl_x_write,
3309 _save_appl_y, _save_appl_y_write, code_p, pass_no);
3310 break;
3311 case fail_op:
3312 code_p = a_e(_op_fail, code_p, pass_no);
3313 code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
3314 break;
3315 case cut_op:
3316 code_p = a_cut(&clinfo, code_p, pass_no, cip);
3317 break;
3318 case cutexit_op:
3319 cip->clause_has_cut = TRUE;
3320 if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
3321 (*clause_has_blobsp || *clause_has_dbtermp) && !clinfo.alloc_found)
3322 code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip);
3323 code_p = a_cut(&clinfo, code_p, pass_no, cip);
3324 break;
3325 case allocate_op:
3326 clinfo.alloc_found = 2;
3327 break;
3328 case deallocate_op:
3329 code_p = a_deallocate(&clinfo, code_p, pass_no, cip);
3330 break;
3331 case tryme_op:
3332#ifdef TABLING
3333 if (tabled)
3334 code_p = TABLE_TRYCODE(_table_try_me);
3335 else
3336#endif
3337 code_p = TRYCODE(_try_me, _try_me0);
3338 break;
3339 case retryme_op:
3340#ifdef TABLING
3341 if (tabled)
3342 code_p = TABLE_TRYCODE(_table_retry_me);
3343 else
3344#endif
3345 code_p = TRYCODE(_retry_me, _retry_me0);
3346 break;
3347 case trustme_op:
3348#ifdef TABLING
3349 if (tabled)
3350 code_p = TABLE_TRYCODE(_table_trust_me);
3351 else
3352#endif
3353 code_p = TRYCODE(_trust_me, _trust_me0);
3354 break;
3355 case enter_lu_op:
3356 code_p = a_lucl(_enter_lu_pred, code_p, pass_no, cip, &clinfo);
3357 break;
3358 case try_op:
3359 if (log_update) {
3360 add_clref(cip->cpc->rnd1, pass_no);
3361 }
3362#ifdef TABLING
3363 if (tabled)
3364 code_p = a_gl(_table_try, code_p, pass_no, cip->cpc, cip PASS_REGS);
3365 else
3366#endif
3367 code_p = a_gl(_try_clause, code_p, pass_no, cip->cpc, cip PASS_REGS);
3368 break;
3369 case retry_op:
3370 if (log_update) {
3371 add_clref(cip->cpc->rnd1, pass_no);
3372 }
3373#ifdef TABLING
3374 if (tabled)
3375 code_p = a_gl(_table_retry, code_p, pass_no, cip->cpc, cip PASS_REGS);
3376 else
3377#endif
3378 code_p = a_gl(_retry, code_p, pass_no, cip->cpc, cip PASS_REGS);
3379 break;
3380 case trust_op:
3381 if (log_update) {
3382 add_clref(cip->cpc->rnd1, pass_no);
3383 }
3384#ifdef TABLING
3385 if (tabled)
3386 code_p = a_gl(_table_trust, code_p, pass_no, cip->cpc, cip PASS_REGS);
3387 else
3388#endif
3389 code_p = a_gl(_trust, code_p, pass_no, cip->cpc, cip PASS_REGS);
3390 break;
3391 case try_in_op:
3392 code_p = a_il(cip->cpc->rnd1, _try_in, code_p, pass_no, cip);
3393 break;
3394 case jump_op:
3395 /* don't assemble jumps to next instruction */
3396 if (cip->cpc->nextInst == NULL || cip->cpc->nextInst->op != label_op ||
3397 cip->cpc->rnd1 != cip->cpc->nextInst->rnd1) {
3398 code_p = a_l(cip->cpc->rnd1, _jump, code_p, pass_no, cip);
3399 }
3400 break;
3401 case jumpi_op:
3402 code_p = a_il(cip->cpc->rnd1, _jump, code_p, pass_no, cip);
3403 break;
3404 case restore_tmps_op:
3405 code_p = a_l(cip->cpc->rnd1, _move_back, code_p, pass_no, cip);
3406 break;
3407 case restore_tmps_and_skip_op:
3408 code_p = a_l(cip->cpc->rnd1, _skip, code_p, pass_no, cip);
3409 break;
3410 case procceed_op:
3411 if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
3412 (*clause_has_blobsp || *clause_has_dbtermp) && !clinfo.alloc_found)
3413 code_p = a_cle(_alloc_for_logical_pred, code_p, pass_no, cip);
3414 code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
3415 break;
3416 case call_op:
3417 code_p = a_p(_call, &clinfo, code_p, pass_no, cip);
3418 break;
3419 case execute_op:
3420 code_p = a_p(_execute, &clinfo, code_p, pass_no, cip);
3421 break;
3422 case safe_call_op:
3423 code_p = a_p(_call, &clinfo, code_p, pass_no, cip);
3424 break;
3425 case label_op:
3426 if (!ystop_found && cip->cpc->nextInst != NULL &&
3427 (cip->cpc->nextInst->op == mark_initialized_pvars_op ||
3428 cip->cpc->nextInst->op == mark_live_regs_op ||
3429 cip->cpc->nextInst->op == blob_op ||
3430 cip->cpc->nextInst->op == string_op)) {
3431 ystop_found = TRUE;
3432 code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
3433 }
3434 if (!pass_no) {
3435#if !USE_SYSTEM_MALLOC
3436 if (CellPtr(cip->label_offset + cip->cpc->rnd1) > ASP - 256) {
3437 LOCAL_ThrowError_Size =
3438 256 + ((char *)(cip->label_offset + cip->cpc->rnd1) - (char *)HR);
3439 save_machine_regs();
3440 siglongjmp(cip->CompilerBotch, 3);
3441 }
3442 if ((char *)(cip->label_offset + cip->cpc->rnd1) >= cip->freep)
3443 cip->freep = (char *)(cip->label_offset + (cip->cpc->rnd1 + 1));
3444#endif
3445
3446 cip->label_offset[cip->cpc->rnd1] = (CELL)code_p;
3447 }
3448 /* reset dealloc_found in case there was a branch */
3449 clinfo.dealloc_found = FALSE;
3450 break;
3451 case ensure_space_op:
3452 code_p = a_ensure_space(_ensure_space, code_p, pass_no, cip, &clinfo);
3453 break;
3454 case pop_op:
3455 if (cip->cpc->rnd1 == 1)
3456 code_p = a_e(_pop, code_p, pass_no);
3457 else {
3458 code_p =
3459 a_n(_pop_n, 2 * CELLSIZE * (cip->cpc->rnd1 - 1), code_p, pass_no);
3460 }
3461 break;
3462 case either_op:
3463 code_p = check_alloc(&clinfo, code_p, pass_no, cip);
3464#ifdef YAPOR
3465 if (pass_no)
3466 either_inst[either_cont++] = code_p;
3467 if (either_cont == MAX_DISJ_BRANCHES) {
3468 Yap_ThrowError(SYSTEM_ERROR_FATAL, TermNil,
3469 "Too Many Branches in disjunction: please increase "
3470 "MAX_DISJ_BRANCHES in amasm.c\n");
3471 exit(1);
3472 }
3473 code_p =
3474 a_either(_either, -Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2,
3475 Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1],
3476 0, code_p, pass_no, cip);
3477#else
3478 code_p =
3479 a_either(_either, -Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2,
3480 Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1],
3481 code_p, pass_no, cip);
3482#endif /* YAPOR */
3483 break;
3484 case orelse_op:
3485#ifdef YAPOR
3486 if (pass_no)
3487 either_inst[either_cont++] = code_p;
3488 code_p =
3489 a_either(_or_else, -Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2,
3490 Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1],
3491 0, code_p, pass_no, cip);
3492#else
3493 code_p =
3494 a_either(_or_else, -Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2,
3495 Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1],
3496 code_p, pass_no, cip);
3497#endif /* YAPOR */
3498 clinfo.dealloc_found = FALSE;
3499 break;
3500 case orlast_op:
3501#ifdef YAPOR
3502 if (pass_no)
3503 either_inst[either_cont++] = code_p;
3504 code_p = a_either(_or_last, 0, 0, 0, code_p, pass_no, cip);
3505 if (pass_no) {
3506 int cont = 1;
3507 do {
3508 either_cont--;
3509 PUT_YAMOP_LTT(either_inst[either_cont], cont++);
3510 } while (either_inst[either_cont]->opc != opcode(_either));
3511 }
3512#else
3513 code_p = a_pl(_or_last, cip->CurrentPred, code_p, pass_no);
3514#endif /* YAPOR */
3515 clinfo.dealloc_found = FALSE;
3516 break;
3517 case cache_arg_op:
3518 code_p = a_4sw_x(_switch_on_arg_type, code_p, pass_no, cip);
3519 break;
3520 case cache_sub_arg_op:
3521 code_p = a_4sw_s(_switch_on_sub_arg_type, code_p, pass_no, cip);
3522 break;
3523 case jump_v_op:
3524 code_p = a_igl(cip->cpc->rnd1, _jump_if_var, code_p, pass_no, cip);
3525 break;
3526 case jump_nv_op:
3527 code_p = a_xigl(_jump_if_nonvar, code_p, pass_no, cip->cpc);
3528 break;
3529 case user_switch_op:
3530 code_p = a_lp(_user_switch, code_p, pass_no, cip);
3531 break;
3532 case switch_on_type_op:
3533 code_p = a_4sw(_switch_on_type, code_p, pass_no, cip);
3534 break;
3535 case switch_c_op:
3536 code_p = a_hx(_switch_on_cons, cl_u, log_update, code_p, pass_no, cip);
3537 break;
3538 case switch_f_op:
3539 code_p = a_hx(_switch_on_func, cl_u, log_update, code_p, pass_no, cip);
3540 break;
3541 case if_c_op:
3542 if (cip->cpc->rnd1 == 1) {
3543 code_p = a_if(_go_on_cons, cl_u, log_update, code_p, pass_no, cip);
3544 } else {
3545 code_p = a_if(_if_cons, cl_u, log_update, code_p, pass_no, cip);
3546 }
3547 break;
3548 case if_f_op:
3549 if (cip->cpc->rnd1 == 1) {
3550 code_p = a_if(_go_on_func, cl_u, log_update, code_p, pass_no, cip);
3551 } else {
3552 code_p = a_if(_if_func, cl_u, log_update, code_p, pass_no, cip);
3553 }
3554 break;
3555 case if_not_op:
3556 code_p = a_ifnot(_if_not_then, code_p, pass_no, cip);
3557 break;
3558 case index_dbref_op:
3559 code_p = a_e(_index_dbref, code_p, pass_no);
3560 break;
3561 case index_blob_op:
3562 code_p = a_e(_index_blob, code_p, pass_no);
3563 break;
3564 case index_long_op:
3565 code_p = a_e(_index_long, code_p, pass_no);
3566 break;
3567 case mark_initialized_pvars_op:
3568 if (!ystop_found) {
3569 code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
3570 ystop_found = TRUE;
3571 }
3572 code_p = a_bmap(code_p, pass_no, cip->cpc);
3573 break;
3574 case mark_live_regs_op:
3575 if (!ystop_found) {
3576 code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
3577 printf("-> %p\n", code_p->y_u.l.l);
3578 ystop_found = TRUE;
3579 }
3580 code_p = a_bregs(code_p, pass_no, cip->cpc);
3581 break;
3582 case fetch_args_vv_op:
3583 a_fetch_vv(&cmp_info, pass_no, cip);
3584 break;
3585 case fetch_args_vc_op:
3586 case fetch_args_vi_op:
3587 a_fetch_vc(&cmp_info, pass_no, cip);
3588 break;
3589 case fetch_args_cv_op:
3590 case fetch_args_iv_op:
3591 a_fetch_cv(&cmp_info, pass_no, cip);
3592 break;
3593 case f_val_op:
3594 code_p = a_f2(&cmp_info, code_p, pass_no, cip);
3595 break;
3596 case f_var_op:
3597 code_p = a_f2(&cmp_info, code_p, pass_no, cip);
3598 break;
3599 case f_0_op:
3600 code_p = a_f2(&cmp_info, code_p, pass_no, cip);
3601 break;
3602 case enter_profiling_op: {
3603 PredEntry *pe = (PredEntry *)(cip->cpc->rnd1);
3604 if ((pe->PredFlags & (CPredFlag | UserCPredFlag | AsmPredFlag)) ||
3605 !pe->ModuleOfPred) {
3606 code_p = a_pl(_enter_profiling, pe, code_p, pass_no);
3607 Yap_initProfiler(pe);
3608 }
3609 } break;
3610 case retry_profiled_op:
3611 if (!Yap_initProfiler(cip->CurrentPred)) {
3612 return NULL;
3613 }
3614 code_p =
3615 a_pl(_retry_profiled, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
3616 break;
3617 case count_call_op: {
3618 PredEntry *pe = (PredEntry *)(cip->cpc->rnd1);
3619 if ((pe->PredFlags & (CPredFlag | UserCPredFlag | AsmPredFlag)) ||
3620 !pe->ModuleOfPred) {
3621 code_p =
3622 a_pl(_count_call, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
3623 }
3624 } break;
3625 case count_retry_op:
3626 code_p =
3627 a_pl(_count_retry, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
3628 break;
3629 case bccall_op:
3630 code_p =
3631 a_bfunc(cip->cpc->rnd1, cip->cpc->rnd3, (PredEntry *)(cip->cpc->rnd5),
3632 &clinfo, code_p, pass_no, cip);
3633 break;
3634 case align_float_op:
3635/* install a blob */
3636#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
3637 if (!((CELL)code_p & 0x4))
3638 GONEXT(e);
3639#endif
3640 break;
3641 case blob_op:
3642 /* install a blob */
3643 code_p = copy_blob(code_p, pass_no, cip->cpc);
3644 break;
3645 case string_op:
3646 /* install a blob */
3647 code_p = copy_string(code_p, pass_no, cip->cpc);
3648 break;
3649 case empty_call_op:
3650 /* create an empty call */
3651 code_p = a_empty_call(&clinfo, code_p, pass_no, cip);
3652 break;
3653 case push_or_op:
3654 /* be sure to allocate if we have an ;, even if it is
3655 compiled inline.
3656 */
3657 code_p = check_alloc(&clinfo, code_p, pass_no, cip);
3658 case pushpop_or_op:
3659 case pop_or_op:
3660 case nop_op:
3661 case name_op:
3662 break;
3663#ifdef BEAM
3664 case body_op:
3665 case endgoal_op:
3666 break;
3667 case run_op:
3668 code_p = a_eam(_run_eam, cip->cpc->rnd2,
3669 (long)((PredEntry *)cip->cpc->rnd2)->beamTable->last,
3670 code_p, pass_no);
3671 break;
3672#endif
3673 default:
3674 Yap_ThrowError(SYSTEM_ERROR_COMPILER, TermNil,
3675 "instruction %d found while assembling", (int)cip->cpc->op);
3676 save_machine_regs();
3677 siglongjmp(cip->CompilerBotch, 1);
3678 }
3679 cip->cpc = cip->cpc->nextInst;
3680 }
3681 if (!ystop_found)
3682 code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip);
3683 return code_p;
3684}
3685
3686static DBTerm *fetch_clause_space(Term *tp, UInt size,
3687 struct intermediates *cip,
3688 UInt *osizep USES_REGS) {
3689 CELL *h0 = HR;
3690 DBTerm *x;
3691
3692 /* This stuff should be just about fetching the space from the data-base,
3693 unfortunately we have to do all sorts of error handling :-( */
3694 HR = (CELL *)cip->freep;
3695 while ((x = Yap_StoreTermInDBPlusExtraSpace(*tp, size, osizep)) == NULL) {
3696
3697 HR = h0;
3698 switch (LOCAL_Error_TYPE) {
3699 case RESOURCE_ERROR_STACK:
3700 LOCAL_Error_Size = 256 + ((char *)cip->freep - (char *)HR);
3701 save_machine_regs();
3702 siglongjmp(cip->CompilerBotch, 3);
3703 case RESOURCE_ERROR_TRAIL:
3704 /* don't just return NULL */
3705 ARG1 = *tp;
3706 if (!Yap_growtrail(K64, FALSE)) {
3707 return NULL;
3708 }
3709 LOCAL_Error_TYPE = YAP_NO_ERROR;
3710 *tp = ARG1;
3711 break;
3712 case RESOURCE_ERROR_AUXILIARY_STACK:
3713 ARG1 = *tp;
3714 if (!Yap_ExpandPreAllocCodeSpace(LOCAL_Error_Size, (void *)cip, TRUE)) {
3715 return NULL;
3716 }
3717 LOCAL_Error_TYPE = YAP_NO_ERROR;
3718 *tp = ARG1;
3719 break;
3720 case RESOURCE_ERROR_HEAP:
3721 /* don't just return NULL */
3722 ARG1 = *tp;
3723 if (!Yap_growheap(TRUE, size, cip)) {
3724 return NULL;
3725 }
3726 LOCAL_Error_TYPE = YAP_NO_ERROR;
3727 *tp = ARG1;
3728 break;
3729 default:
3730 return NULL;
3731 }
3732 h0 = HR;
3733 HR = (CELL *)cip->freep;
3734 }
3735 HR = h0;
3736 return x;
3737}
3738
3739static DBTermList *init_dbterms_list(yamop *code_p, PredEntry *ap) {
3740 DBTermList *new;
3741 if ((new = (DBTermList *)Yap_AllocCodeSpace(sizeof(DBTermList))) == NULL) {
3742 return NULL;
3743 }
3744 new->dbterms = NULL;
3745 new->clause_code = code_p;
3746 new->p = ap;
3747 LOCK(DBTermsListLock);
3748 new->next_dbl = DBTermsList;
3749 DBTermsList = new;
3750 UNLOCK(DBTermsListLock);
3751 return new;
3752}
3753
3754#define DEFAULT_NLABELS 4096
3755
3756yamop *Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact,
3757 struct intermediates *cip, UInt max_label) {
3758 CACHE_REGS
3759 /*
3760 * the assembly proccess is done in two passes: 1 - a first pass
3761 * computes labels offsets and total code size 2 - the second pass
3762 * produces the final version of the code
3763 */
3764 UInt size = 0;
3765 yamop *entry_code;
3766 yamop *code_p;
3767 int clause_has_blobs = FALSE;
3768 int clause_has_dbterm = FALSE;
3769
3770#if USE_SYSTEM_MALLOC
3771 if (!cip->label_offset) {
3772 if (!LOCAL_LabelFirstArray && max_label <= DEFAULT_NLABELS) {
3773 LOCAL_LabelFirstArray =
3774 (Int *)Yap_AllocCodeSpace(sizeof(Int) * DEFAULT_NLABELS);
3775 LOCAL_LabelFirstArraySz = DEFAULT_NLABELS;
3776 if (!LOCAL_LabelFirstArray) {
3777 save_machine_regs();
3778 siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
3779 }
3780 }
3781 if (LOCAL_LabelFirstArray && max_label <= LOCAL_LabelFirstArraySz) {
3782 cip->label_offset = LOCAL_LabelFirstArray;
3783 } else {
3784 cip->label_offset = (Int *)Yap_AllocCodeSpace(sizeof(Int) * max_label);
3785 if (!cip->label_offset) {
3786 save_machine_regs();
3787 siglongjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH);
3788 }
3789 }
3790 }
3791#else
3792 cip->label_offset = (Int *)cip->freep;
3793#endif
3794 cip->clause_has_cut = FALSE;
3795 cip->code_addr = NULL;
3796 code_p = do_pass(0, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm,
3797 cip, size PASS_REGS);
3798 if (clause_has_dbterm) {
3799 cip->dbterml = init_dbterms_list(code_p, ap);
3800 }
3801 if (ap->PredFlags & DynamicPredFlag) {
3802 size = (CELL)NEXTOP(
3803 NEXTOP(NEXTOP((yamop *)(((DynamicClause *)NULL)->ClCode), Otapl),
3804 Osbpp),
3805 e);
3806 }
3807 if ((CELL)code_p > size)
3808 size = (CELL)code_p;
3809 if (mode == ASSEMBLING_CLAUSE && ap->PredFlags & LogUpdatePredFlag &&
3810 !is_fact) {
3811 DBTerm *x;
3812 LogUpdClause *cl;
3813 UInt osize;
3814
3815 if (!(x = fetch_clause_space(&t, size, cip, &osize PASS_REGS))) {
3816 return NULL;
3817 }
3818 cl = (LogUpdClause *)((CODEADDR)x - (UInt)size);
3819 cl->lusl.ClSource = x;
3820 cl->ClFlags |= SrcMask;
3821 x->ag.line_number = Yap_source_line_no();
3822 cl->ClSize = osize;
3823 cip->code_addr = (yamop *)cl;
3824 } else if (mode == ASSEMBLING_CLAUSE &&
3825 (ap->PredFlags & MultiFileFlag ||
3826 (ap->cs.p_code.NOfClauses == 0 &&
3827 trueGlobalPrologFlag(SOURCE_FLAG)) ||
3828 (ap->cs.p_code.NOfClauses > 0 &&
3829 (ap->PredFlags & SourcePredFlag))) &&
3830 !is_fact) {
3831 DBTerm *x;
3832 StaticClause *cl;
3833 UInt osize;
3834
3835 if (!(x = fetch_clause_space(&t, size, cip, &osize PASS_REGS))) {
3836 return NULL;
3837 }
3838 cl = (StaticClause *)((CODEADDR)x - (UInt)size);
3839 cip->code_addr = (yamop *)cl;
3840 code_p = do_pass(1, &entry_code, mode, &clause_has_blobs,
3841 &clause_has_dbterm, cip, size PASS_REGS);
3842 /* make sure we copy after second pass */
3843 cl->usc.ClSource = x;
3844 cl->ClFlags |= SrcMask;
3845 x->ag.line_number = Yap_source_line_no();
3846 cl->ClSize = osize;
3847 LOCAL_ProfEnd = code_p;
3848 Yap_inform_profiler_of_clause(cl, LOCAL_ProfEnd, ap, GPROF_CLAUSE);
3849 return entry_code;
3850 } else {
3851 while ((cip->code_addr = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
3852
3853 if (!Yap_growheap(TRUE, size, cip)) {
3854 LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
3855 LOCAL_Error_Size = size;
3856 return NULL;
3857 }
3858 }
3859 Yap_inform_profiler_of_clause(
3860 cip->code_addr, (char *)(cip->code_addr) + size, ap,
3861 (mode == ASSEMBLING_INDEX ? GPROF_INDEX : GPROF_CLAUSE));
3862 if (mode == ASSEMBLING_CLAUSE) {
3863 if (ap->PredFlags & LogUpdatePredFlag) {
3864 ((LogUpdClause *)(cip->code_addr))->ClSize = size;
3865 Yap_LUClauseSpace += size;
3866 } else {
3867 StaticClause *cl = ((StaticClause *)(cip->code_addr));
3868 cl->usc.ClSource = NULL;
3869 cl->ClSize = size;
3870 cl->ClFlags = 0;
3871 Yap_ClauseSpace += size;
3872 }
3873 } else {
3874 if (ap->PredFlags & LogUpdatePredFlag) {
3875 Yap_LUIndexSpace_Tree += size;
3876 } else
3877 Yap_IndexSpace_Tree += size;
3878 }
3879 }
3880 do_pass(1, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip,
3881 size PASS_REGS);
3882 return entry_code;
3883}
3884
3885void Yap_InitComma(void) {
3886 yamop *code_p = COMMA_CODE;
3887 code_p->opc = opcode(_call);
3888 code_p->y_u.Osbpp.s = emit_count(-Signed(RealEnvSize) - sizeof(CELL) * 3);
3889 code_p->y_u.Osbpp.p = code_p->y_u.Osbpp.p0 =
3890 RepPredProp(PredPropByFunc(FunctorComma, 0));
3891 code_p->y_u.Osbpp.bmap = NULL;
3892 GONEXT(Osbpp);
3893 code_p->opc = opcode(_p_execute_tail);
3894 code_p->y_u.Osbmp.s = emit_count(-Signed(RealEnvSize) - 3 * sizeof(CELL));
3895 code_p->y_u.Osbmp.bmap = NULL;
3896 code_p->y_u.Osbmp.mod = MkAtomTerm(AtomUser);
3897 code_p->y_u.Osbmp.p0 = RepPredProp(PredPropByFunc(FunctorComma, 0));
3898 GONEXT(Osbmp);
3899 code_p->opc = emit_op(_deallocate);
3900 code_p->y_u.p.p = PredMetaCall;
3901 GONEXT(p);
3902 code_p->opc = emit_op(_procceed);
3903 code_p->y_u.p.p = PredMetaCall;
3904 GONEXT(p);
3905}
3906
3907yamop *Yap_InitCommaContinuation(PredEntry *pe) {
3908 arity_t arity = pe->ArityOfPE, i;
3909 yamop *code_p = NULL;
3910
3911 GONEXT(Osbmp);
3912 for (i = 0; i < arity; i++)
3913 GONEXT(yx);
3914 GONEXT(Osbmp);
3915pe->MetaEntryOfPred = code_p =
3916Yap_AllocCodeSpace((size_t)code_p);
3917 code_p->opc = opcode(_call);
3918 code_p->y_u.Osbpp.s = emit_count(-Signed(RealEnvSize) - sizeof(CELL) * pe->ArityOfPE);
3919 code_p->y_u.Osbpp.p =
3920 code_p->y_u.Osbpp.p0 = PredMetaCall;
3921 code_p->y_u.Osbpp.bmap = NULL;
3922 GONEXT(Osbmp);
3923 for (i = 0; i < arity; i++) {
3924 code_p->opc = opcode(_put_y_var);
3925 code_p->y_u.yx.y = -i - Signed(RealEnvSize) / sizeof(CELL);
3926 code_p->y_u.yx.x = emit_xreg(i + 1);
3927 GONEXT(yx);
3928 }
3929 code_p->opc = opcode(_dexecute);
3930 code_p->y_u.Osbpp.p0 = PredMetaCall;
3931 code_p->y_u.Osbpp.s = -Signed(RealEnvSize);
3932 code_p->y_u.Osbpp.p = pe;
3933 GONEXT(Osbpp);
3934 return pe->MetaEntryOfPred;
3935}
Yap.h
Main definitions.
DB_TERM
Definition: Yatom.h:689
clause_info_struct
Definition: amasm.c:216
cmp_op_info_struct
Definition: amasm.c:209
dbterm_list
Definition: clause.h:228
dynamic_clause
Definition: clause.h:101
gc_mark_continuation
Definition: heapgc.c:59
logic_upd_clause
Definition: clause.h:64
logic_upd_index
Definition: clause.h:46
pred_entry
Definition: Yatom.h:544
profile_data
Definition: Yatom.h:529
static_clause
Definition: clause.h:127
static_index
Definition: clause.h:116
x_el
Definition: YapFlags.h:152
yami
Definition: amidefs.h:264
clause_obj
Definition: clause.h:152