~burner/xsb/debianized-xsb

« back to all changes in this revision

Viewing changes to emu/slginsts_xsb_i.h

  • Committer: Michael R. Head
  • Date: 2006-09-06 22:11:55 UTC
  • Revision ID: burner@n23-20060906221155-7e398d23438a7ee4
Add the files from the 3.0.1 release package

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/* File:      slginsts_xsb_i.h
 
2
** Author(s): Swift, Rao, Sagonas, Freire, Cui, Johnson
 
3
** Contact:   xsb-contact@cs.sunysb.edu
 
4
** 
 
5
** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998
 
6
** 
 
7
** XSB is free software; you can redistribute it and/or modify it under the
 
8
** terms of the GNU Library General Public License as published by the Free
 
9
** Software Foundation; either version 2 of the License, or (at your option)
 
10
** any later version.
 
11
** 
 
12
** XSB is distributed in the hope that it will be useful, but WITHOUT ANY
 
13
** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
14
** FOR A PARTICULAR PURPOSE.  See the GNU Library General Public License for
 
15
** more details.
 
16
** 
 
17
** You should have received a copy of the GNU Library General Public License
 
18
** along with XSB; if not, write to the Free Software Foundation,
 
19
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
20
**
 
21
** $Id: slginsts_xsb_i.h,v 1.59 2006/06/02 23:32:39 ruim Exp $
 
22
** 
 
23
*/
 
24
 
 
25
 
 
26
/* special debug includes */
 
27
#include "debugs/debug_delay.h"
 
28
 
 
29
 
 
30
#define ARITY   op1     /* register Cell */
 
31
#define Yn      op2     /* register Cell */
 
32
#define LABEL   op3     /* CPtr */
 
33
 
 
34
/*-------------------------------------------------------------------------*/
 
35
 
 
36
/*
 
37
 *  Organization of Tabling Choice Points:
 
38
 *
 
39
 *             +-------------+
 
40
 *             |             |   LOW MEMORY
 
41
 *             |    Trail    |
 
42
 *             |             |
 
43
 *             |      |      |
 
44
 *             |      V      |
 
45
 *             |             |
 
46
 *             |             |
 
47
 *             |      ^      |
 
48
 *             |      |      |
 
49
 *             |             |
 
50
 *             |  CP Stack   |
 
51
 *             |             |
 
52
 *             |             |
 
53
 *             |=============|
 
54
 *             | Rest of CPF |--- Different for Generator and Consumer
 
55
 *             |-------------|_
 
56
 *             |   INT: m    | \
 
57
 *             |   Term-m    |  |
 
58
 *             |      .      |  |- Answer Template
 
59
 *             |      .      |  |
 
60
 *             |      .      |  |
 
61
 *             |   Term-1    |_/
 
62
 *             |=============|
 
63
 *             |      .      |
 
64
 *             |      .      |
 
65
 *             |      .      |    HIGH MEMORY
 
66
 *             +-------------+
 
67
 *
 
68
 *
 
69
 *  Answer Templates are stored in the Heap:
 
70
 *
 
71
 *             +-------------+
 
72
 *             |      .      |   LOW MEMORY
 
73
 *             |      .      |
 
74
 *             |      .      |
 
75
 *             |-------------|_
 
76
 *             |   Term-m    | \
 
77
 *             |      .      |  |
 
78
 *             |      .      |  |- Answer Template
 
79
 *             |      .      |  |
 
80
 *             |   Term-1    |  |
 
81
 *             |   INT: m    |_/
 
82
 *             |-------------|
 
83
 *             |             |
 
84
 *             |    Heap     |
 
85
 *             |             |
 
86
 *             |      |      |
 
87
 *             |      V      |
 
88
 *             |             |
 
89
 *             |             |
 
90
 *             |      ^      |
 
91
 *             |      |      |
 
92
 *             |             |
 
93
 *             |    Local    |
 
94
 *             |             |    HIGH MEMORY
 
95
 *             +-------------+
 
96
 */
 
97
 
 
98
/*-------------------------------------------------------------------------*/
 
99
 
 
100
/*
 
101
 *  Instruction format:
 
102
 *    1st word: opcode X X pred_arity
 
103
 *    2nd word: pred_first_clause_label
 
104
 *    3rd word: preds_TableInfo_record
 
105
 */
 
106
 
 
107
XSB_Start_Instr_Chained(tabletry,_tabletry)
 
108
XSB_Start_Instr(tabletrysingle,_tabletrysingle) 
 
109
  DefOps13
 
110
  /*
 
111
   *  Retrieve instruction arguments and test the system stacks for
 
112
   *  overflow.  The local PCreg, "lpcreg", is incremented to point to
 
113
   *  the instruction to be executed should this one fail.
 
114
   */
 
115
  byte this_instr = *lpcreg;
 
116
  byte *continuation;
 
117
  TabledCallInfo callInfo;
 
118
  CallLookupResults lookupResults;
 
119
  VariantSF producer_sf, consumer_sf;
 
120
  CPtr answer_template;
 
121
  int template_size, attv_num, tmp;
 
122
  TIFptr tip;
 
123
#ifdef SHARED_COMPL_TABLES
 
124
  byte * inst_addr = lpcreg;
 
125
  int table_tid ;
 
126
  int grabbed = FALSE;
 
127
  th_context * waiting_for_thread;
 
128
#endif
 
129
#ifdef MULTI_THREAD_RWL
 
130
  CPtr tbreg;
 
131
#ifdef SLG_GC
 
132
  CPtr old_cptop;
 
133
#endif
 
134
#endif
 
135
 
 
136
  xwammode = 1;
 
137
  CallInfo_Arguments(callInfo) = reg + 1;
 
138
  CallInfo_CallArity(callInfo) = get_xxa; 
 
139
  LABEL = (CPtr)((byte *) get_xxxl);  
 
140
  Op1(get_xxxxl);
 
141
  tip =  (TIFptr) get_xxxxl;
 
142
  SET_TRIE_ALLOCATION_TYPE_TIP(tip); /* No-op in seq engine */
 
143
#ifdef MULTI_THREAD
 
144
  handle_dispatch_block(tip);
 
145
#endif
 
146
  CallInfo_TableInfo(callInfo) = tip;
 
147
  ADVANCE_PC(size_xxxXX);
 
148
 
 
149
  check_tcpstack_overflow;
 
150
  CallInfo_VarVectorLoc(callInfo) = top_of_cpstack;
 
151
 
 
152
  if ( this_instr == tabletry ) {
 
153
    /* lpcreg was left pointing to the next clause, e.g. tableretry */
 
154
    continuation = lpcreg;
 
155
  }
 
156
  else 
 
157
    continuation = (pb) &check_complete_inst;
 
158
 
 
159
  check_glstack_overflow(CallInfo_CallArity(callInfo),lpcreg,OVERFLOW_MARGIN);
 
160
 
 
161
#ifdef SHARED_COMPL_TABLES
 
162
  pthread_mutex_lock( &completing_mut );
 
163
#endif
 
164
  /*
 
165
   *  Perform a call-check/insert operation on the current call.  The
 
166
   *  subterms of this call which form the answer template are
 
167
   *  computed and pushed on top of the CP stack, along with its size
 
168
   *  (encoded as a Prolog INT) .  A pointer to this size, followed by
 
169
   *  the reverse template vector (as depicted above), is returned in
 
170
   *  CallLUR_VarVector(lookupResults).  Always (now) the answer
 
171
   *  template is pushed on the Heap rather than the CPS.  In that
 
172
   *  case, (heap - 1) points to the A.T. and
 
173
   *  CallLUR_VarVector(lookupResults) has the same value as
 
174
   *  CallInfo_VarVectorLoc(callInfo).
 
175
   */
 
176
  table_call_search(CTXTc &callInfo,&lookupResults);
 
177
 
 
178
  producer_sf = CallLUR_Subsumer(lookupResults);
 
179
  answer_template = CallLUR_VarVector(lookupResults);
 
180
 
 
181
xsb_dbgmsg((LOG_DEBUG,"After variant call search AT: %x\n",answer_template));
 
182
 
 
183
#ifdef SHARED_COMPL_TABLES
 
184
/* This allows sharing of completed tables.
 
185
   If the subgoal frame is not new, and the table is being generated by
 
186
   a different thread, wait for it to complete.
 
187
 */
 
188
  if ( !IsNULL(producer_sf) ) {
 
189
     while( !is_completed(producer_sf))
 
190
     {  
 
191
        /* if is leader and subgoal is marked to be computed by leader */
 
192
        if( th->deadlock_brk_leader && subg_grabbed(producer_sf) )
 
193
        {       subg_tid(producer_sf) = th->tid ;
 
194
                subg_grabbed(producer_sf) = FALSE ;
 
195
                grabbed = TRUE ;
 
196
                break ;
 
197
        }
 
198
        table_tid = subg_tid(producer_sf) ;
 
199
        /* if the thread owns the table, proceed */
 
200
        if (table_tid == th->tid) 
 
201
                break ;
 
202
        waiting_for_thread = find_context(table_tid) ;
 
203
        if( would_deadlock( waiting_for_thread, th ) )
 
204
        {       /* code for leader */
 
205
                reset_other_threads( th, waiting_for_thread, producer_sf );
 
206
                th->deadlock_brk_leader = TRUE ;
 
207
                continue ;
 
208
        }
 
209
        th->waiting_for_subgoal = producer_sf ;
 
210
        th->waiting_for_thread = waiting_for_thread ;
 
211
        pthread_cond_wait(&completing_cond,&completing_mut) ;
 
212
        if( th->reset_thread )
 
213
        {       th->reset_thread = FALSE ;
 
214
                pthread_mutex_unlock(&completing_mut) ;
 
215
                /* restart the tabletry instruction */
 
216
                lpcreg = pcreg ;
 
217
                XSB_Next_Instr() ;
 
218
        }
 
219
     }
 
220
     th->waiting_for_thread = NULL ;
 
221
     th->waiting_for_subgoal = NULL ;
 
222
     pthread_mutex_unlock(&completing_mut);
 
223
  } 
 
224
 
 
225
  if ( IsNULL(producer_sf) || grabbed ) {
 
226
 
 
227
    /* New Producer
 
228
       ------------ */
 
229
    CPtr producer_cpf;
 
230
    if( !grabbed )
 
231
    {
 
232
      producer_sf = NewProducerSF(CTXTc CallLUR_Leaf(lookupResults),
 
233
                                   CallInfo_TableInfo(callInfo));
 
234
      subg_tid(producer_sf) = th->tid;
 
235
      subg_grabbed(producer_sf) = 0;
 
236
      pthread_mutex_unlock( &completing_mut );
 
237
    }
 
238
    else
 
239
    {   subg_compl_stack_ptr(producer_sf) = openreg - COMPLFRAMESIZE;
 
240
    }
 
241
#else  /* !SHARED_COMPL_TABLES */
 
242
#ifdef CONC_COMPL
 
243
    pthread_mutex_lock( &completing_mut ) ;
 
244
#endif
 
245
  if ( IsNULL(producer_sf) ) {
 
246
#ifdef CONC_COMPL
 
247
    pthread_mutex_unlock( &completing_mut ) ;
 
248
#endif
 
249
 
 
250
    /* New Producer
 
251
       ------------ */
 
252
    CPtr producer_cpf;
 
253
    producer_sf = NewProducerSF(CTXTc CallLUR_Leaf(lookupResults),
 
254
                                 CallInfo_TableInfo(callInfo));
 
255
#endif /* !SHARED_COMPL_TABLES */
 
256
#ifdef CONC_COMPL
 
257
    subg_tid(producer_sf) = th->tid;
 
258
    subg_tag(producer_sf) = INCOMP_ANSWERS;
 
259
#endif
 
260
    producer_cpf = answer_template;
 
261
    save_find_locx(ereg);
 
262
    save_registers(producer_cpf, CallInfo_CallArity(callInfo), rreg);
 
263
    SaveProducerCPF(producer_cpf, continuation, producer_sf,
 
264
                    CallInfo_CallArity(callInfo), (hreg - 1));
 
265
#ifdef SHARED_COMPL_TABLES
 
266
    tcp_reset_pcreg(producer_cpf) = inst_addr ;
 
267
#endif
 
268
#ifdef SLG_GC
 
269
    tcp_prevtop(producer_cpf) = answer_template; 
 
270
    /* answer_template points to the previous top, since the A.T. proper
 
271
       is now always copied to the heap */
 
272
#endif
 
273
    push_completion_frame(producer_sf);
 
274
#ifdef CONC_COMPL
 
275
    compl_ext_cons(openreg) = NULL ;
 
276
    tcp_compl_stack_ptr(producer_cpf) = openreg ;
 
277
#endif
 
278
    ptcpreg = (CPtr)producer_sf;
 
279
    subg_cp_ptr(producer_sf) = breg = producer_cpf;
 
280
    xsb_dbgmsg((LOG_COMPLETION,"just created tabled cp %x\n",breg));
 
281
    delayreg = NULL;
 
282
    if (root_address == 0)
 
283
      root_address = breg;
 
284
    hbreg = hreg;
 
285
    lpcreg = (byte *) LABEL;    /* branch to program clause */
 
286
    XSB_Next_Instr();
 
287
  }
 
288
 
 
289
  else if ( is_completed(producer_sf) ) {
 
290
 
 
291
#ifdef CONC_COMPL
 
292
    pthread_mutex_unlock( &completing_mut ) ;
 
293
#endif
 
294
    /* Unify Call with Answer Trie
 
295
       --------------------------- */
 
296
    if (has_answer_code(producer_sf)) {
 
297
      int i;
 
298
      xsb_dbgmsg((LOG_DELAY, "++Returning answers from COMPLETED table: "));
 
299
      dbg_print_subgoal(LOG_DELAY, stddbg, producer_sf);
 
300
      xsb_dbgmsg((LOG_DELAY, "\n"));
 
301
      answer_template = hreg - 1; 
 
302
 
 
303
      tmp = int_val(cell(answer_template));
 
304
      get_var_and_attv_nums(template_size, attv_num, tmp);
 
305
      num_vars_in_var_regs = -1;
 
306
 
 
307
      /* Initialize var_regs[] as the attvs in the call.  This is
 
308
         needed by the trie_xxx_val instructions, and the symbols of
 
309
         the trie nodes have been set up to account for this in
 
310
         variant_answer_search() -- see the documentation there.  */
 
311
      if (attv_num > 0) {
 
312
        CPtr cptr;
 
313
        for (cptr = answer_template - 1;
 
314
             cptr >= answer_template - template_size; cptr--) {
 
315
          // tls changed from 10/05 cptr >= answer_template + template_size; cptr++) 
 
316
          if (isattv(cell(cptr))) {
 
317
            var_regs[++num_vars_in_var_regs] = (CPtr) cell(cptr);
 
318
            xsb_dbgmsg((LOG_TRIE_INSTR, "setting var_regs for attv %d \n",
 
319
                        num_vars_in_var_regs));
 
320
          }
 
321
        }
 
322
        /* now num_vars_in_var_regs should be attv_num - 1 */
 
323
      }
 
324
 
 
325
      reg_arrayptr = reg_array-1;
 
326
      for (i = 0; i < template_size; i++) {
 
327
        pushreg(cell(answer_template-template_size+i));
 
328
      }
 
329
      delay_it = 1;
 
330
      lpcreg = (byte *)subg_ans_root_ptr(producer_sf);
 
331
#ifdef MULTI_THREAD_RWL
 
332
/* save choice point for trie_unlock instruction */
 
333
      save_find_locx(ereg);
 
334
      tbreg = top_of_cpstack;
 
335
#ifdef SLG_GC
 
336
      old_cptop = tbreg;
 
337
#endif
 
338
      save_choicepoint(tbreg,ereg,(byte *)&trie_fail_unlock_inst,breg);
 
339
#ifdef SLG_GC
 
340
      cp_prevtop(tbreg) = old_cptop;
 
341
#endif
 
342
      breg = tbreg;
 
343
      hbreg = hreg;
 
344
#endif
 
345
      XSB_Next_Instr();
 
346
    }
 
347
    else {
 
348
      Fail1;
 
349
      XSB_Next_Instr();
 
350
    }
 
351
  }
 
352
 
 
353
  else if ( CallLUR_VariantFound(lookupResults) )
 
354
 
 
355
    /* Previously Seen Subsumed Call
 
356
       ----------------------------- */
 
357
    consumer_sf = CallTrieLeaf_GetSF(CallLUR_Leaf(lookupResults));
 
358
 
 
359
  else
 
360
 
 
361
    /* New Properly Subsumed Call
 
362
       -------------------------- */
 
363
    NewSubConsSF( consumer_sf, CallLUR_Leaf(lookupResults),
 
364
                   CallInfo_TableInfo(callInfo), producer_sf );
 
365
 
 
366
  /*
 
367
   * The call, represented by "consumer_sf", will consume from an
 
368
   * incomplete producer, represented by "producer_sf".
 
369
   */
 
370
  {
 
371
    CPtr consumer_cpf;
 
372
#ifdef SLG_GC
 
373
    CPtr prev_cptop;
 
374
#endif
 
375
    ALNptr answer_continuation;
 
376
    BTNptr first_answer;
 
377
 
 
378
    /* Create Consumer Choice Point
 
379
       ---------------------------- */
 
380
#ifdef CONC_COMPL
 
381
    CPtr producer_cpf ;
 
382
 
 
383
    if( subg_tid(producer_sf) == th->tid )
 
384
    {
 
385
#endif
 
386
    adjust_level(subg_compl_stack_ptr(producer_sf));
 
387
#ifdef CONC_COMPL
 
388
    consumer_cpf = answer_template;
 
389
    }
 
390
    else
 
391
    {
 
392
        producer_cpf = answer_template;
 
393
        SaveProducerCPF(producer_cpf, (pb)&check_complete_inst, producer_sf,
 
394
                        CallInfo_CallArity(callInfo), (hreg - 1));
 
395
        consumer_cpf = breg = producer_cpf;
 
396
    }
 
397
#endif
 
398
    save_find_locx(ereg);
 
399
 
 
400
#ifndef CONC_COMPL
 
401
    consumer_cpf = answer_template;
 
402
#endif
 
403
#ifdef SLG_GC
 
404
    prev_cptop = consumer_cpf;
 
405
#endif
 
406
 
 
407
    answer_template = hreg-1;
 
408
 
 
409
    efreg = ebreg;
 
410
    if (trreg > trfreg) trfreg = trreg;
 
411
    if (hfreg < hreg) hfreg = hreg;
 
412
    SaveConsumerCPF( consumer_cpf, consumer_sf,
 
413
                     subg_asf_list_ptr(producer_sf), 
 
414
                     answer_template);
 
415
#ifdef SLG_GC
 
416
    nlcp_prevtop(consumer_cpf) = prev_cptop;
 
417
#endif
 
418
    subg_asf_list_ptr(producer_sf) = breg = bfreg = consumer_cpf;
 
419
 
 
420
    xsb_dbgmsg((LOG_COMPLETION,"created ccp at %x with prevbreg as %x\n",
 
421
                breg,nlcp_prevbreg(breg)));
 
422
 
 
423
#ifdef CONC_COMPL
 
424
    nlcp_tid(consumer_cpf) = makeint(th->tid);
 
425
 
 
426
    if( subg_tid(producer_sf) != th->tid )
 
427
    {
 
428
        push_completion_frame(producer_sf);
 
429
        compl_ext_cons(openreg) = consumer_cpf;
 
430
        tcp_compl_stack_ptr(producer_cpf) = openreg ;
 
431
    }
 
432
#endif
 
433
 
 
434
    /* Consume First Answer or Suspend
 
435
       ------------------------------- */
 
436
    table_pending_answer( subg_ans_list_ptr(consumer_sf),
 
437
                          answer_continuation,
 
438
                          first_answer,
 
439
                          (SubConsSF)consumer_sf,
 
440
                          (SubProdSF)producer_sf,
 
441
                          answer_template,
 
442
                          TPA_NoOp,
 
443
                          TPA_NoOp );
 
444
 
 
445
    if ( IsNonNULL(answer_continuation) ) {
 
446
      int tmp;
 
447
      nlcp_trie_return(consumer_cpf) = answer_continuation; 
 
448
      hbreg = hreg;
 
449
 
 
450
      tmp = int_val(cell(answer_template));
 
451
      get_var_and_attv_nums(template_size, attv_num, tmp);
 
452
      answer_template--;
 
453
 
 
454
      table_consume_answer(CTXTc first_answer,template_size,attv_num,answer_template,
 
455
                           CallInfo_TableInfo(callInfo));
 
456
 
 
457
      if (is_conditional_answer(first_answer)) {
 
458
        xsb_dbgmsg((LOG_DELAY,
 
459
                "! POSITIVELY DELAYING in lay active (delayreg = %p)\n",
 
460
                delayreg));
 
461
        xsb_dbgmsg((LOG_DELAY, "\n>>>> delay_positively in lay_down_active\n"));
 
462
        xsb_dbgmsg((LOG_DELAY, ">>>> subgoal = "));
 
463
        dbg_print_subgoal(LOG_DELAY, stddbg, producer_sf);
 
464
        xsb_dbgmsg((LOG_DELAY, "\n"));
 
465
        {
 
466
          /*
 
467
           * Similar to delay_positively() in retry_active, we also
 
468
           * need to put the substitution factor of the answer,
 
469
           * var_addr[], into a term ret/n and pass it to
 
470
           * delay_positively().
 
471
           */
 
472
          if (num_heap_term_vars == 0) {
 
473
            delay_positively(producer_sf, first_answer,
 
474
                             makestring(get_ret_string()));
 
475
          }
 
476
          else {
 
477
#ifndef IGNORE_DELAYVAR
 
478
            int i;
 
479
            CPtr temp_hreg = hreg;
 
480
            new_heap_functor(hreg, get_ret_psc(num_heap_term_vars));
 
481
            if (var_addr == NULL) printf("var_addr NULL 3\n");
 
482
            for (i = 0; i < num_heap_term_vars; i++)
 
483
              cell(hreg++) = (Cell) var_addr[i];
 
484
            delay_positively(producer_sf, first_answer, makecs(temp_hreg));
 
485
#else
 
486
            delay_positively(producer_sf, first_answer,
 
487
                             makestring(get_ret_string()));
 
488
#endif /* IGNORE_DELAYVAR */
 
489
          }
 
490
        }
 
491
      }
 
492
      lpcreg = cpreg;
 
493
    }
 
494
    else {
 
495
      breg = nlcp_prevbreg(consumer_cpf);
 
496
      Fail1;
 
497
    }
 
498
#ifdef CONC_COMPL
 
499
    pthread_mutex_unlock(&completing_mut);
 
500
#endif
 
501
  }
 
502
XSB_End_Instr()
 
503
 
 
504
/*-------------------------------------------------------------------------*/
 
505
 
 
506
/*
 
507
 *  Instruction format:
 
508
 *    1st word: opcode X X X
 
509
 *
 
510
 *  Description:
 
511
 *    Returns to a consumer an answer if one is available, otherwise it
 
512
 *    suspends.  Answer consumption is effected by unifying the consumer's
 
513
 *    answer template with an answer.  This instruction is encountered only
 
514
 *    by backtracking into a consumer choice point frame, either as a
 
515
 *    result of WAM- style backtracking or having been resumed via a
 
516
 *    check-complete instruction.  The CPF field "nlcp-trie-return" points
 
517
 *    to the last answer consumed.  If none have yet been consumed, then it
 
518
 *    points to the dummy answer.
 
519
 */
 
520
 
 
521
XSB_Start_Instr(answer_return,_answer_return) 
 
522
  VariantSF consumer_sf;
 
523
  ALNptr answer_continuation;
 
524
  BTNptr next_answer;
 
525
  CPtr answer_template;
 
526
  int template_size, attv_num;
 
527
 
 
528
 
 
529
  xsb_dbgmsg((LOG_DEBUG,"Starting answer return %x (%x) (prev %x)\n",
 
530
              breg,*lpcreg,nlcp_prevbreg(breg))); 
 
531
 
 
532
  /* Locate relevant answers
 
533
     ----------------------- */
 
534
  answer_continuation = ALN_Next(nlcp_trie_return(breg)); /* step to next answer */
 
535
  consumer_sf = (VariantSF)nlcp_subgoal_ptr(breg);
 
536
  answer_template = nlcp_template(breg);
 
537
#ifdef CONC_COMPL
 
538
  pthread_mutex_lock(&completing_mut);
 
539
#endif
 
540
  table_pending_answer( nlcp_trie_return(breg),
 
541
                        answer_continuation,
 
542
                        next_answer,
 
543
                        (SubConsSF)consumer_sf,
 
544
                        conssf_producer(consumer_sf),
 
545
                        answer_template,
 
546
                        switch_envs(breg),
 
547
                        TPA_NoOp );
 
548
 
 
549
  if ( IsNonNULL(answer_continuation)) {
 
550
    int tmp;
 
551
 
 
552
    /* Restore Consumer's state
 
553
       ------------------------ */
 
554
    switch_envs(breg);
 
555
    ptcpreg = nlcp_ptcp(breg);
 
556
    delayreg = nlcp_pdreg(breg);
 
557
    restore_some_wamregs(breg, ereg);
 
558
 
 
559
    /* Consume the next answer
 
560
       ----------------------- */
 
561
    nlcp_trie_return(breg) = answer_continuation;   /* update */
 
562
    tmp = int_val(cell(answer_template));
 
563
    get_var_and_attv_nums(template_size, attv_num, tmp);
 
564
    answer_template--;
 
565
 
 
566
    //    printf("answer_template %x size %d\n",answer_template,template_size);
 
567
    //    sfPrintGoal(CTXTdeclc stddbg, consumer_sf, FALSE);
 
568
 
 
569
    table_consume_answer(CTXTc next_answer,template_size,attv_num,answer_template,
 
570
                         subg_tif_ptr(consumer_sf));
 
571
 
 
572
    if (is_conditional_answer(next_answer)) {
 
573
      /*
 
574
       * After load_solution_trie(), the substitution factor of the
 
575
       * answer is left in array var_addr[], and its arity is in
 
576
       * num_heap_term_vars.  We have to put it into a term ret/n (on 
 
577
       * the heap) and pass it to delay_positively().
 
578
       */
 
579
      if (num_heap_term_vars == 0) {
 
580
        delay_positively(consumer_sf, next_answer,
 
581
                         makestring(get_ret_string()));
 
582
      }
 
583
      else {
 
584
#ifndef IGNORE_DELAYVAR
 
585
        int i;
 
586
        CPtr temp_hreg = hreg;
 
587
        new_heap_functor(hreg, get_ret_psc(num_heap_term_vars));
 
588
        if (var_addr == NULL) printf("var_addr NULL 4\n");
 
589
        for (i = 0; i < num_heap_term_vars; i++) {
 
590
          cell(hreg++) = (Cell) var_addr[i];
 
591
        }
 
592
        delay_positively(consumer_sf, next_answer, makecs(temp_hreg));
 
593
#else
 
594
        delay_positively(consumer_sf, next_answer,
 
595
                         makestring(get_ret_string()));
 
596
#endif /* IGNORE_DELAYVAR */
 
597
      }
 
598
    }
 
599
    lpcreg = cpreg;
 
600
  }
 
601
 
 
602
  else {
 
603
 
 
604
    /* Suspend this Consumer
 
605
       --------------------- */
 
606
    xsb_dbgmsg((LOG_DEBUG,"Failing from answer return %x to %x (inst %x)\n",
 
607
                breg,nlcp_prevbreg(breg),*tcp_pcreg(nlcp_prevbreg(breg))));
 
608
    breg = nlcp_prevbreg(breg); /* in semi-naive this execs next active */
 
609
    restore_trail_condition_registers(breg);
 
610
    if (hbreg >= hfreg) hreg = hbreg; else hreg = hfreg;
 
611
    Fail1;
 
612
  }
 
613
#ifdef CONC_COMPL
 
614
  pthread_mutex_unlock(&completing_mut);
 
615
#endif
 
616
XSB_End_Instr()
 
617
 
 
618
/*-------------------------------------------------------------------------*/
 
619
 
 
620
/*
 
621
 *  Instruction format:
 
622
 *    1st word: opcode X pred_arity perm_var_index
 
623
 *
 
624
 *  Description:
 
625
 *    Last instruction in each clause of a tabled predicate.  The instruction
 
626
 *    (1) saves the answer substitution in the answer trie and (2)
 
627
 *    adds a cell to the end of the answer list pointing to the root
 
628
 *    of the new subtstitution. All the
 
629
 *    information necessary to perform this Answer Check/Insert operation
 
630
 *    is saved in the producer's choice point frame.  This CP is 
 
631
 *    reached through the subgoal frame, which is noted in the first
 
632
 *    environment variable of the tabled clause.
 
633
 * 
 
634
 *    In the case where we have added an unconditional ground answer
 
635
 *    we perform early completion for the subgoal.
 
636
 *
 
637
 *    Next, if we are executing Local Evaluation, we fail after adding
 
638
 *    the answer (and perhaps performing ec)  This is not always the
 
639
 *    optimal way, as we need fail only if the subgoal is potentially
 
640
 *    a leader.
 
641
 * 
 
642
 *    If we are not executing local evaluation, we take the forward
 
643
 *    condinuation (i.e. we'll proceed).  In his case a delay element
 
644
 *    must be added to the delay list or the root subgoal of the
 
645
 *    current subgoal before proceeding.
 
646
 */
 
647
 
 
648
XSB_Start_Instr(new_answer_dealloc,_new_answer_dealloc) 
 
649
  Def2ops
 
650
  CPtr producer_cpf, producer_csf, answer_template;
 
651
  int template_size, attv_num, tmp;
 
652
  VariantSF producer_sf;
 
653
  xsbBool isNewAnswer = FALSE;
 
654
  BTNptr answer_leaf;
 
655
 
 
656
  ARITY = get_xax;
 
657
  Yn = get_xxa; /* we want the # of the register, not a pointer to it */
 
658
 
 
659
  ADVANCE_PC(size_xxx);
 
660
 
 
661
  xsb_dbgmsg((LOG_COMPLETION,"starting new_answer breg %x\n",breg));
 
662
  producer_sf = (VariantSF)cell(ereg-Yn);
 
663
  producer_cpf = subg_cp_ptr(producer_sf);
 
664
 
 
665
#ifdef DEBUG_DELAYVAR
 
666
  xsb_dbgmsg((LOG_DEBUG,">>>> New answer for %s subgoal: ",
 
667
             (is_completed(producer_sf) ? "completed" : "incomplete")));
 
668
  fprintf(stddbg, ">>>> ");
 
669
  dbg_print_subgoal(LOG_DEBUG, stddbg, producer_sf);
 
670
  xsb_dbgmsg((LOG_DEBUG,">>>> has delayreg = %p", delayreg));
 
671
#endif
 
672
 
 
673
  producer_csf = subg_compl_stack_ptr(producer_sf);
 
674
 
 
675
  /* if the subgoal has been early completed and its space reclaimed
 
676
   * from the stacks, access to its relevant information (e.g. to its
 
677
   * substitution factor) in the stacks is not safe, so better not
 
678
   * try to add this answer; it is a redundant one anyway...
 
679
   */
 
680
  if ((subgoal_space_has_been_reclaimed(producer_sf,producer_csf)) ||
 
681
      (IsNonNULL(delayreg) && answer_is_junk(delayreg))) {
 
682
    Fail1;
 
683
    XSB_Next_Instr();
 
684
  }
 
685
 
 
686
  /* answer template is now in the heap for generators */
 
687
  answer_template = tcp_template(subg_cp_ptr(producer_sf));
 
688
  tmp = int_val(cell(answer_template));
 
689
  get_var_and_attv_nums(template_size, attv_num, tmp);
 
690
  answer_template--;
 
691
 
 
692
#ifdef DEBUG_DELAYVAR
 
693
  xsb_dbgmsg(LOG_DEBUG,">>>> ARITY = %d; Yn = %d", (int)ARITY, (int)Yn);
 
694
#endif
 
695
 
 
696
  xsb_dbgmsg((LOG_DELAY, "\t--> This answer for "));
 
697
  dbg_print_subgoal(LOG_DELAY, stddbg, producer_sf);
 
698
#ifdef DEBUG_VERBOSE
 
699
  if (LOG_DELAY <= cur_log_level) {
 
700
    if (delayreg != NULL) {
 
701
      fprintf(stddbg, " has delay list = ");
 
702
      print_delay_list(stddbg, delayreg);
 
703
    } else {
 
704
      fprintf(stddbg, " has no delay list\n");
 
705
    }
 
706
  }
 
707
#endif
 
708
 
 
709
#ifdef DEBUG_DELAYVAR
 
710
  fprintf(stddbg, "\n>>>> (before variant_answer_search) template_size = %d\n",
 
711
          (int)template_size);
 
712
  {
 
713
    int i;
 
714
    for (i = 0; i < template_size; i++) {
 
715
      fprintf(stddbg, ">>>> answer_template[%d] = ", i);
 
716
      printterm(stddbg, (Cell)(answer_template - i), 25);
 
717
      fprintf(stddbg, "\n");
 
718
    }
 
719
  }
 
720
#endif
 
721
 
 
722
  SET_TRIE_ALLOCATION_TYPE_SF(producer_sf); /* No-op in seq engine */
 
723
  answer_leaf = table_answer_search( CTXTc producer_sf, template_size, attv_num,
 
724
                                     answer_template, &isNewAnswer );
 
725
 
 
726
  if ( isNewAnswer ) {   /* go ahead -- look for more answers */
 
727
    delayreg = tcp_pdreg(producer_cpf);      /* restore delayreg of parent */
 
728
    if (is_conditional_answer(answer_leaf)) {   /* positive delay */
 
729
#ifndef LOCAL_EVAL
 
730
#ifdef DEBUG_DELAYVAR
 
731
      fprintf(stddbg, ">>>> delay_positively in new_answer_dealloc\n");
 
732
#endif
 
733
      /*
 
734
       * The new answer for this call is a conditional one, so add it
 
735
       * into the delay list for its root subgoal.  Notice that
 
736
       * delayreg has already been restored to the delayreg of parent.
 
737
       *
 
738
       * This is the new version of delay_positively().  Here,
 
739
       * ans_var_pos_reg is passed from variant_answer_search().  It is a
 
740
       * pointer to the heap where the substitution factor of the
 
741
       * answer was saved as a term ret/n (in variant_answer_search()).
 
742
       */
 
743
#ifndef IGNORE_DELAYVAR
 
744
      if (isinteger(cell(ans_var_pos_reg))) {
 
745
        delay_positively(producer_sf, answer_leaf,
 
746
                         makestring(get_ret_string()));
 
747
      }
 
748
      else 
 
749
        delay_positively(producer_sf, answer_leaf, makecs(ans_var_pos_reg));
 
750
#else
 
751
        delay_positively(producer_sf, answer_leaf,
 
752
                         makestring(get_ret_string()));
 
753
#endif /* IGNORE_DELAYVAR */
 
754
#endif /* ! LOCAL_EVAL */
 
755
    }
 
756
    else {
 
757
      if (template_size == 0) {
 
758
        /*
 
759
         *  The table is for a ground call which we just proved true.
 
760
         *  (We entered an ESCAPE Node, above, to note this fact in the
 
761
         *  table.)  As we only need to do this once, we perform "early
 
762
         *  completion" by ignoring the other clauses of the predicate
 
763
         *  and setting the failure continuation (next_clause) field of
 
764
         *  the CPF to a check_complete instr.
 
765
         *
 
766
         */
 
767
        perform_early_completion(producer_sf, producer_cpf);
 
768
#if defined(LOCAL_EVAL)
 
769
          breg = producer_cpf;
 
770
#endif
 
771
      }
 
772
    }
 
773
#ifdef LOCAL_EVAL
 
774
    Fail1;      /* and do not return answer to the generator */
 
775
    xsb_dbgmsg((LOG_DEBUG,"Failing from new answer %x to %x (inst %x)\n",
 
776
                breg,tcp_pcreg(breg),*tcp_pcreg(breg)));
 
777
 
 
778
#else
 
779
    ptcpreg = tcp_ptcp(producer_cpf);
 
780
    cpreg = *((byte **)ereg-1);
 
781
    ereg = *(CPtr *)ereg;
 
782
    lpcreg = cpreg; 
 
783
#endif
 
784
  }
 
785
  else     /* repeat answer -- ignore */
 
786
     Fail1;
 
787
XSB_End_Instr()
 
788
 
 
789
/*-------------------------------------------------------------------------*/
 
790
 
 
791
/*
 
792
 *  Instruction format:
 
793
 *    1st word: opcode X X pred_arity
 
794
 *    2nd word: pred_next_clause_label
 
795
 *
 
796
 *  Description:
 
797
 *    Store the predicate's arity in "op1", update the failure continuation
 
798
 *    to the instruction following this one, and set the program counter to
 
799
 *    the predicate's next code subblock to be executed, as pointed to by
 
800
 *    the second argument to this instruction.  Finally, restore the state
 
801
 *    at the point of choice and continue execution using the predicate's
 
802
 *    next code subblock.
 
803
 */
 
804
 
 
805
XSB_Start_Instr(tableretry,_tableretry)
 
806
  Def1op
 
807
  Op1(get_xxa);
 
808
  tcp_pcreg(breg) = lpcreg+sizeof(Cell)*2;
 
809
  lpcreg = *(pb *)(lpcreg+sizeof(Cell));
 
810
  restore_type = 0;
 
811
  TABLE_RESTORE_SUB
 
812
XSB_End_Instr()
 
813
 
 
814
/*-------------------------------------------------------------------------*/
 
815
 
 
816
/*
 
817
 *  Instruction format:
 
818
 *    1st word: opcode X X pred_arity
 
819
 *
 
820
 *  Description:
 
821
 *    Store the predicate's arity in "op1", update the failure continuation
 
822
 *    to a check_complete instruction, and set the program counter to the
 
823
 *    predicate's last code subblock to be executed, as pointed to by the
 
824
 *    second argument to this instruction.  Finally, restore the state at
 
825
 *    the point of choice and continue execution with this last code
 
826
 *    subblock.
 
827
 */
 
828
 
 
829
XSB_Start_Instr(tabletrust,_tabletrust)
 
830
  Def1op
 
831
  Op1(get_xxa);
 
832
  ADVANCE_PC(size_xxx);
 
833
  tcp_pcreg(breg) = (byte *) &check_complete_inst;
 
834
  lpcreg = *(pb *)lpcreg;
 
835
#if defined(LOCAL_EVAL)
 
836
  /* trail cond. registers should not be restored here for Local */
 
837
  restore_type = 0;
 
838
#else
 
839
  restore_type = 1;
 
840
#endif
 
841
  TABLE_RESTORE_SUB
 
842
XSB_End_Instr()
 
843
/*-------------------------------------------------------------------------*/
 
844
 
 
845
#include "complete_xsb_i.h"
 
846
 
 
847
/*-------------------------------------------------------------------------*/
 
848
 
 
849
XSB_Start_Instr(resume_compl_suspension,_resume_compl_suspension)
 
850
#ifdef DEBUG_DELAYVAR
 
851
      fprintf(stddbg, ">>>> resume_compl_suspension is called\n");
 
852
#endif
 
853
{
 
854
  if ((unsigned long) csf_pcreg(breg) == 
 
855
      (unsigned long) &resume_compl_suspension_inst) {
 
856
    CPtr csf = breg;
 
857
    
 
858
    /* Switches the environment to a frame of a subgoal that was        */
 
859
    /* suspended on completion, and sets the continuation pointer.      */
 
860
    check_glstack_overflow(0,lpcreg,OVERFLOW_MARGIN);
 
861
    freeze_and_switch_envs(csf, COMPL_SUSP_CP_SIZE);
 
862
    ptcpreg = csf_ptcp(csf);
 
863
    neg_delay = (csf_neg_loop(csf) != FALSE);
 
864
    delayreg = csf_pdreg(csf);
 
865
    cpreg = csf_cpreg(csf); 
 
866
    ereg = csf_ereg(csf);
 
867
    ebreg = csf_ebreg(csf);
 
868
    hbreg = csf_hreg(csf);
 
869
    save_find_locx(ereg);
 
870
    hbreg = hreg;
 
871
    breg = csf_prevcsf(csf);
 
872
    lpcreg = cpreg;
 
873
  } else {
 
874
    CPtr csf = cs_compsuspptr(breg);
 
875
    /* Switches the environment to a frame of a subgoal that was        */
 
876
    /* suspended on completion, and sets the continuation pointer.      */
 
877
    check_glstack_overflow(0,lpcreg,OVERFLOW_MARGIN);
 
878
    freeze_and_switch_envs(csf, COMPL_SUSP_CP_SIZE);
 
879
    ptcpreg = csf_ptcp(csf);
 
880
    neg_delay = (csf_neg_loop(csf) != FALSE);
 
881
    delayreg = csf_pdreg(csf);
 
882
    cpreg = csf_cpreg(csf); 
 
883
    ereg = csf_ereg(csf);
 
884
    ebreg = csf_ebreg(csf);
 
885
    hbreg = csf_hreg(csf);
 
886
    save_find_locx(ereg);
 
887
    hbreg = hreg;
 
888
    if (csf_prevcsf(csf) != NULL) {
 
889
      cs_compsuspptr(breg) = csf_prevcsf(csf);
 
890
    } else {
 
891
      breg = cs_prevbreg(breg);
 
892
    }
 
893
    lpcreg = cpreg;
 
894
  }
 
895
}
 
896
XSB_End_Instr()
 
897
 
 
898
/*----------------------------------------------------------------------*/
 
899