1 /*************************************************************************
2 * *
3 * BEAM -> Basic Extended Andorra Model *
4 * BEAM extends the YAP Prolog system to support the EAM *
5 * *
6 * Copyright: Ricardo Lopes and NCC - University of Porto, Portugal *
7 * *
8 **************************************************************************
9 * comments: eam code compiler *
10 *************************************************************************/
11
12 #ifdef BEAM
13
14 #include "eam.h"
15 #include "eamamasm.h"
16 #include <stdio.h>
17 #include <stdlib.h>
18 #include <string.h>
19
20 extern int skip_while_var(void);
21 extern int wait_while_var(void);
22 extern int force_wait(void);
23 extern int p_write(void);
24 extern int p_is(void);
25 extern int p_halt(void);
26 extern int p_halt0(void);
27 extern int commit(void);
28 extern int eager_split(void);
29
30 extern void eam_showcode(Cell *);
31 extern Cell *eam_assemble(CInstr *);
32 extern void ShowCode_new2(int, int, CELL);
33 extern Cell *gera_codigo_try(int);
34 extern Cell *gera_codigo_try_list(int);
35 extern Cell *gera_codigo_try_only_vars(int);
36 extern struct HASH_TABLE **gera_codigo_try_atom(int);
37 extern struct HASH_TABLE **gera_codigo_try_functor(int);
38
39 /* Novas Definicoes */
40 compiler_struct *CGLOBS;
41 int labelno;
42 extern int nperm;
43 CInstr *inter_code,*StartCode;
44
45 void convert_Yaam(struct Clauses *);
46 void anota_predicados(struct Clauses *, PredEntry *,unsigned long ,int ,int ,int);
47 void verifica_predicados(struct Clauses *);
48 void ShowCode_new(int);
49 void codigo_eam(compiler_struct *);
50 void ver_predicados(void);
51 void eam_instructions(struct Clauses *);
52 void identify_calls(CInstr *);
53 int needs_box(Cell);
54 int is_skip(Cell);
55 void delay_prepare_calls(void);
56 int test_for_side_effects(void);
57 CInstr *insert_inst(CInstr *, int,int,CELL);
58 CInstr *emit_new(int, int, CELL);
59 CInstr *new_inst(int, int, CELL);
60 void *alloc_mem_temp(Cell);
61 void *alloc_mem(Cell);
62
63 /***********************************************************************\
64 * Aqui estao as novas partes do compilador *
65 \***********************************************************************/
66
anota_predicados(struct Clauses * clause,PredEntry * p,unsigned long a,int b,int info_type,int call)67 void anota_predicados(struct Clauses *clause, PredEntry *p, unsigned long a,int b,int info_type,int call)
68 {
69 struct Predicates *predi;
70
71 if (p->beamTable==NULL) { /*1 vez que aparece, inicializar uma nova estrutura */
72 predi=(struct Predicates *) alloc_mem(sizeof(struct Predicates));
73 p->beamTable=predi;
74
75 predi->id=a;
76 predi->name=(char *) RepAtom(AtomOfTerm(MkAtomTerm((Atom) a)))->StrOfAE;
77 predi->arity=b;
78 predi->nr_alt=0;
79 predi->calls=0;
80 predi->idx_var=0;
81 predi->idx_list=0;
82 predi->idx_atom=0;
83 predi->idx_functor=0;
84 predi->first=NULL;
85 predi->last=NULL;
86
87 } else predi=p->beamTable;
88
89 if (!call) { /* se nao foi chamado por um call, entao anota informacao */
90 predi->id=a;
91 predi->nr_alt++;
92 if (info_type & Variavel ) predi->idx_var++; /* info_type=Lista+Estrutura+Constante; */
93 if (info_type & Lista ) predi->idx_list++;
94 if (info_type & Estrutura) predi->idx_functor++;
95 if (info_type & Constante) predi->idx_atom++;
96 if (predi->last==NULL) {
97 predi->first=clause;
98 predi->last=clause;
99 clause->next=NULL;
100 } else {
101 predi->last->next=clause;
102 predi->last=clause;
103 clause->next=NULL;
104 }
105
106 }
107
108 return;
109 }
110
identify_calls(CInstr * code)111 void identify_calls(CInstr *code) {
112 PredEntry *p = RepPredProp((Prop) code->new4);
113 Functor f = p->FunctorOfPred;
114 int arity=p->ArityOfPE;
115 char *name;
116
117 if ( arity == 0) name=((AtomEntry *) f)->StrOfAE;
118 else name=((AtomEntry *) NameOfFunctor(f))->StrOfAE;
119
120 /*
121 if (code->op==call_op) printf("call: ");
122 else if (code->op==safe_call_op) printf("call: ");
123 else if (code->op==execute_op) printf("execute: ");
124 printf("->%s/%d...............\n",name,arity);
125 */
126
127 if (arity==0) {
128 if (strcmp(name,"/")==0) { code->op=commit_op; return; }
129 if (strcmp(name,":")==0) { code->op=force_wait_op; return; }
130 if (strcmp(name,"nl")==0) { code->op=write_op; code->new1='\n'; return; }
131 if (strcmp(name,"halt")==0) { code->op=exit_op; return; }
132
133 } else if (arity==1) {
134 if (strcmp(name,"wait_while_var")==0) { code->op=wait_while_var_op; return; }
135 if (strcmp(name,"skip_while_var")==0) { code->op=skip_while_var_op; return; }
136 if (strcmp(name,"write")==0) { code->op=write_op; return; }
137
138 } else if (arity==2) {
139 if (strcmp(name,"is")==0) { code->op=is_op; return; }
140 }
141
142 /* n�o � nenhum call conhecido, deve ser um predicado em Prolog */
143
144 return;
145 }
146
147 /* no verifica_predicados, vou transformar os calls para */
verifica_predicados(struct Clauses * clause)148 void verifica_predicados(struct Clauses *clause)
149 {
150 CELL Flags;
151
152 inter_code=StartCode;
153 anota_predicados(clause,(CGLOBS->cint).CurrentPred, StartCode->new4,StartCode->new1,clause->idx,0);
154
155 while(inter_code!=NULL) {
156 if (inter_code->op==safe_call_op) { /* new1 deve continuar igual */
157 Flags = RepPredProp((Prop) (inter_code->new4))->PredFlags;
158 if (Flags & AsmPredFlag) {
159 inter_code->op=std_base_op;
160 inter_code->new4=(Flags &0x7f);
161 } else {
162 PredEntry *p=RepPredProp((Prop) inter_code->new4);
163 inter_code->op=safe_call_op;
164 inter_code->new4= (unsigned long) p->cs.f_code;
165 if (Flags & BinaryPredFlag) inter_code->new1=2;
166 else inter_code->new1=0;
167 }
168 }
169 else if (inter_code->op==call_op || inter_code->op==execute_op) {
170 PredEntry *p = RepPredProp((Prop) inter_code->new4);
171 Flags = p->PredFlags;
172 Functor f = p->FunctorOfPred;
173
174 if (Flags & AsmPredFlag) {
175 int op;
176 switch (Flags & 0x7f) {
177 case _equal:
178 op = _p_equal;
179 break;
180 case _dif:
181 op = _p_dif;
182 break;
183 case _eq:
184 op = _p_eq;
185 break;
186 case _arg:
187 op = _p_arg;
188 break;
189 case _functor:
190 op = _p_functor;
191 break;
192 default:
193 printf("Internal eam assembler error for built-in %d\n",((int) (Flags & 0x7f)));
194 exit(1);
195 }
196 }
197
198 if (!(Flags & CPredFlag)) {
199 if (p->ArityOfPE == 0) f = Yap_MkFunctor((Atom) f, 0);
200 inter_code->new4=(unsigned long) p;
201 anota_predicados(clause, p, (unsigned long) NameOfFunctor(f),ArityOfFunctor(f),0,1);
202 p->beamTable->calls++;
203
204 } else {/* safe_call */
205 inter_code->op=safe_call_op;
206 inter_code->new4= (unsigned long) p->cs.f_code;
207 if (Flags & BinaryPredFlag) inter_code->new1=2;
208 else inter_code->new1=0;
209 }
210 }
211 inter_code=inter_code->nextInst;
212 }
213
214 return;
215 }
216
217
ShowCode_new(int i)218 void ShowCode_new(int i)
219 {
220 /*
221 struct intermediates c;
222 c.CodeStart=StartCode;
223
224 Yap_ShowCode(&c);
225 return;
226 */
227 #ifdef DEBUG
228
229 switch(i) {
230 case 1: printf("\nVer Predicados \n");
231 break;
232 case 2: printf("\nVer yaam Original\n");
233 break;
234 case 4: printf("\nVer abs machine code\n");
235 break;
236 case 8: printf("\nVer o codigo dos trys\n");
237 break;
238 case 16: printf("\nVer o codigo yaam ja transformado\n");
239 break;
240 case 32: printf("\nver codigo EAM com direct calls\n");
241 break;
242 case 128: printf("\nVer codigo EAM final\n");
243 break;
244 }
245
246 inter_code = StartCode;
247 while (inter_code) {
248 ShowCode_new2(inter_code->op, inter_code->new1,inter_code->new4);
249 inter_code = inter_code->nextInst;
250 }
251 printf("\n");
252 #endif
253 }
254
255
codigo_eam(compiler_struct * cglobs)256 void codigo_eam(compiler_struct *cglobs)
257 {
258 struct Clauses *clause;
259
260 CGLOBS=cglobs;
261 labelno=cglobs->labelno;
262
263 #ifdef DEBUG
264 if (Print_Code & 2 ) Yap_ShowCode(&CGLOBS->cint);
265 #endif
266 clause=(struct Clauses *) alloc_mem(sizeof(struct Clauses));
267 convert_Yaam(clause); /* convert into an internal struct code and check IDX */
268 verifica_predicados(clause); /* check predicates and convert calls */
269
270 clause->predi=(CGLOBS->cint).CurrentPred->beamTable;
271 (CGLOBS->cint).CurrentPred->beamTable->idx=0; /* will need to go by indexing */
272
273 if (Print_Code & 4) ShowCode_new(2); /* codigo YAAM */
274
275 /* transf os safe_calls em instrucoes eam e verifica se existem side_effects */
276 clause->side_effects=test_for_side_effects();
277
278 eam_instructions(clause);
279 if (Print_Code & 16) ShowCode_new(16); /* codigo EAM */
280 inter_code=NULL;
281 delay_prepare_calls(); /* transforma alguns safe_calls em direct_calls */
282
283 if (Print_Code & 32) ShowCode_new(32); /* codigo com direct_callss */
284 clause->code=eam_assemble(StartCode);
285 clause->nr_vars=nperm;
286
287 if (Print_Code & 128) eam_showcode((Cell *)clause->code);
288
289 }
290
291
292
293
294 /********************************************************\
295 * Convert Code *
296 \********************************************************/
297
298
is_skip(Cell op)299 int is_skip(Cell op)
300 {
301 if (op==skip_while_var_op) return(1);
302 if (op==wait_while_var_op) return(1);
303
304 return(0);
305 }
306
eam_instructions(struct Clauses * clause)307 void eam_instructions(struct Clauses *clause)
308 {
309 int calls=0,nrcall=0;
310 CInstr *b_code=NULL;
311
312 inter_code=StartCode;
313 while(inter_code!=NULL){
314 if (inter_code->op==body_op) calls=0;
315 if (inter_code->op==procceed_op) inter_code->nextInst=NULL; /* CUIDADO */
316 if (inter_code->op==allocate_op) inter_code->op=nop_op;
317 if (inter_code->op==deallocate_op) inter_code->op=nop_op;
318 if (inter_code->op==cutexit_op) {
319 inter_code->op=cut_op;
320 insert_inst(inter_code,procceed_op,0,0);
321 }
322 if (inter_code->op==fail_op) insert_inst(inter_code,procceed_op,0,0);
323
324 if (inter_code->op==execute_op) {
325 inter_code->op=call_op;
326 insert_inst(inter_code,procceed_op,0,0);
327 }
328 if (inter_code->op==safe_call_op) {
329 if ((void *)inter_code->new4==(void *) eager_split) {
330 inter_code->op=nop_op;
331 clause->predi->eager_split=1;
332 }
333 }
334 if (needs_box(inter_code->op)) calls++;
335
336 inter_code=inter_code->nextInst;
337 }
338
339 if (calls) {
340 inter_code=StartCode;
341 while(inter_code!=NULL){
342 if (inter_code->op==body_op) {
343 inter_code->new4=calls;
344 insert_inst(inter_code,create_first_box_op,calls,++labelno);
345 inter_code=inter_code->nextInst;
346 }
347 if (needs_box(inter_code->op)) {
348 insert_inst(inter_code,remove_box_op,nrcall,0);
349 inter_code=inter_code->nextInst;
350 b_code=inter_code;
351 insert_inst(inter_code,label_op,nrcall,labelno);
352 inter_code=inter_code->nextInst;
353 insert_inst(inter_code,create_box_op,++nrcall,++labelno);
354 }
355 inter_code=inter_code->nextInst;
356 }
357
358 b_code->op=remove_last_box_op;
359 b_code->nextInst->nextInst->op=nop_op;
360 }
361
362 }
363
delay_prepare_calls(void)364 void delay_prepare_calls(void) {
365 CInstr *b_code=NULL;
366
367 inter_code=StartCode;
368 while(inter_code!=NULL){
369 if (inter_code->op==body_op) b_code=inter_code;
370 if (inter_code->op!=safe_call_op && inter_code->op!=cut_op && (needs_box(inter_code->op) || is_skip(inter_code->op))) break;
371
372 if (inter_code->op==safe_call_op) {
373 inter_code->op=direct_safe_call_op;
374
375 b_code->nextInst->op=nop_op;
376 inter_code->nextInst->op=nop_op;
377 if (b_code->new4>1) {
378 inter_code->nextInst->nextInst->op=body_op;
379 inter_code->nextInst->nextInst->new1=0;
380 inter_code->nextInst->nextInst->new4=b_code->new4-1;
381 } else {
382 inter_code->nextInst->nextInst->op=procceed_op;
383 inter_code->nextInst->nextInst->new1=0;
384 inter_code->nextInst->nextInst->new4=0;
385 }
386 b_code->op=nop_op;
387
388 }
389
390 inter_code=inter_code->nextInst;
391 }
392
393 }
394
395
needs_box(Cell op)396 int needs_box(Cell op)
397 {
398 if (op==safe_call_op) return(1);
399 if (op==call_op) return(1);
400 if (op==std_base_op) return(1);
401 if (op==fail_op) return(1);
402 if (op==force_wait_op) return(1);
403 if (op==cut_op) return(1);
404 if (op==commit_op) return(1);
405 if (op==cutexit_op) return(1);
406 if (op==write_op) return(1);
407 if (op==is_op) return(1);
408 if (op==equal_op) return(1);
409 if (op==exit_op) return(1);
410
411 return(0);
412 }
413
test_for_side_effects()414 int test_for_side_effects()
415 {
416 int side_effects=0;
417
418 inter_code=StartCode;
419 while(inter_code!=NULL){
420 switch (inter_code->op) {
421 case write_op:
422 side_effects+=WRITE;
423 break;
424
425 case cutexit_op:
426 case commit_op:
427 case cut_op:
428 side_effects+=CUT;
429 break;
430 case force_wait_op:
431 side_effects+=SEQUENCIAL;
432 break;
433 }
434 inter_code=inter_code->nextInst;
435 }
436
437 return(side_effects);
438 }
439
convert_Yaam(struct Clauses * clause)440 void convert_Yaam(struct Clauses *clause)
441 {
442 PInstr *CodeStart, *ppc;
443 int calls=0;
444
445 clause->val=0;
446 clause->idx=Variavel;
447
448 StartCode=NULL;
449 inter_code=NULL;
450 CodeStart=(&CGLOBS->cint)->CodeStart;
451 ppc=CodeStart;
452 while(ppc!=NULL){ /* copia o codigo YAAM para poder ser alterado e ve o tipo de indexacao*/
453 if (ppc->op!=nop_op) {
454 if (ppc->op==get_var_op && ppc->rnd2==1) { clause->idx=Variavel; clause->val=0; }
455 if (ppc->op==get_list_op && ppc->rnd2==1) { clause->idx=Lista; clause->val=0; }
456 if (ppc->op==get_struct_op && ppc->rnd2==1) { clause->idx=Estrutura; clause->val=ppc->rnd1; }
457 if ((ppc->op==get_atom_op || ppc->op==get_num_op) && ppc->rnd2==1) { clause->idx=Constante; clause->val=ppc->rnd1; }
458
459 if (ppc->op==body_op || ppc->op==safe_call_op || ppc->op==call_op || ppc->op==execute_op) calls=1;
460
461 if (ppc->op==endgoal_op) {
462 if (calls==0) emit_new(equal_op, 0, 0);
463 calls=0;
464 } else {
465 emit_new(ppc->op, ppc->rnd2, ppc->rnd1);
466 if (ppc->op==body_op) calls=1;
467 if (ppc->op==safe_call_op || ppc->op==call_op || ppc->op==execute_op) {
468 calls=1; identify_calls(inter_code);
469 }
470 }
471
472 }
473 ppc=ppc->nextInst;
474 }
475 emit_new(nop_op, 0,0);
476 emit_new(nop_op, 0,0);
477
478 /*
479 CodeStart->nextInst=NULL;
480 ppc=CodeStart;
481
482 (&CGLOBS->cint)->cpc=CodeStart;
483
484 Yap_emit(cut_op,Zero,Zero,&CGLOBS->cint);
485 Yap_emit(run_op,Zero,(unsigned long) (CGLOBS->cint).CurrentPred,&CGLOBS->cint);
486 Yap_emit(procceed_op, Zero, Zero, &CGLOBS->cint);
487 */
488 return;
489 }
490
491
insert_inst(CInstr * inst,int o,int r1,CELL r4)492 CInstr *insert_inst(CInstr *inst, int o,int r1,CELL r4)
493 {
494 CInstr *p;
495
496 p=new_inst(o,r1,r4);
497 if (inst==NULL) inst=p;
498 else {
499 p->nextInst=inst->nextInst;
500 inst->nextInst=p;
501 }
502 return (p);
503 }
504
emit_new(int o,int r1,CELL r4)505 CInstr *emit_new(int o, int r1,CELL r4)
506 {
507 CInstr *p;
508
509 p=new_inst(o,r1,r4);
510 if (inter_code == NULL) {
511 inter_code = StartCode = p;
512 }
513 else {
514 inter_code->nextInst = p;
515 inter_code = p;
516 }
517 return(inter_code);
518 }
519
new_inst(int o,int r1,CELL r4)520 CInstr *new_inst(int o, int r1,CELL r4)
521 {
522 CInstr *p;
523
524 p = (CInstr *) alloc_mem_temp(sizeof(CInstr));
525 p->op = o;
526 p->new1 = r1;
527 p->new4 = r4;
528 p->nextInst = NULL;
529
530 return(p);
531 }
532
alloc_mem(Cell size)533 void *alloc_mem(Cell size)
534 {
535 void *p;
536
537 p=malloc(size);
538 if (p==NULL) { printf(" Erro, falta de memoria \n"); exit(1); }
539 // p=Yap_AllocCMem(size,&CGLOBS->cint);
540
541 return(p);
542 }
543
alloc_mem_temp(Cell size)544 void *alloc_mem_temp(Cell size) /* memory that will be discard after compiling */
545 {
546 void *p;
547
548 p=malloc(size);
549 if (p==NULL) { printf(" Erro, falta de memoria \n"); exit(1); }
550 // p=Yap_AllocCMem(size,&CGLOBS->cint);
551
552 return(p);
553 }
554
555
556
557 #ifdef DEBUG
558
559 static char *opformat2[] =
560 {
561 "nop",
562 "get_var %1,%4",
563 "put_var %1,%4",
564 "get_val %1,%4",
565 "put_val %1,%4",
566 "get_atom %1,%4",
567 "put_atom %1,%4",
568 "get_num %1,%4",
569 "put_num %1,%4",
570 "get_float %1,%4",
571 "put_float %1,%4",
572 "align_float %1,%4",
573 "get_longint %1,%4",
574 "put_longint %1,%4",
575 "get_bigint %1,%4",
576 "put_bigint %1,%4",
577 "get_list %1,%4",
578 "put_list %1,%4",
579 "get_struct %1,%4",
580 "put_struct %1,%4",
581 "put_unsafe %1,%4",
582 "unify_var %1,%4",
583 "write_var %1,%4",
584 "unify_val %1,%4",
585 "write_val %1,%4",
586 "unify_atom %1,%4",
587 "write_atom %1,%4",
588 "unify_num %1,%4",
589 "write_num %1,%4",
590 "unify_float %1,%4",
591 "write_float %1,%4",
592 "unify_longint %1,%4",
593 "write_longint %1,%4",
594 "unify_bigint %1,%4",
595 "write_bigint %1,%4",
596 "unify_list %1,%4",
597 "write_list %1,%4",
598 "unify_struct %1,%4",
599 "write_struct %1,%4",
600 "write_unsafe %1,%4",
601 "fail %1,%4",
602 "cut %1,%4",
603 "cutexit %1,%4",
604 "allocate %1,%4",
605 "deallocate %1,%4",
606 "try_me_else %1,%4",
607 "jump %1,%4",
608 "jump %1,%4",
609 "proceed %1,%4",
610 "call %1,%4",
611 "execute %1,%4",
612 "sys %1,%4",
613 "%l: %1,%4",
614 "name %1,%4",
615 "pop %1,%4",
616 "retry_me_else %1,%4",
617 "trust_me_else_fail %1,%4",
618 "either_me %1,%4",
619 "or_else %1,%4",
620 "or_last %1,%4",
621 "push_or %1,%4",
622 "pushpop_or %1,%4",
623 "pop_or %1,%4",
624 "save_by %1,%4",
625 "commit_by %1,%4",
626 "patch_by %1,%4",
627 "try %1,%4",
628 "retry %1,%4",
629 "trust %1,%4",
630 "try_in %1,%4",
631 "jump_if_var %1,%4",
632 "jump_if_nonvar %1,%4",
633 "cache_arg %1,%4",
634 "cache_sub_arg %1,%4",
635 "switch_on_type %1,%4",
636 "switch_on_constant %1,%4",
637 "if_constant %1,%4",
638 "switch_on_functor %1,%4",
639 "if_functor %1,%4",
640 "if_not_then %1,%4",
641 "index_on_dbref %1,%4",
642 "index_on_blob %1,%4",
643 "check_var %1,%4",
644 "save_pair %1,%4",
645 "save_appl %1,%4",
646 "fail_label %1,%4",
647 "unify_local %1,%4",
648 "write local %1,%4",
649 "unify_last_list %1,%4",
650 "write_last_list %1,%4",
651 "unify_last_struct %1,%4",
652 "write_last_struct %1,%4",
653 "unify_last_var %1,%4",
654 "unify_last_val %1,%4",
655 "unify_last_local %1,%4",
656 "unify_last_atom %1,%4",
657 "unify_last_num %1,%4",
658 "unify_last_float %1,%4",
659 "unify_last_longint %1,%4",
660 "unify_last_bigint %1,%4",
661 "pvar_bitmap %1,%4",
662 "pvar_live_regs %1,%4",
663 "fetch_reg1_reg2 %1,%4",
664 "fetch_constant_reg %1,%4",
665 "fetch_reg_constant %1,%4",
666 "function_to_var %1,%4",
667 "function_to_al %1,%4",
668 "enter_profiling %1,%4",
669 "retry_profiled %1,%4",
670 "count_call_op %1,%4",
671 "count_retry_op %1,%4",
672 "restore_temps %1,%4",
673 "restore_temps_and_skip %1,%4",
674 "enter_lu %1,%4",
675 "empty_call %1,%4",
676 #ifdef YAPOR
677 "sync
678 #endif /* YAPOR */
679 #ifdef TABLING
680 "table_new_answer %1,%4",
681 "table_try_single %1,%4",
682 #endif /* TABLING */
683 #ifdef TABLING_INNER_CUTS
684 "clause_with_cut %1,%4",
685 #endif /* TABLING_INNER_CUTS */
686 #ifdef BEAM
687 "run_op %1,%4",
688 "body_op %1",
689 "endgoal_op",
690 "try_me_op %1,%4",
691 "retry_me_op %1,%4",
692 "trust_me_op %1,%4",
693 "only_1_clause_op %1,%4",
694 "create_first_box_op %1,%4",
695 "create_box_op %1,%4",
696 "create_last_box_op %1,%4",
697 "remove_box_op %1,%4",
698 "remove_last_box_op %1,%4",
699 "prepare_tries",
700 "std_base_op %1,%4",
701 "direct_safe_call",
702 "commit_op",
703 "skip_while_var_op",
704 "wait_while_var_op",
705 "force_wait_op",
706 "write_op",
707 "is_op",
708 "exit",
709 #endif
710 "fetch_args_for_bccall %1,%4",
711 "binary_cfunc %1,%4",
712 "blob %1,%4",
713 #ifdef SFUNC
714 ,
715 "get_s_f_op %1,%4",
716 "put_s_f_op %1,%4",
717 "unify_s_f_op %1,%4",
718 "write_s_f_op %1,%4",
719 "unify_s_var %1,%4",
720 "write_s_var %1,%4",
721 "unify_s_val %1,%4",
722 "write_s_val %1,%4",
723 "unify_s_a %1,%4",
724 "write_s_a %1,%4",
725 "get_s_end",
726 "put_s_end",
727 "unify_s_end",
728 "write_s_end"
729 #endif
730 };
731
732 void ShowCode_new2(int op, int new1,CELL new4);
733
734 void ShowCode_new2(int op, int new1,CELL new4)
735 {
736 char *f,ch;
737 f=opformat2[op];
738
739 while ((ch = *f++) != 0)
740 {
741 if (ch == '%')
742 switch (ch = *f++)
743 {
744 case '1':
745 Yap_plwrite(MkIntTerm(new1), Yap_DebugPutc, 0, 1200);
746 break;
747 case '4':
748 Yap_plwrite(MkIntTerm(new4), Yap_DebugPutc, 0, 1200);
749 break;
750 default:
751 Yap_DebugPutc (Yap_c_error_stream,'%');
752 Yap_DebugPutc (Yap_c_error_stream,ch);
753 }
754 else
755 Yap_DebugPutc (Yap_c_error_stream,ch);
756 }
757 Yap_DebugPutc (Yap_c_error_stream,'\n');
758 }
759
760
761 #endif
762
763
764 #endif /* BEAM */
765