2005-09-08 23:36:16 +01:00
/*************************************************************************
* *
* BEAM - > Basic Extended Andorra Model *
* BEAM extends the YAP Prolog system to support the EAM *
* Copyright : Ricardo Lopes and NCC - University of Porto , Portugal *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* comments : eam abstract machine emulator *
* *
* IMPORTANT : ON i386 ISAPPL SHOUD ALWAYS BE AFTER ISVAR *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
# ifdef BEAM
# include "Yap.h"
# include "Yatom.h"
# include <stdlib.h>
# include <stdio.h>
# include <string.h>
# include <sys/types.h>
# include <sys/mman.h>
# include <sys/stat.h>
# include <fcntl.h>
# include <unistd.h>
2005-10-09 22:13:57 +01:00
# define Debug 0
2006-03-24 16:19:31 +00:00
# define Debug_GC 1
2005-09-08 23:36:16 +01:00
# define Debug_Dump_State 0 /* 0 =off || 1==only on Scheduling || 2== only on GC || 4=on every abs inst NOTE: DEBUG has to be enable to use 4*/
2005-10-09 22:13:57 +01:00
# define Debug_MEMORY 0
2005-09-08 23:36:16 +01:00
# define Memory_Stat 0
# define Clear_MEMORY 0 /* 0- do not clear || 1-> clear on request || 2-> clear on release || 3 -> both*/
# define Fast_go 1 /* normaly 1 ; use 0 to run some extra tests only to control some possible bugs (slower) */
# define USE_SPLIT 1
2006-03-24 16:19:31 +00:00
# define MEM_FOR_BOXES 32 /* In Mb */
# define MEM_FOR_HEAP 32 /* In Mb */
# define MEM_FOR_VARS 32 /* In Mb */
2005-09-08 23:36:16 +01:00
# define MEM_BOXES MEM_FOR_BOXES*1024*1024
# define MEM_H MEM_FOR_HEAP*1024*1024
# define MEM_VARS MEM_FOR_VARS*1024*1024
2006-03-24 16:19:31 +00:00
# define INDEX_SIZE 100000 /* size of vector for saving memory requests */
2005-09-08 23:36:16 +01:00
# define GARBAGE_COLLECTOR 2 /* 0= NO GC || 1 = Heap only || 2 = Heap + Box */
# define HYBRID_BOXMEM 1 /* 0 - Off || 1 - On */
# define START_ON_NEXT 1 /* PLEASE DON'T CHANGE , specially if you use skip_while_var */
# define USE_LEFTMOST 1 /* SHOULD ALWAYS BE 1 for now... */
# define MICRO_TIME 1 /* 0 == eamtime uses CPU time 1 == eamtime uses total time */
2006-03-24 16:19:31 +00:00
# define MAX_MEMORYSTAT 5000
2005-09-08 23:36:16 +01:00
# define READ 0
# define WRITE 1
2006-03-24 16:19:31 +00:00
# include "eam.h"
# include "eamamasm.h"
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
int EAM = 0 ; /* Is EAM enabled ? */
Cell * beam_ALTERNATIVES ; /* NEEDED FOR ABSMI */
PredEntry * bpEntry ;
struct EAM_Global EAMGlobal ;
struct EAM_Global * eamGlobal = & EAMGlobal ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
# if !Debug
# define INLINE inline
# define DIRECT_JUMP 1
# else
# define INLINE
# define DIRECT_JUMP 0
void break_top ( void ) ; void break_top ( void ) { } ;
2006-04-12 18:26:14 +01:00
void break_debug ( int ) ;
void break_debug ( int conta ) {
2006-03-24 16:19:31 +00:00
# if Debug_Dump_State & 4
dump_eam_state ( ) ;
# endif
2006-04-12 18:26:14 +01:00
if ( Debug ! = - 1 & & conta > Debug * 100 ) { printf ( " exit por contador>debug \n " ) ; exit ( 1 ) ; }
2006-03-24 16:19:31 +00:00
} ;
# endif
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
# define push_mode_and_sreg() { *--beam_sp = (Cell) beam_Mode; *--beam_sp = (Cell) beam_S; }
# define pop_mode_and_sreg() { beam_S = (Cell *) *beam_sp++; beam_Mode = (short) *beam_sp++; }
2005-09-08 23:36:16 +01:00
# define isvar(a) IsVarTerm((Cell) a)
# define isappl(a) IsApplTerm((Cell) a)
# define ispair(a) IsPairTerm((Cell) a)
# define isatom(a) IsAtomOrIntTerm((Cell) a)
# define reppair(a) RepPair((Cell) a)
# define repappl(a) RepAppl((Cell) a)
# define abspair(a) AbsPair((Term *) a)
# define absappl(a) AbsAppl((Term *) a)
2006-04-08 15:56:48 +01:00
int is_perm_var ( Cell * a ) ; inline int is_perm_var ( Cell * a ) { if ( a > = ( Cell * ) beam_END_BOX & & a < ( Cell * ) ( beam_END_BOX + MEM_VARS ) ) return ( 1 ) ; else return ( 0 ) ; }
//int is_perm_var(Cell *a); inline int is_perm_var(Cell *a) { if (a<(Cell *) beam_END_BOX) return(0); else return (1); }
//int is_perm_var(Cell *a); inline int is_perm_var(Cell *a) { if ( a<(Cell *) beam_START_ADDR_HEAP || a>=(Cell *) beam_END_BOX) return(1); else return (0); }
2005-09-08 23:36:16 +01:00
Cell deref ( Cell a ) ;
int Unify ( Cell * a , Cell * b ) ;
void UnifyCells ( Cell * a , Cell * b ) ;
void trail ( struct AND_BOX * andbox , struct PERM_VAR * a ) ;
void limpa_trail ( struct AND_BOX * andbox ) ;
void get_arguments ( int nr , Cell * a ) ;
Cell * save_arguments ( int nr ) ;
void remove_memory_arguments ( Cell * a ) ;
void initialize_memory_areas ( void ) ;
Cell * request_memory ( int size ) ;
void free_memory ( Cell * mem , int size ) ;
void limpa_trail_orbox ( struct OR_BOX * orbox ) ;
struct SUSPENSIONS * addto_suspensions_list ( struct AND_BOX * a , int reason ) ;
void delfrom_suspensions_list ( struct SUSPENSIONS * b ) ;
void totop_suspensions_list ( struct SUSPENSIONS * b ) ;
int verify_externals ( struct AND_BOX * and_box ) ;
void remove_from_perm_var_suspensions ( struct PERM_VAR * v , struct AND_BOX * andbox ) ;
void change_perm_var_suspensions ( struct PERM_VAR * v , struct AND_BOX * andbox , struct AND_BOX * new ) ;
void do_forking_andbox ( struct AND_BOX * a ) ;
void remove_all_externals ( struct AND_BOX * andbox ) ;
void remove_all_externals_suspensions ( struct AND_BOX * andbox ) ;
void del_andbox_and_sons ( struct AND_BOX * andbox ) ;
void del_orbox_and_sons ( struct OR_BOX * orbox ) ;
void waking_boxes_suspended_on_var ( struct PERM_VAR * v ) ;
struct PERM_VAR * request_permVar ( struct AND_BOX * a ) ;
void free_permVar ( struct PERM_VAR * v ) ;
2005-10-09 22:13:57 +01:00
Cell * request_memory_locals ( int nr ) ;
Cell * request_memory_locals_noinit ( int nr ) ;
2005-09-08 23:36:16 +01:00
void free_memory_locals ( Cell * l ) ;
void add_to_list_perms ( struct PERM_VAR * var , struct AND_BOX * a ) ;
void remove_list_perms ( struct AND_BOX * a ) ;
void move_perm_vars ( struct AND_BOX * b , struct AND_BOX * a ) ;
void move_perm_variables ( struct AND_BOX * a ) ;
void inc_level ( struct AND_BOX * andbox , int dif ) ;
void abort_eam ( char * s ) ;
void exit_eam ( char * s ) ;
int HEAP_MEM_FULL ( void ) ;
void change_from_to ( struct PERM_VAR * o , struct PERM_VAR * d ) ;
unsigned int index_of_hash_table_atom ( Cell c , int nr ) ;
unsigned int index_of_hash_table_appl ( Cell c , int nr ) ;
int deve_limpar_var ( struct EXTERNAL_VAR * e ) ;
struct status_and * remove_call_from_andbox ( struct status_and * ncall , struct AND_BOX * a ) ;
int is_leftmost ( struct AND_BOX * a , struct status_and * n ) ;
int exists_var_in ( Cell * c ) ;
void garbage_collector ( void ) ;
void conta_memoria_livre ( int size ) ;
int showTime ( void ) ;
struct AND_BOX * choose_leftmost ( void ) ;
2006-03-24 16:19:31 +00:00
extern Cell BEAM_is ( void ) ;
2005-09-08 23:36:16 +01:00
extern void do_eam_indexing ( struct Predicates * ) ;
2012-02-13 23:07:31 +00:00
extern void Yap_plwrite ( Term , void * , int , int ) ;
2005-09-08 23:36:16 +01:00
# if Debug_Dump_State
void dump_eam_state ( void ) ;
# endif
/************************************************************************\
* Debug + Status routines *
\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
void conta_memoria_livre ( int size ) {
int i , nr , ult = 0 ;
long total = 0 ;
Cell * c ;
for ( i = 0 ; i < INDEX_SIZE ; i + + ) {
nr = 0 ;
2006-03-24 16:19:31 +00:00
c = beam_IndexFree [ i ] ;
2005-09-08 23:36:16 +01:00
while ( c ! = NULL ) {
ult = i ;
nr + + ;
c = ( Cell * ) * c ;
}
total = total + nr * i ;
}
2006-04-08 15:56:48 +01:00
printf ( " Ultimo Pedido (bytes) =%d <20> Ultimo bloco livre=%d \n " , size , ( int ) ult * CELL_SIZE ) ;
2006-03-24 16:19:31 +00:00
printf ( " Memoria TOTAL (bytes) =%ld \n " , ( ( unsigned long ) beam_END_BOX ) - ( ( unsigned long ) beam_START_ADDR_BOXES ) ) ;
printf ( " Memoria livre no IndexFree=%ld \n " , total * CELL_SIZE ) ;
printf ( " Memoria Total livre =%ld \n " , total * CELL_SIZE + ( ( unsigned long ) beam_END_BOX ) - ( ( unsigned long ) beam_NextFree ) ) ;
printf ( " Memoria Total na HEAP=%ld livre=%ld \n " , ( unsigned long ) MEM_H , ( unsigned long ) beam_H - ( unsigned long ) beam_START_ADDR_HEAP ) ;
2005-09-08 23:36:16 +01:00
}
void abort_eam ( char * s )
{
printf ( " %s \n " , s ) ;
exit ( 1 ) ;
}
void exit_eam ( char * s )
{
printf ( " %s \n " , s ) ;
2006-03-24 16:19:31 +00:00
if ( beam_nr_call_forking ) printf ( " %d forks executed \n " , beam_nr_call_forking ) ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
if ( beam_nr_gc_heap )
printf ( " GC was called %d times on Heap Mem \n " , beam_nr_gc_heap ) ;
if ( beam_nr_gc_boxed )
printf ( " GC was called %d times on Boxed Mem \n " , beam_nr_gc_boxed ) ;
if ( beam_nr_gc_boxed & & beam_nr_gc_heap )
printf ( " GC was called %d times \n " , beam_nr_gc_boxed + beam_nr_gc_heap ) ;
2005-09-08 23:36:16 +01:00
# if Memory_Stat
{ unsigned long req , used ;
2006-03-24 16:19:31 +00:00
req = beam_TOTAL_MEM + beam_TOTAL_PERMS ;
used = ( beam_TOTAL_MEM + beam_TOTAL_PERMS ) - ( beam_MEM_REUSED + beam_PERMS_REUSED ) ;
2005-09-08 23:36:16 +01:00
printf ( " ------------------------------------------------------------------- \n " ) ;
printf ( " Total Mem: Requested %ld (%.2fKb) (%.2fMb) \n " , req , req / 1024.0 , req / 1048576.0 ) ;
printf ( " Used %ld (%.2fKb) (%.2fMb) / Reused (%3.2f%c) \n " , used , used / 1024.0 , used / 1048576.0 , ( float ) ( req - used ) / req * 100 , ' % ' ) ;
printf ( " ------------------------------------------------------------------- \n " ) ;
2006-03-24 16:19:31 +00:00
used = ( beam_TOTAL_MEM - beam_TOTAL_TEMPS ) - ( beam_MEM_REUSED - beam_TEMPS_REUSED ) ;
printf ( " Boxed Mem: Requested %ld (%.2fKb) (%.2fMb) \n " , beam_TOTAL_MEM - beam_TOTAL_TEMPS , ( beam_TOTAL_MEM - beam_TOTAL_TEMPS ) / 1024.0 , ( beam_TOTAL_MEM - beam_TOTAL_TEMPS ) / 1048576.0 ) ;
printf ( " Used %ld (%.2fKb) (%.2fMb) / Reused (%3.2f%c) \n " , used , used / 1024.0 , used / 1048576.0 , ( float ) ( beam_MEM_REUSED - beam_TEMPS_REUSED ) / ( beam_TOTAL_MEM - beam_TOTAL_TEMPS ) * 100 , ' % ' ) ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
used = beam_TOTAL_TEMPS - beam_TEMPS_REUSED ;
printf ( " Temps Mem: Requested %ld (%.2fKb) (%.2fMB) \n " , beam_TOTAL_TEMPS , beam_TOTAL_TEMPS / 1024.0 , beam_TOTAL_TEMPS / 1048576.0 ) ;
printf ( " Used %ld (%.2fKb) (%.2fMb) / Reused (%3.2f%c) \n " , used , used / 1024.0 , used / 1048576.0 , ( float ) beam_TEMPS_REUSED / ( beam_TOTAL_TEMPS ) * 100 , ' % ' ) ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
used = beam_TOTAL_PERMS - beam_PERMS_REUSED ;
printf ( " Perms Mem: Requested %ld (%.2fKb) (%.2fMB) \n " , beam_TOTAL_PERMS , beam_TOTAL_PERMS / 1024.0 , beam_TOTAL_PERMS / 1048576.0 ) ;
printf ( " Used %ld (%.2fKb) (%.2fMb) / Reused (%3.2f%c) \n " , used , used / 1024.0 , used / 1048576.0 , ( float ) beam_PERMS_REUSED / ( beam_TOTAL_PERMS ) * 100 , ' % ' ) ;
2005-09-08 23:36:16 +01:00
}
printf ( " ------------------------------------------------------------------- \n " ) ;
2006-03-24 16:19:31 +00:00
if ( beam_nr_gc_boxed + beam_nr_gc_heap > 0 ) {
2005-09-08 23:36:16 +01:00
int i ;
2006-03-24 16:19:31 +00:00
beam_Memory_STAT [ 0 ] [ 0 ] = 0 ; beam_Memory_STAT [ 0 ] [ 1 ] = 0 ; beam_Memory_STAT [ 0 ] [ 2 ] = 0 ; beam_Memory_STAT [ 0 ] [ 3 ] = 0 ; beam_Memory_STAT [ 0 ] [ 4 ] = 0 ;
for ( i = 1 ; i < = beam_nr_gc_boxed + beam_nr_gc_heap ; i + + ) {
beam_Memory_STAT [ 0 ] [ 0 ] + = beam_Memory_STAT [ i ] [ 0 ] ;
beam_Memory_STAT [ 0 ] [ 1 ] + = beam_Memory_STAT [ i ] [ 1 ] ;
beam_Memory_STAT [ 0 ] [ 2 ] + = beam_Memory_STAT [ i ] [ 2 ] ;
beam_Memory_STAT [ 0 ] [ 3 ] + = beam_Memory_STAT [ i ] [ 3 ] ;
beam_Memory_STAT [ 0 ] [ 4 ] + = beam_Memory_STAT [ i ] [ 4 ] ;
2005-09-08 23:36:16 +01:00
printf ( " GC %4d Time=%ld H=%ld to %ld (%3.2f) Box=%ld to %ld (%3.2f) \n " ,
2006-03-24 16:19:31 +00:00
i , beam_Memory_STAT [ i ] [ 0 ] , beam_Memory_STAT [ i ] [ 1 ] , beam_Memory_STAT [ i ] [ 3 ] ,
( ( float ) beam_Memory_STAT [ i ] [ 3 ] / beam_Memory_STAT [ i ] [ 1 ] ) * 100 , beam_Memory_STAT [ i ] [ 2 ] , beam_Memory_STAT [ i ] [ 4 ] ,
( ( float ) beam_Memory_STAT [ i ] [ 4 ] / beam_Memory_STAT [ i ] [ 2 ] ) * 100 ) ;
2005-09-08 23:36:16 +01:00
}
i - - ;
printf ( " \n RESUME GC: Time=%ld H=%ld to %ld (%3.2f) Box=%ld to %ld (%3.2f) \n " ,
2006-03-24 16:19:31 +00:00
beam_Memory_STAT [ 0 ] [ 0 ] / i , beam_Memory_STAT [ 0 ] [ 1 ] / i , beam_Memory_STAT [ 0 ] [ 3 ] / i ,
100.0 - ( ( float ) beam_Memory_STAT [ 0 ] [ 3 ] / beam_Memory_STAT [ 0 ] [ 1 ] ) * 100 , beam_Memory_STAT [ 0 ] [ 2 ] / i , beam_Memory_STAT [ 0 ] [ 4 ] / i ,
100.0 - ( ( float ) beam_Memory_STAT [ 0 ] [ 4 ] / beam_Memory_STAT [ 0 ] [ 2 ] ) * 100 ) ;
2005-09-08 23:36:16 +01:00
} else {
2006-03-24 16:19:31 +00:00
printf ( " Heap Mem Requested %ld (%.2fKb) (%.2fMB) \n " , ( ( unsigned long ) beam_H - beam_START_ADDR_HEAP ) , ( ( unsigned long ) beam_H - beam_START_ADDR_HEAP ) / 1024.0 , ( ( unsigned long ) beam_H - beam_START_ADDR_HEAP ) / 1048576.0 ) ;
2005-09-08 23:36:16 +01:00
printf ( " ------------------------------------------------------------------- \n " ) ;
}
# endif
exit ( 0 ) ;
}
/************************************************************************\
* Memory Management routines *
\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
void initialize_memory_areas ( )
{
static int first_time = 1 ;
if ( first_time ) {
first_time = 0 ;
2006-03-24 16:19:31 +00:00
beam_IndexFree = ( Cell * * ) malloc ( INDEX_SIZE * POINTER_SIZE ) ;
if ( ( void * ) beam_IndexFree = = ( void * ) NULL ) abort_eam ( " Memory Initialization Error IndexFree \n " ) ;
beam_START_ADDR_HEAP = ( unsigned long ) malloc ( MEM_H + MEM_BOXES + MEM_VARS ) ;
if ( ( void * ) beam_START_ADDR_HEAP = = ( void * ) NULL ) abort_eam ( " Memory Initialization Error Heap+Boxes \n " ) ;
beam_START_ADDR_BOXES = beam_START_ADDR_HEAP + MEM_H ;
beam_END_H = beam_START_ADDR_HEAP + MEM_H ;
beam_END_BOX = beam_START_ADDR_BOXES + MEM_BOXES ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_sp = ( Cell * ) beam_END_H ; beam_sp - = 2 ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
beam_NextVar = ( struct PERM_VAR * ) beam_END_BOX ;
beam_H = ( Cell * ) beam_START_ADDR_HEAP ;
2005-09-08 23:36:16 +01:00
# if GARBAGE_COLLECTOR!=2
2006-03-24 16:19:31 +00:00
beam_NextFree = ( Cell * ) beam_END_BOX ;
2005-09-08 23:36:16 +01:00
# else
2006-03-24 16:19:31 +00:00
beam_NextFree = ( Cell * ) beam_START_ADDR_BOXES ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_MemGoing = 1 ;
memset ( beam_IndexFree , 0 , INDEX_SIZE * POINTER_SIZE ) ;
2005-09-08 23:36:16 +01:00
{ int i , max ;
max = MEM_VARS / PERM_VAR_SIZE ;
for ( i = 0 ; i < max - 1 ; i + + ) {
2006-03-24 16:19:31 +00:00
beam_NextVar [ i ] . next = & beam_NextVar [ i + 1 ] ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_NextVar [ max - 1 ] . next = NULL ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_varlocals = NULL ;
beam_USE_SAME_ANDBOX = NULL ;
beam_nr_alternative = NULL ;
beam_nr_call = NULL ;
beam_nr_gc_heap = 0 ;
beam_nr_gc_boxed = 0 ;
beam_Mode = READ ;
beam_VAR_TRAIL_NR = 0 ;
beam_nr_call_forking = 0 ;
beam_Mem_FULL = 0 ;
2005-09-08 23:36:16 +01:00
# if Memory_Stat
2006-03-24 16:19:31 +00:00
beam_TOTAL_MEM = 0 ; beam_MEM_REUSED = 0 ; beam_TOTAL_TEMPS = 0 ; beam_TEMPS_REUSED = 0 ; beam_TOTAL_PERMS = 0 ; beam_PERMS_REUSED = 0 ;
memset ( beam_Memory_STAT , 0 , MAX_MEMORYSTAT * 5 * sizeof ( unsigned long ) ) ;
2005-09-08 23:36:16 +01:00
# endif
}
INLINE int HEAP_MEM_FULL ( void )
{
2006-03-24 16:19:31 +00:00
if ( beam_MemGoing = = 1 ) {
if ( ( unsigned long ) beam_H > ( unsigned long ) ( beam_START_ADDR_HEAP + MEM_H / 2 ) ) {
beam_Mem_FULL | = 2 ;
2005-09-08 23:36:16 +01:00
}
} else {
2006-03-24 16:19:31 +00:00
if ( ( unsigned long ) beam_H > ( unsigned long ) ( beam_START_ADDR_HEAP + MEM_H ) ) {
beam_Mem_FULL | = 2 ;
2005-09-08 23:36:16 +01:00
}
}
2006-03-24 16:19:31 +00:00
return ( beam_Mem_FULL ) ;
2005-09-08 23:36:16 +01:00
}
INLINE Cell * request_memory ( int size ) /* size in bytes */
{
register Cell * mem ;
register int size_cells ;
if ( size = = 0 ) return NULL ;
size_cells = size / CELL_SIZE ;
# if !Fast_go
if ( size_cells > INDEX_SIZE )
abort_eam ( " Foi pedido um block de memoria grande demais !!! \n " ) ;
# endif
# if Debug & Debug_MEMORY
printf ( " Requesting memory size %d \n " , size_cells ) ;
# endif
# if HYBRID_BOXMEM
2006-03-24 16:19:31 +00:00
mem = beam_IndexFree [ ( unsigned ) size_cells ] ;
2005-09-08 23:36:16 +01:00
# if Memory_Stat
2006-03-24 16:19:31 +00:00
beam_TOTAL_MEM + = size ;
if ( mem ! = NULL ) beam_MEM_REUSED + = size ;
2005-09-08 23:36:16 +01:00
# endif
if ( mem = = NULL ) {
# else /* GC Only */
# if Memory_Stat
2006-03-24 16:19:31 +00:00
beam_TOTAL_MEM + = size ;
2005-09-08 23:36:16 +01:00
# endif
if ( 1 ) {
# endif
# if GARBAGE_COLLECTOR!=2
2006-03-24 16:19:31 +00:00
beam_NextFree - = size_cells ;
mem = beam_NextFree ;
if ( beam_NextFree < ( Cell * ) beam_START_ADDR_BOXES ) abort_eam ( " No more BOX_MEM \n " ) ;
2005-09-08 23:36:16 +01:00
# else
2006-03-24 16:19:31 +00:00
if ( beam_MemGoing = = 1 ) {
mem = beam_NextFree ;
beam_NextFree + = size_cells ;
if ( beam_NextFree > ( Cell * ) ( beam_START_ADDR_BOXES + MEM_BOXES / 2 ) ) beam_Mem_FULL | = 1 ;
2005-09-08 23:36:16 +01:00
} else {
2006-03-24 16:19:31 +00:00
beam_NextFree - = size_cells ;
mem = beam_NextFree ;
if ( beam_NextFree < ( Cell * ) ( beam_START_ADDR_BOXES + MEM_BOXES / 2 ) ) beam_Mem_FULL | = 1 ;
2005-09-08 23:36:16 +01:00
}
# endif
} else {
2006-03-24 16:19:31 +00:00
beam_IndexFree [ ( unsigned ) size_cells ] = ( Cell * ) * mem ;
2005-09-08 23:36:16 +01:00
}
# if Clear_MEMORY & 1
memset ( mem , 0 , size ) ; /* NOT REALLY NECESSARY, use only to detect possible errors*/
# endif
return ( mem ) ;
}
# if HYBRID_BOXMEM==0
void free_memory ( Cell * mem , int size ) {
# if Clear_MEMORY & 2
memset ( mem , 0 , size ) ;
# endif
} ;
# else
INLINE void free_memory ( Cell * mem , int size ) /* size in bytes */
{
2005-10-09 22:13:57 +01:00
register int size_cells ;
2005-09-08 23:36:16 +01:00
if ( size = = 0 | | mem = = NULL ) return ;
size_cells = size / CELL_SIZE ;
# if Clear_MEMORY & 2
memset ( mem , 0 , size ) ; /* NOT REALLY NECESSARY, use only to detect possible errors*/
# endif
# if Debug & Debug_MEMORY
printf ( " Freeing memory size %d \n " , size_cells ) ;
# endif
2006-03-24 16:19:31 +00:00
* mem = ( Cell ) beam_IndexFree [ size_cells ] ;
beam_IndexFree [ size_cells ] = mem ;
2005-09-08 23:36:16 +01:00
}
# endif
INLINE void get_arguments ( int nr , Cell * a )
{
register int i ;
2006-03-24 16:19:31 +00:00
for ( i = 1 ; i < = nr ; i + + ) beam_X [ i ] = a [ i ] ;
2005-09-08 23:36:16 +01:00
}
INLINE Cell * save_arguments ( int nr ) /* nr arguments */
{
if ( ! nr ) return ( NULL ) ;
{
register int i ;
register Cell * a ;
a = ( Cell * ) request_memory ( ( nr + 1 ) * CELL_SIZE ) ;
a [ 0 ] = nr + 1 ;
2006-03-24 16:19:31 +00:00
for ( i = 1 ; i < = nr ; i + + ) a [ i ] = beam_X [ i ] ;
2005-09-08 23:36:16 +01:00
return ( a ) ;
}
}
INLINE void remove_memory_arguments ( Cell * a )
{
if ( a = = NULL ) return ;
2006-04-08 15:56:48 +01:00
# if !Fast_go
if ( a [ 0 ] < 1 | | a [ 0 ] > 1000 )
printf ( " %d Numero Invalido de Argumentos............ \n " , a [ 0 ] ) ;
# endif
2005-09-08 23:36:16 +01:00
free_memory ( a , a [ 0 ] * CELL_SIZE ) ;
}
struct PERM_VAR * request_permVar ( struct AND_BOX * a ) {
struct PERM_VAR * pv ;
# if Memory_Stat
static struct PERM_VAR * old = NULL ;
2006-03-24 16:19:31 +00:00
beam_TOTAL_PERMS + = PERM_VAR_SIZE ;
if ( old < = beam_NextVar ) old = beam_NextVar ;
else beam_PERMS_REUSED + = PERM_VAR_SIZE ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
# if Debug && Debug_MEMORY
2005-09-08 23:36:16 +01:00
printf ( " Requesting a permVar... \n " ) ;
# endif
# if !Fast_go
2006-03-24 16:19:31 +00:00
if ( beam_NextVar - > next = = NULL ) { printf ( " Fim da memoria para variaveis \n " ) ; exit ( - 1 ) ; }
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
pv = beam_NextVar ;
beam_NextVar = beam_NextVar - > next ;
2005-09-08 23:36:16 +01:00
pv - > value = ( Cell ) & ( pv - > value ) ;
pv - > home = a ;
pv - > suspensions = NULL ;
pv - > yapvar = NULL ;
pv - > next = a - > perms ;
a - > perms = pv ;
return ( pv ) ;
}
void free_permVar ( struct PERM_VAR * v ) {
# if Clear_MEMORY
v - > value = ( Cell ) NULL ;
v - > home = ( struct AND_BOX * ) NULL ;
v - > suspensions = ( struct SUSPENSIONS_VAR * ) NULL ;
# endif
# if Debug & Debug_MEMORY
printf ( " Freeing a permVar... \n " ) ;
# endif
2006-03-24 16:19:31 +00:00
v - > next = beam_NextVar ;
beam_NextVar = v ;
2005-09-08 23:36:16 +01:00
return ;
}
2005-10-09 22:13:57 +01:00
INLINE Cell * request_memory_locals ( int nr )
2005-09-08 23:36:16 +01:00
{
Cell * l ;
int i ;
# if Memory_Stat
Cell * old ;
2006-03-24 16:19:31 +00:00
old = beam_NextFree ;
beam_TOTAL_TEMPS + = CELL_SIZE * ( nr + 1 ) ;
2005-09-08 23:36:16 +01:00
# endif
# if Debug_MEMORY
printf ( " Requesting Memory for %d+1 locals... \n " , nr ) ;
# endif
l = ( Cell * ) request_memory ( CELL_SIZE * ( nr + 1 ) ) ;
l [ 0 ] = nr ;
l + + ;
for ( i = 0 ; i < nr ; i + + ) {
l [ i ] = ( Cell ) & l [ i ] ;
}
# if Memory_Stat
2006-03-24 16:19:31 +00:00
if ( old = = beam_NextFree ) beam_TEMPS_REUSED + = CELL_SIZE * ( nr + 1 ) ;
2005-09-08 23:36:16 +01:00
# endif
return ( l ) ;
}
2005-10-09 22:13:57 +01:00
INLINE Cell * request_memory_locals_noinit ( int nr )
{
Cell * l ;
# if Memory_Stat
Cell * old ;
2006-03-24 16:19:31 +00:00
old = beam_NextFree ;
beam_TOTAL_TEMPS + = CELL_SIZE * ( nr + 1 ) ;
2005-10-09 22:13:57 +01:00
# endif
# if Debug_MEMORY
printf ( " Requesting Memory for %d+1 locals (not initialized)... \n " , nr ) ;
# endif
l = ( Cell * ) request_memory ( CELL_SIZE * ( nr + 1 ) ) ;
l [ 0 ] = nr ;
l + + ;
# if Memory_Stat
2006-03-24 16:19:31 +00:00
if ( old = = beam_NextFree ) beam_TEMPS_REUSED + = CELL_SIZE * ( nr + 1 ) ;
2005-10-09 22:13:57 +01:00
# endif
return ( l ) ;
}
2005-09-08 23:36:16 +01:00
INLINE void free_memory_locals ( Cell * l )
{
if ( l = = NULL | | l [ - 1 ] = = 0 ) return ;
# if Debug_MEMORY
printf ( " Freeing Memory for %ld+1 locals... \n " , l [ - 1 ] ) ;
# endif
free_memory ( ( Cell * ) & l [ - 1 ] , CELL_SIZE * ( l [ - 1 ] + 1 ) ) ;
l [ - 1 ] = 0 ; /* <20> necess<73> rio para evitar apagar este vector novamente
porque varias calls podem estar a referenciar o mesmo vector locals */
}
/************************************************************************\
* Manipulating And - Or - Boxes structures *
\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
void del_andbox_and_sons ( struct AND_BOX * andbox )
{
register struct status_and * ncall ;
if ( andbox = = NULL ) return ;
remove_all_externals ( andbox ) ;
delfrom_suspensions_list ( andbox - > suspended ) ;
ncall = andbox - > calls ;
while ( ncall ! = NULL ) {
del_orbox_and_sons ( ncall - > call ) ;
{
struct status_and * ncall_old ;
ncall_old = ncall ;
ncall = ncall - > next ;
free_memory_locals ( ncall_old - > locals ) ;
free_memory ( ( Cell * ) ncall_old , STATUS_AND_SIZE ) ;
}
}
remove_list_perms ( andbox ) ;
free_memory ( ( Cell * ) andbox , ANDBOX_SIZE ) ;
}
void del_orbox_and_sons ( struct OR_BOX * orbox )
{
struct status_or * so ;
Cell * a = NULL ;
if ( orbox = = NULL ) return ;
so = orbox - > alternatives ;
while ( so ! = NULL ) {
struct status_or * old ;
del_andbox_and_sons ( so - > alternative ) ;
a = so - > args ;
old = so ;
so = so - > next ;
free_memory ( ( Cell * ) old , STATUS_OR_SIZE ) ;
}
remove_memory_arguments ( a ) ; /* remove args */
free_memory ( ( Cell * ) orbox , ORBOX_SIZE ) ;
}
INLINE struct status_and * remove_call_from_andbox ( struct status_and * ncall , struct AND_BOX * a )
{
register int nr ;
struct status_and * r ;
nr = a - > nr_all_calls ;
nr - - ;
a - > nr_all_calls = nr ;
if ( nr = = 0 ) {
a - > calls = NULL ;
} else {
if ( ncall - > previous ! = NULL ) {
ncall - > previous - > next = ncall - > next ;
} else a - > calls = ncall - > next ;
if ( ncall - > next ! = NULL ) {
ncall - > next - > previous = ncall - > previous ;
}
}
r = ncall - > next ;
{ /* vou ver se as locals ainda estao a ser usadas por outra ncall */
int aSerUsada = 0 ;
struct status_and * l ;
l = ncall - > previous ;
while ( l ! = NULL ) {
if ( l - > locals = = ncall - > locals ) { aSerUsada = 1 ; break ; }
l = l - > previous ;
}
l = r ;
while ( aSerUsada = = 0 & & l ! = NULL ) {
if ( l - > locals = = ncall - > locals ) { aSerUsada = 1 ; break ; }
l = l - > next ;
}
// aSerUsada=1; /* CUIDADO ao apagar as var locals da call */
if ( aSerUsada = = 0 ) free_memory_locals ( ncall - > locals ) ;
}
free_memory ( ( Cell * ) ncall , STATUS_AND_SIZE ) ;
return ( r ) ;
}
INLINE void totop_suspensions_list ( struct SUSPENSIONS * b )
{
2006-03-24 16:19:31 +00:00
if ( beam_su = = b ) return ; /* is already on top of list */
if ( beam_su - > prev = = b ) { beam_su = b ; return ; } /* It was the last one */
2005-09-08 23:36:16 +01:00
b - > prev - > next = b - > next ;
b - > next - > prev = b - > prev ;
2006-03-24 16:19:31 +00:00
b - > next = beam_su ;
b - > prev = beam_su - > prev ;
beam_su - > prev = b ;
2005-09-08 23:36:16 +01:00
b - > prev - > next = b ;
2006-03-24 16:19:31 +00:00
beam_su = b ;
2005-09-08 23:36:16 +01:00
}
void waking_boxes_suspended_on_var ( struct PERM_VAR * v )
{
struct SUSPENSIONS_VAR * s ;
s = v - > suspensions ;
while ( s ! = NULL ) {
register struct AND_BOX * a ;
# if Debug
printf ( " Waking and_box assigment changed on a var that forced and_box to suspend \n " ) ;
# endif
a = s - > and_box ;
totop_suspensions_list ( a - > suspended ) ;
a - > nr_alternative - > state | = WAKE ;
s = s - > next ;
}
}
/* THE FALLOWING ROTINES ARE TO BE APPLYED TO THE SUSPENSION LIST
( DO NOT USE IT TO THE SUSPENSIONS ON THE LOCAL_VAR ) */
INLINE struct SUSPENSIONS * addto_suspensions_list ( struct AND_BOX * a , int r )
{
struct SUSPENSIONS * s ;
if ( a - > suspended ) return ( a - > suspended ) ; /* already suspended */
s = ( struct SUSPENSIONS * ) request_memory ( SUSPENSIONS_SIZE ) ;
s - > and_box = a ;
s - > reason = r ;
2006-03-24 16:19:31 +00:00
if ( beam_su = = NULL ) {
2005-09-08 23:36:16 +01:00
s - > next = s ;
s - > prev = s ;
2006-03-24 16:19:31 +00:00
beam_su = s ;
2005-09-08 23:36:16 +01:00
} else {
2006-03-24 16:19:31 +00:00
s - > next = beam_su ;
s - > prev = beam_su - > prev ;
beam_su - > prev = s ;
if ( beam_su - > next = = beam_su ) { /* so existem 2 elementos na lista */
beam_su - > next = s ;
2005-09-08 23:36:16 +01:00
} else {
s - > prev - > next = s ;
}
}
return ( s ) ;
}
void delfrom_suspensions_list ( struct SUSPENSIONS * b )
{
if ( b = = NULL ) return ;
# if !Fast_go
if ( b - > and_box - > suspended = = NULL )
abort_eam ( " Nunca deveria acontecer no delfrom_suspensions_list ????? \n " ) ;
# endif
remove_all_externals_suspensions ( b - > and_box ) ;
b - > and_box - > suspended = NULL ;
2006-03-24 16:19:31 +00:00
if ( b = = beam_su ) beam_su = b - > next ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
if ( b = = beam_su ) { /* so existe um */
beam_su = NULL ;
2005-09-08 23:36:16 +01:00
} else {
b - > prev - > next = b - > next ;
b - > next - > prev = b - > prev ;
}
free_memory ( ( Cell * ) b , SUSPENSIONS_SIZE ) ;
}
INLINE void change_perm_var_suspensions ( struct PERM_VAR * v , struct AND_BOX * andbox , struct AND_BOX * new )
{
struct SUSPENSIONS_VAR * s ;
s = v - > suspensions ;
while ( s ! = NULL )
{
if ( s - > and_box = = andbox ) {
s - > and_box = new ;
return ;
}
s = s - > next ;
}
}
/* MANIPULATE PERM VARS SUSPENSIONS */
INLINE void remove_from_perm_var_suspensions ( struct PERM_VAR * v , struct AND_BOX * andbox )
{
struct SUSPENSIONS_VAR * s , * prev = NULL ;
if ( v = = NULL ) {
# if !Fast_go
abort_eam ( " Nunca deveria acontecer no remove_from_perm_var_suspensions ????? \n " ) ;
# endif
return ;
}
s = v - > suspensions ;
while ( s ! = NULL )
{
struct SUSPENSIONS_VAR * next ;
next = s - > next ;
if ( s - > and_box = = andbox ) {
if ( prev = = NULL ) {
v - > suspensions = s - > next ;
} else prev - > next = s - > next ;
free_memory ( ( Cell * ) s , SUSPENSIONS_VAR_SIZE ) ;
} else { /* acordar as boxes restantes porque houve uma alteracao */
s - > and_box - > nr_alternative - > state | = WAKE ;
prev = s ;
}
s = next ;
}
}
void remove_all_externals_suspensions ( struct AND_BOX * andbox )
{
struct EXTERNAL_VAR * e ;
e = andbox - > externals ;
while ( e ) {
remove_from_perm_var_suspensions ( e - > var , andbox ) ;
e = e - > next ;
}
}
void remove_all_externals ( struct AND_BOX * andbox )
{
struct EXTERNAL_VAR * e ;
e = andbox - > externals ;
while ( e ) {
struct EXTERNAL_VAR * next ;
next = e - > next ;
remove_from_perm_var_suspensions ( e - > var , andbox ) ;
free_memory ( ( Cell * ) e , EXTERNAL_VAR_SIZE ) ;
e = next ;
}
}
void remove_list_perms ( struct AND_BOX * a )
{
struct PERM_VAR * l , * oldl ;
l = a - > perms ;
a - > perms = NULL ;
while ( l ) {
oldl = l ;
l = oldl - > next ;
free_permVar ( oldl ) ;
}
}
INLINE void move_perm_vars ( struct AND_BOX * b , struct AND_BOX * a ) /* (from b to a) */
{
struct PERM_VAR * l , * old ;
l = b - > perms ;
if ( l = = NULL ) return ;
do {
old = l ;
l - > home = a ;
if ( l - > suspensions ) change_perm_var_suspensions ( l , b , a ) ;
l = l - > next ;
} while ( l ! = NULL ) ;
old - > next = a - > perms ;
a - > perms = b - > perms ;
return ;
}
void add_to_list_perms ( struct PERM_VAR * var , struct AND_BOX * a )
{
var - > next = a - > perms ;
a - > perms = var ;
return ;
}
/* change all suspended external references of perm var o to perm var d */
void change_from_to ( struct PERM_VAR * o , struct PERM_VAR * d ) {
struct SUSPENSIONS_VAR * s , * last ;
# if Debug
printf ( " Change Vars from one andbox to another \n " ) ;
# endif
s = o - > suspensions ;
if ( s = = NULL ) return ;
/* CUIDADO - Don't Forget to Write de Code to verify if they are compatible */
/* second change the references of o to point to d, also change suspensions from o to d */
do {
struct EXTERNAL_VAR * e ;
# if Debug
struct SUSPENSIONS_VAR * l ;
l = d - > suspensions ;
while ( l ! = NULL ) {
if ( l - > and_box = = s - > and_box ) {
printf ( " Same and-box binding... must check for compatibility.......!!!! " ) ;
}
l = l - > next ;
}
# endif
e = s - > and_box - > externals ;
while ( e ! = NULL ) {
if ( e - > var = = o ) {
e - > var = d ;
}
e = e - > next ;
}
last = s ;
s = s - > next ;
} while ( s ) ;
last - > next = d - > suspensions ;
d - > suspensions = o - > suspensions ;
o - > suspensions = NULL ;
}
/************************************************************************\
* Other routines *
\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
void inc_level ( struct AND_BOX * andbox , int dif )
{
struct OR_BOX * orbox ;
struct status_and * calls ;
if ( andbox = = NULL ) return ;
andbox - > level + = dif ;
calls = andbox - > calls ;
while ( calls ! = NULL ) {
orbox = calls - > call ;
if ( orbox ! = NULL ) {
struct status_or * so ;
so = orbox - > alternatives ;
while ( so ! = NULL ) {
inc_level ( so - > alternative , dif ) ;
so = so - > next ;
}
}
calls = calls - > next ;
}
}
INLINE int is_leftmost ( struct AND_BOX * a , struct status_and * n )
{
2006-03-24 16:19:31 +00:00
if ( a = = beam_top ) return ( 1 ) ;
2005-09-08 23:36:16 +01:00
if ( a - > calls ! = n ) return ( 0 ) ;
if ( a - > nr_alternative - > previous ! = NULL ) return ( 0 ) ;
return ( is_leftmost ( a - > parent - > parent , a - > parent - > nr_call ) ) ;
}
struct AND_BOX * choose_leftmost ( void )
{
struct AND_BOX * a ;
struct OR_BOX * o = NULL ;
struct status_and * ncall ;
2006-03-24 16:19:31 +00:00
a = beam_top ;
2005-09-08 23:36:16 +01:00
do {
ncall = a - > calls ;
if ( ncall = = NULL ) break ;
while ( ncall ! = NULL ) {
o = ncall - > call ;
if ( o ! = NULL ) break ;
ncall = ncall - > next ;
}
if ( ncall = = NULL ) break ;
a = o - > alternatives - > alternative ;
2006-03-24 16:19:31 +00:00
if ( a = = NULL ) { beam_OBX = o ; return ( a ) ; }
2005-09-08 23:36:16 +01:00
} while ( 1 ) ;
return a ;
}
INLINE unsigned int index_of_hash_table_atom ( Cell c , int nr )
{
return ( ( ( unsigned long ) c > > 3 ) % nr ) ;
}
INLINE unsigned int index_of_hash_table_appl ( Cell c , int nr )
{
return ( ( ( unsigned long ) c > > 5 ) % nr ) ;
}
/************************************************************************\
* Unification routines *
\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
void trail ( struct AND_BOX * andbox , struct PERM_VAR * v )
{
register struct EXTERNAL_VAR * e ;
int var_level ;
if ( ! is_perm_var ( ( Cell * ) v ) ) return ;
var_level = ( v - > home ) - > level ;
if ( var_level > = andbox - > level ) { /* Don't Need to Trail */
waking_boxes_suspended_on_var ( v ) ; /* Really Not Needed, just to speedup avoiding forks */
if ( isvar ( v - > value ) ) { /* CUIDADO posso ter de fazer deref primeiro */
change_from_to ( v , ( struct PERM_VAR * ) * ( ( Cell * ) v - > value ) ) ;
}
return ;
}
# if Debug
printf ( " Trailing var 0x%lX on ANDBOX 0x%lX \n " , ( unsigned long ) v , ( unsigned long ) andbox ) ;
# endif
e = ( struct EXTERNAL_VAR * ) request_memory ( EXTERNAL_VAR_SIZE ) ;
e - > next = andbox - > externals ;
andbox - > externals = e ;
e - > var = v ;
e - > value = v - > value ;
}
INLINE int deve_limpar_var ( struct EXTERNAL_VAR * e )
{
return ( e - > var - > value = = e - > value & & isvar ( e - > var ) ) ; /* ????? */
}
void limpa_trail ( struct AND_BOX * andbox )
{
struct EXTERNAL_VAR * e ;
Cell * l ;
if ( andbox = = NULL ) return ;
e = andbox - > externals ;
while ( e ! = NULL ) {
if ( deve_limpar_var ( e ) ) {
2005-10-19 12:31:57 +01:00
l = ( Cell * ) e - > var ;
2005-09-08 23:36:16 +01:00
* ( ( Cell * ) l ) = ( Cell ) l ;
}
e = e - > next ;
}
{ register struct status_and * ncall ;
ncall = andbox - > calls ;
while ( ncall ) {
register struct OR_BOX * o ;
o = ncall - > call ;
if ( o ! = NULL ) {
struct status_or * so ;
so = o - > alternatives ;
while ( so ! = NULL ) {
limpa_trail ( so - > alternative ) ;
so = so - > next ;
}
}
ncall = ncall - > next ;
}
}
}
INLINE void limpa_trail_orbox ( struct OR_BOX * orbox )
{
struct status_or * so ;
so = orbox - > alternatives ;
while ( so ! = NULL ) {
limpa_trail ( so - > alternative ) ;
so = so - > next ;
}
}
INLINE Cell deref ( Cell a )
{
register Cell * b ;
while ( isvar ( a ) ) {
b = ( Cell * ) a ;
a = * b ;
if ( a = = ( ( Cell ) b ) ) return a ;
}
return a ;
}
void UnifyCells ( Cell * a , Cell * b ) /* a e b variaveis */
{
if ( a = = b ) return ;
if ( is_perm_var ( a ) ) {
if ( is_perm_var ( b ) ) {
register int i , j ;
i = ( ( struct PERM_VAR * ) a ) - > home - > level ;
j = ( ( struct PERM_VAR * ) b ) - > home - > level ;
if ( i < j ) {
* b = ( Cell ) a ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) b ) ;
2005-09-08 23:36:16 +01:00
return ;
} else {
* a = ( Cell ) b ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) a ) ;
2005-09-08 23:36:16 +01:00
return ;
}
} else {
* b = ( Cell ) a ;
return ;
}
}
* a = ( Cell ) b ;
return ;
}
int Unify ( Cell * a , Cell * b )
{
a = ( Cell * ) deref ( ( Cell ) a ) ;
b = ( Cell * ) deref ( ( Cell ) b ) ;
if ( isvar ( a ) ) {
if ( isvar ( b ) ) {
UnifyCells ( a , b ) ;
return 1 ;
}
2006-03-24 16:19:31 +00:00
{ * a = ( Cell ) b ; trail ( beam_ABX , ( struct PERM_VAR * ) a ) ; }
2005-09-08 23:36:16 +01:00
return 1 ;
}
if ( isvar ( b ) ) {
2006-03-24 16:19:31 +00:00
{ * b = ( Cell ) a ; trail ( beam_ABX , ( struct PERM_VAR * ) b ) ; }
2005-09-08 23:36:16 +01:00
return 1 ;
}
if ( a = = b ) return 1 ;
if ( isappl ( a ) ) {
int arity ;
if ( ! isappl ( b ) ) return 0 ;
a = ( Cell * ) repappl ( a ) ;
b = ( Cell * ) repappl ( b ) ;
if ( * a ! = * b ) return 0 ;
arity = ( ( int ) ArityOfFunctor ( ( Functor ) * a ) ) ;
while ( arity ! = 0 ) {
if ( ! Unify ( ( Cell * ) a [ arity ] , ( Cell * ) b [ arity ] ) ) return 0 ;
- - arity ;
}
return 1 ;
}
if ( ispair ( a ) ) {
if ( ! ispair ( b ) ) return 0 ;
a = ( Cell * ) reppair ( a ) ;
b = ( Cell * ) reppair ( b ) ;
if ( ! Unify ( ( Cell * ) * a , ( Cell * ) * b ) ) return 0 ;
return Unify ( ( Cell * ) a [ 1 ] , ( Cell * ) b [ 1 ] ) ;
}
if ( a ! = b ) return 0 ;
return 1 ;
}
int verify_externals ( struct AND_BOX * andbox )
{
struct EXTERNAL_VAR * e , * prev ;
# if Debug
printf ( " Entering Verify Externals \n " ) ;
# endif
e = andbox - > externals ;
prev = NULL ;
while ( e ) {
Cell d ;
d = deref ( ( Cell ) e - > var ) ; /* e->var->value */
if ( ! isvar ( d ) ) { /* ja nao e' var */
if ( isvar ( e - > value ) ) {
struct PERM_VAR * old , * new ;
struct SUSPENSIONS_VAR * s ;
old = e - > var ;
new = ( struct PERM_VAR * ) e - > value ;
e - > var = new ;
e - > value = ( Cell ) old ;
remove_from_perm_var_suspensions ( old , andbox ) ;
s = ( struct SUSPENSIONS_VAR * ) request_memory ( SUSPENSIONS_VAR_SIZE ) ;
s - > and_box = andbox ;
s - > next = new - > suspensions ;
new - > suspensions = s ;
if ( e - > var - > home - > level = = andbox - > level ) { /* ja nao e' uma var externa */
e - > var - > value = e - > value ;
goto tudo_ok ;
}
prev = e ;
e = e - > next ;
continue ;
} else {
if ( Unify ( ( Cell * ) d , ( Cell * ) e - > value ) ) {
/* Preciso de ter cuidado pois podem ter sido criadas External Vars */
if ( prev = = NULL & & andbox - > externals ! = e ) {
prev = andbox - > externals ;
while ( prev - > next ! = e ) prev = prev - > next ;
}
goto tudo_ok ;
}
# if Debug
printf ( " Verify Externals Has failed \n " ) ;
# endif
return ( 0 ) ;
}
} else { /* ainda e' var */
if ( e - > var - > home - > level = = andbox - > level ) { /* ja nao e' uma var externa */
/* e->var->value=e->value; */
* ( ( Cell * ) d ) = e - > value ;
tudo_ok :
/* primeiro remover a andbox da lista de suspensoes da variavel */
remove_from_perm_var_suspensions ( e - > var , andbox ) ;
waking_boxes_suspended_on_var ( e - > var ) ;
/* remover a variavel da lista de externals */
if ( prev = = NULL ) { /* a var e' a primeira da lista */
andbox - > externals = e - > next ;
free_memory ( ( Cell * ) e , EXTERNAL_VAR_SIZE ) ;
e = andbox - > externals ;
continue ;
} else {
prev - > next = e - > next ;
free_memory ( ( Cell * ) e , EXTERNAL_VAR_SIZE ) ;
e = prev - > next ;
continue ;
}
}
}
prev = e ;
e = e - > next ;
}
if ( andbox - > externals = = NULL ) { /* Se ja nao ha external vars posso remover andbox da lista suspensions */
delfrom_suspensions_list ( andbox - > suspended ) ;
}
# if Debug
printf ( " Verify Externals Has ended with Sucess \n " ) ;
# endif
return ( 1 ) ; /* Means OK */
}
int exists_var_in ( Cell * c )
{
Cell * C , * OldC ;
OldC = ( Cell * ) deref ( ( Cell ) c ) ;
if ( isvar ( OldC ) ) {
return ( 1 ) ;
}
if ( isatom ( OldC ) ) {
return ( 0 ) ;
}
if ( ispair ( OldC ) ) {
C = ( Cell * ) reppair ( OldC ) ;
return ( exists_var_in ( C ) | | exists_var_in ( + + C ) ) ;
}
return ( 0 ) ;
}
/************************************************************************\
* Emulador de EAM *
\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
void give_solution_toyap ( void ) ;
void give_solution_toyap ( void ) {
struct PERM_VAR * l ;
2006-03-24 16:19:31 +00:00
l = beam_ABX - > perms ;
2005-09-08 23:36:16 +01:00
while ( l ) {
if ( l - > yapvar ) {
* TR = ( Cell ) l - > yapvar ;
TR + + ;
* ( l - > yapvar ) = l - > value ;
}
l = l - > next ;
}
}
void add_vars_to_listperms ( struct AND_BOX * a , Cell * arg ) ;
void add_vars_to_listperms ( struct AND_BOX * a , Cell * arg ) {
Cell * _DR ;
Cell * NewC ;
_DR = ( Cell * ) deref ( ( Cell ) arg ) ;
if ( isvar ( ( Cell * ) _DR ) & & ! is_perm_var ( _DR ) ) {
struct PERM_VAR * l ;
l = request_permVar ( a ) ;
l - > yapvar = _DR ;
* _DR = ( Cell ) l ;
}
if ( isappl ( _DR ) ) {
int i , arity ;
NewC = ( Cell * ) repappl ( _DR ) ;
arity = ( ( int ) ArityOfFunctor ( ( Functor ) * NewC ) ) ;
for ( i = 0 ; i < arity ; i + + ) {
NewC + + ;
add_vars_to_listperms ( a , NewC ) ;
}
}
if ( ispair ( _DR ) ) {
NewC = ( Cell * ) reppair ( _DR ) ;
add_vars_to_listperms ( a , NewC ) ;
NewC + + ;
add_vars_to_listperms ( a , NewC ) ;
NewC + + ;
}
/* <20> atomic, posso terminar */
}
PredEntry * prepare_args_torun ( void ) ;
PredEntry * prepare_args_torun ( void ) {
Cell * _DR ;
Prop pe ;
PredEntry * ppe ;
/* at this time, ARG1=call */
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( beam_X [ 1 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isatom ( _DR ) ) {
/* char *name = AtomOfTerm((Term) _DR)->StrOfAE; */
pe = PredPropByAtom ( AtomOfTerm ( ( Term ) _DR ) , CurrentModule ) ;
ppe = RepPredProp ( pe ) ;
return ( ppe ) ;
}
if ( isappl ( _DR ) ) {
/* char *name = (NameOfFunctor((Functor) *NewC))->StrOfAE; */
int i , arity ;
Functor f = FunctorOfTerm ( ( Term ) _DR ) ;
if ( IsBlobFunctor ( f ) ) {
Yap_Error ( TYPE_ERROR_CALLABLE , ( Term ) _DR , " call/1 " ) ;
return ( FALSE ) ;
}
pe = PredPropByFunc ( f , CurrentModule ) ;
ppe = RepPredProp ( pe ) ;
_DR = ( Cell * ) repappl ( _DR ) ;
arity = ArityOfFunctor ( f ) ;
for ( i = 1 ; i < = arity ; i + + ) {
_DR + + ;
2006-03-24 16:19:31 +00:00
beam_X [ i ] = ( Cell ) _DR ;
2005-09-08 23:36:16 +01:00
}
return ( ppe ) ;
}
return ( NULL ) ;
}
2006-03-24 16:19:31 +00:00
# if DIRECT_JUMP
# define execute_next() goto **((void **) beam_pc)
Cell * TABLE_OPS = NULL ;
2005-09-08 23:36:16 +01:00
# else
2006-03-24 16:19:31 +00:00
# define execute_next() goto *OpAddress[*beam_pc]
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
2005-09-08 23:36:16 +01:00
int eam_am ( PredEntry * initPred ) ;
int eam_am ( PredEntry * initPred )
{
2006-03-24 16:19:31 +00:00
static void * OpAddress [ ] = {
2005-09-08 23:36:16 +01:00
& & exit_eam ,
& & top_tree ,
& & scheduler ,
& & prepare_tries ,
& & prepare_calls ,
& & get_var_X ,
& & get_var_Y ,
& & get_val_X ,
& & get_val_Y ,
& & get_atom ,
& & get_list ,
& & get_struct ,
& & unify_void ,
& & unify_val_X ,
& & unify_val_Y ,
& & unify_var_X ,
& & unify_var_Y ,
& & unify_atom ,
& & unify_list ,
& & unify_last_list ,
& & unify_struct ,
& & unify_last_struct ,
& & unify_last_atom ,
& & unify_local_X ,
& & unify_local_Y ,
& & put_var_X ,
& & put_var_Y ,
& & put_val_X ,
& & put_val_Y ,
& & put_atom ,
& & put_list ,
& & put_struct ,
& & put_unsafe ,
& & put_var_P ,
& & write_void ,
& & write_var_X ,
& & write_var_Y ,
& & write_val_X ,
& & write_val_Y ,
& & write_atom ,
& & write_list ,
& & write_struct ,
& & write_last_list ,
& & write_last_struct ,
& & write_local_X ,
& & write_local_Y ,
& & write_var_P ,
& & pop ,
& & jump ,
& & proceed ,
& & call ,
& & safe_call ,
& & safe_call_unary ,
& & safe_call_binary ,
& & only_1_clause ,
& & try_me ,
& & retry_me ,
& & trust_me ,
& & do_nothing ,
& & direct_safe_call ,
& & direct_safe_call_unary ,
& & direct_safe_call_binary ,
& & skip_while_var ,
& & wait_while_var ,
& & force_wait ,
& & write_call ,
& & is_call ,
& & equal_call ,
& & cut ,
& & commit ,
& & fail ,
& & save_b_X ,
& & save_b_Y ,
& & comit_b_X ,
& & comit_b_Y ,
& & save_appl_X ,
& & save_appl_Y ,
& & save_pair_X ,
& & save_pair_Y ,
& & either ,
& & orelse ,
& & orlast ,
& & p_atom ,
& & p_atomic ,
& & p_equal ,
& & p_integer ,
& & p_nonvar ,
& & p_number ,
& & p_var ,
& & p_db_ref ,
& & p_primitive ,
& & p_cut_by ,
2013-02-13 15:06:06 +00:00
& & p_save_by ,
2005-09-08 23:36:16 +01:00
& & p_succ ,
& & p_predc ,
& & p_plus ,
& & p_minus ,
& & p_times ,
& & p_div ,
& & p_dif ,
& & p_eq ,
& & p_arg ,
& & p_functor
} ;
2006-04-12 18:26:14 +01:00
# if Debug
static int contador = 1 ;
# endif
2005-09-08 23:36:16 +01:00
Cell code2start [ ] = { _prepare_calls , 1 , 0 , _call_op , 0 , 0 } ;
2006-04-12 18:26:14 +01:00
2005-09-08 23:36:16 +01:00
if ( ( long ) initPred = = 2 ) { /* retry from call eam(goal) */
goto fail ;
} else if ( ( long ) initPred = = 1 ) { /* first time call eam(goal) */
initPred = prepare_args_torun ( ) ;
}
2006-03-24 16:19:31 +00:00
# if DIRECT_JUMP
else if ( ( long ) initPred = = 0 ) { /* first time call eam_am. Init TABLE_OPS */
TABLE_OPS = ( Cell * ) OpAddress ;
2006-04-08 15:56:48 +01:00
return ( FALSE ) ;
2006-03-24 16:19:31 +00:00
}
# endif
2005-09-08 23:36:16 +01:00
if ( initPred = = NULL | | initPred - > beamTable = = NULL ) return ( FALSE ) ;
# if DIRECT_JUMP
code2start [ 0 ] = ( Cell ) OpAddress [ _prepare_calls ] ;
code2start [ 3 ] = ( Cell ) OpAddress [ _call_op ] ;
# endif
code2start [ 2 ] = ( Cell ) & code2start [ 5 ] ;
code2start [ 4 ] = ( Cell ) initPred ;
printf ( " [ EAM execution started to solve %s/%d ] \n " ,
initPred - > beamTable - > name , initPred - > beamTable - > arity ) ;
initialize_memory_areas ( ) ;
2006-03-24 16:19:31 +00:00
beam_su = NULL ;
beam_OBX = NULL ;
beam_ABX = ( struct AND_BOX * ) request_memory ( ANDBOX_SIZE ) ;
beam_ABX - > parent = NULL ;
beam_ABX - > nr_alternative = NULL ;
beam_ABX - > nr_all_calls = 0 ;
beam_ABX - > perms = NULL ;
beam_ABX - > calls = NULL ;
beam_ABX - > level = 1 ;
beam_ABX - > externals = NULL ;
beam_ABX - > suspended = NULL ;
beam_ABX - > side_effects = 0 ;
beam_top = beam_ABX ;
2005-09-08 23:36:16 +01:00
if ( 1 ) { int i ; /* criar mais um nivel acima do top para o caso de haver variaveis na chamada */
2006-03-24 16:19:31 +00:00
beam_ABX - > nr_all_calls = 1 ;
beam_ABX - > calls = ( struct status_and * ) request_memory ( STATUS_AND_SIZE ) ;
beam_ABX - > calls - > locals = NULL ;
beam_ABX - > calls - > code = NULL ;
beam_ABX - > calls - > state = RUNNING ;
beam_ABX - > calls - > previous = NULL ;
beam_ABX - > calls - > next = NULL ;
beam_OBX = ( struct OR_BOX * ) request_memory ( ORBOX_SIZE ) ;
beam_ABX - > calls - > call = beam_OBX ;
beam_OBX - > nr_call = beam_ABX - > calls ;
beam_OBX - > parent = beam_ABX ;
beam_OBX - > nr_all_alternatives = 1 ;
beam_OBX - > eager_split = 0 ;
beam_OBX - > alternatives = ( struct status_or * ) request_memory ( STATUS_OR_SIZE ) ;
beam_OBX - > alternatives - > previous = NULL ;
beam_OBX - > alternatives - > next = NULL ;
beam_OBX - > alternatives - > args = NULL ;
beam_OBX - > alternatives - > code = NULL ;
beam_OBX - > alternatives - > state = RUNNING ;
beam_ABX = ( struct AND_BOX * ) request_memory ( ANDBOX_SIZE ) ;
beam_OBX - > alternatives - > alternative = beam_ABX ;
beam_ABX - > parent = beam_OBX ;
beam_ABX - > nr_alternative = beam_OBX - > alternatives ;
beam_ABX - > nr_all_calls = 0 ;
beam_ABX - > perms = NULL ;
beam_ABX - > calls = NULL ;
beam_ABX - > level = 2 ;
beam_ABX - > externals = NULL ;
beam_ABX - > suspended = NULL ;
beam_ABX - > side_effects = WRITE ;
2005-09-08 23:36:16 +01:00
2006-04-08 15:56:48 +01:00
for ( i = 1 ; i < = initPred - > beamTable - > arity ; i + + )
add_vars_to_listperms ( beam_ABX , ( Cell * ) beam_X [ i ] ) ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_pc = code2start ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
while ( 1 ) {
exit_eam :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->(%3d) exit_eam -> " , contador + + , ( int ) * beam_pc ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
wake :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Trying WAKE and_box on suspension \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( verify_externals ( beam_ABX ) = = 0 ) goto fail_verify_externals ;
if ( beam_ABX - > externals = = NULL ) {
beam_nr_call = beam_ABX - > calls ;
if ( beam_nr_alternative - > state & END ) {
2005-09-08 23:36:16 +01:00
goto success ;
}
2006-03-24 16:19:31 +00:00
beam_nr_alternative - > state = RUNAGAIN ;
2005-09-08 23:36:16 +01:00
goto next_call ;
}
2006-03-24 16:19:31 +00:00
beam_nr_alternative - > state = SUSPEND ;
2005-09-08 23:36:16 +01:00
/* must clear all external assignments */
2006-03-24 16:19:31 +00:00
limpa_trail ( beam_ABX ) ;
2005-09-08 23:36:16 +01:00
/* goto top_tree; */
top_tree :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->I'm on top of the Tree (maybe exit or look for suspended alternatives) \n " , contador + + ) ;
break_debug ( contador ) ;
break_top ( ) ;
2005-09-08 23:36:16 +01:00
# endif
# if GARBAGE_COLLECTOR
if ( HEAP_MEM_FULL ( ) ) garbage_collector ( ) ;
# endif
# if USE_LEFTMOST
2006-03-24 16:19:31 +00:00
if ( beam_su ! = NULL ) {
beam_ABX = beam_su - > and_box ;
beam_OBX = beam_ABX - > parent ;
beam_nr_alternative = beam_ABX - > nr_alternative ;
if ( beam_nr_alternative - > state & ( WAKE ) ) goto wake ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_ABX = choose_leftmost ( ) ;
if ( beam_ABX = = NULL ) { /* Must return to next_alternative in beam_OBX BECAUSE EAGER_SPLIT*/
beam_nr_alternative = beam_ABX - > nr_alternative ;
beam_ABX = beam_OBX - > parent ;
2005-09-08 23:36:16 +01:00
goto next_alternative ;
}
2006-03-24 16:19:31 +00:00
if ( beam_ABX ! = beam_top & & beam_ABX - > suspended ! = NULL ) {
2005-09-08 23:36:16 +01:00
# else
2006-03-24 16:19:31 +00:00
if ( beam_su ! = NULL ) { /* There are suspended alternatives */
beam_ABX = beam_su - > and_box ;
2005-09-08 23:36:16 +01:00
# endif
# if !Fast_go
2006-03-24 16:19:31 +00:00
if ( beam_ABX = = NULL | | beam_ABX - > parent = = NULL | | beam_ABX - > parent - > alternatives = = NULL ) abort_eam ( " Alternativa NULL NO TOP ????? " ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
beam_nr_alternative = beam_ABX - > nr_alternative ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > suspended - > reason = = VAR_SUSPENSION ) {
delfrom_suspensions_list ( beam_ABX - > suspended ) ;
beam_nr_call = beam_ABX - > calls ;
2005-09-08 23:36:16 +01:00
goto next_call ;
}
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > suspended - > reason ! = NORMAL_SUSPENSION ) {
if ( beam_ABX - > calls - > state = = WAITING_TO_BE_FIRST | |
( beam_ABX - > calls - > state & WAITING & & is_leftmost ( beam_ABX , 0 ) ) ) {
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
delfrom_suspensions_list ( beam_ABX - > suspended ) ;
beam_ABX - > calls - > state = READY ;
beam_nr_call = beam_ABX - > calls ;
2005-09-08 23:36:16 +01:00
goto next_call ;
}
# if !USE_LEFTMOST
2006-03-24 16:19:31 +00:00
beam_su = beam_su - > next ;
2005-09-08 23:36:16 +01:00
goto top_tree ;
# endif
}
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > nr_all_alternatives = = 1 & & beam_ABX - > level > beam_OBX - > parent - > level ) {
2005-09-08 23:36:16 +01:00
# if !Fast_go
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > parent - > parent = = NULL ) abort_eam ( " Null no top_tree " ) ;
2005-09-08 23:36:16 +01:00
# endif
goto unique_alternative ;
}
2006-03-24 16:19:31 +00:00
if ( beam_nr_alternative - > state & ( WAKE ) ) goto wake ;
if ( beam_OBX - > nr_all_alternatives > 1 ) {
2005-09-08 23:36:16 +01:00
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Trying Fork in suspended and_box \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
/* pickup the left most alternative instead */
split :
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
# if USE_SPLIT
2006-03-24 16:19:31 +00:00
do_forking_andbox ( beam_ABX ) ;
2005-09-08 23:36:16 +01:00
# else
abort_eam ( " ERROR: Split disable, cannot run non-deterministic programs... " ) ;
# endif
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
beam_nr_alternative = beam_ABX - > nr_alternative ;
2005-09-08 23:36:16 +01:00
goto unique_alternative ;
}
abort_eam ( " ERROR: exit on top, suspensions still available " ) ;
}
/* There is no suspension */
give_solution_toyap ( ) ;
return ( TRUE ) ;
exit_eam ( " \n Exit on top, there is no more work to do... \n " ) ;
proceed :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->proceed... \n " , contador + + ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_USE_SAME_ANDBOX ! = NULL ) { /* was only one alternative */
beam_USE_SAME_ANDBOX = NULL ;
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
2005-09-08 23:36:16 +01:00
goto next_call ;
}
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > externals ! = NULL ) {
beam_nr_alternative - > state = SUSPEND_END ;
2005-09-08 23:36:16 +01:00
goto suspend ;
}
success :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->SUCCESS for call %p in level %d \n " , contador + + , beam_nr_call , beam_ABX - > level ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
/* FOUND SOLUTION -> ALL_SOLUTIONS */
2006-03-24 16:19:31 +00:00
//if ((beam_ABX->side_effects & WRITE) && beam_OBX->nr_all_alternatives>1)
if ( beam_OBX - > parent = = beam_top ) {
2005-09-08 23:36:16 +01:00
give_solution_toyap ( ) ;
return ( TRUE ) ;
goto fail ;
}
2006-03-24 16:19:31 +00:00
beam_ABX = beam_OBX - > parent ;
beam_nr_call = beam_OBX - > nr_call ;
del_orbox_and_sons ( beam_OBX ) ;
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > externals ! = NULL ) {
if ( beam_ABX - > nr_all_calls = = 0 ) {
beam_nr_alternative - > state = SUSPEND_END ;
} else beam_nr_alternative - > state = SUSPEND ;
2005-09-08 23:36:16 +01:00
goto suspend ;
}
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > nr_all_calls = = 0 ) {
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
if ( beam_OBX = = NULL ) {
2005-09-08 23:36:16 +01:00
goto top_tree ;
}
2006-03-24 16:19:31 +00:00
beam_nr_alternative = beam_ABX - > nr_alternative ;
2005-09-08 23:36:16 +01:00
goto success ;
}
next_call :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Searching for a next call in and_box... \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
# if GARBAGE_COLLECTOR
if ( HEAP_MEM_FULL ( ) ) {
garbage_collector ( ) ;
}
# endif
{ register int nr ;
2006-03-24 16:19:31 +00:00
nr = beam_ABX - > nr_all_calls ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > externals ! = NULL & & beam_ABX - > side_effects < CUT ) {
if ( nr = = 0 ) beam_nr_alternative - > state = SUSPEND_END ;
2005-09-08 23:36:16 +01:00
else { /* if next call is a cut then execute it */
2006-03-24 16:19:31 +00:00
beam_pc = beam_ABX - > calls - > code ;
2005-09-08 23:36:16 +01:00
# if Debug
2006-03-24 16:19:31 +00:00
if ( * beam_pc = = _cut_op ) {
2005-09-08 23:36:16 +01:00
# else
2006-03-24 16:19:31 +00:00
if ( * beam_pc = = ( Cell ) & & cut ) {
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_nr_call = beam_ABX - > calls ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
2006-03-24 16:19:31 +00:00
beam_nr_alternative - > state = SUSPEND ;
2005-09-08 23:36:16 +01:00
}
goto suspend ;
}
if ( nr = = 0 ) {
goto success ;
}
# if !START_ON_NEXT
2006-03-24 16:19:31 +00:00
beam_nr_call = beam_ABX - > calls ;
2005-09-08 23:36:16 +01:00
# else
2006-03-24 16:19:31 +00:00
/* if (beam_ABX->parent==beam_OBX) beam_nr_call=beam_ABX->calls; else beam_nr_call=beam_OBX->nr_call->next; */
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
while ( beam_nr_call ! = NULL ) {
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
if ( beam_nr_call - > state & WAITING ) {
if ( beam_nr_call - > state = = WAITING_TO_BE_LEFTMOST ) {
if ( ! is_leftmost ( beam_ABX , beam_nr_call ) ) {
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , LEFTMOST_SUSPENSION ) ;
beam_nr_call = NULL ;
2005-09-08 23:36:16 +01:00
break ;
}
2006-03-24 16:19:31 +00:00
beam_nr_call - > state = READY ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
if ( beam_nr_call - > state = = WAITING_TO_BE_LEFTMOST_PARENT ) {
if ( ! is_leftmost ( beam_ABX - > parent - > parent , beam_ABX - > parent - > nr_call ) ) {
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , LEFTMOST_SUSPENSION ) ;
beam_nr_call = NULL ;
2005-09-08 23:36:16 +01:00
break ;
}
2006-03-24 16:19:31 +00:00
beam_nr_call - > state = READY ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
if ( beam_nr_call - > state = = WAITING_TO_BE_FIRST ) {
if ( beam_nr_call - > previous = = NULL ) {
2005-09-08 23:36:16 +01:00
# if Debug
2006-03-24 16:19:31 +00:00
printf ( " I can stop Waiting on call %p \n " , beam_nr_call ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
2005-09-08 23:36:16 +01:00
continue ;
}
# if Debug
2006-03-24 16:19:31 +00:00
printf ( " Force Waiting on call %p \n " , beam_nr_call ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_nr_call = NULL ;
2005-09-08 23:36:16 +01:00
break ;
}
}
2006-03-24 16:19:31 +00:00
if ( beam_nr_call - > state = = READY ) {
beam_varlocals = beam_nr_call - > locals ;
beam_pc = beam_nr_call - > code ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
2006-03-24 16:19:31 +00:00
beam_nr_call = beam_nr_call - > next ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
/* In case (beam_nr_call==nr) */
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
beam_nr_alternative = beam_ABX - > nr_alternative ;
if ( beam_ABX - > externals ! = NULL ) goto suspend ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
if ( beam_nr_alternative ! = NULL ) beam_nr_alternative = beam_nr_alternative - > next ;
2005-09-08 23:36:16 +01:00
goto next_alternative ;
}
fail_body :
fail_head :
fail :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->fail... \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
fail_verify_externals :
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > externals ! = NULL ) {
limpa_trail ( beam_ABX ) ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
beam_nr_alternative = beam_ABX - > nr_alternative ;
if ( beam_OBX = = NULL ) {
if ( beam_ABX = = beam_top ) return ( FALSE ) ;
abort_eam ( " ERROR -> beam_ABX->parent = NULL (em fail_verify_externals) ????? \n " ) ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_OBX - > nr_all_alternatives = beam_OBX - > nr_all_alternatives - 1 ;
if ( beam_nr_alternative - > next ! = NULL ) beam_nr_alternative - > next - > previous = beam_nr_alternative - > previous ;
if ( beam_nr_alternative - > previous ! = NULL ) beam_nr_alternative - > previous - > next = beam_nr_alternative - > next ;
else beam_OBX - > alternatives = beam_nr_alternative - > next ; /* apaguei o primeiro da lista */
2005-09-08 23:36:16 +01:00
{ register struct status_or * i ;
2006-03-24 16:19:31 +00:00
i = beam_nr_alternative ;
beam_nr_alternative = beam_nr_alternative - > next ;
2005-09-08 23:36:16 +01:00
free_memory ( ( Cell * ) i , STATUS_OR_SIZE ) ;
2006-03-24 16:19:31 +00:00
del_andbox_and_sons ( beam_ABX ) ;
2005-09-08 23:36:16 +01:00
} /* verificar se existe ainda alguma alternativa viavel nesta or_box */
next_alternative :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Searching for a next alternative in or_box... \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
# if GARBAGE_COLLECTOR
if ( HEAP_MEM_FULL ( ) ) garbage_collector ( ) ;
# endif
2006-03-24 16:19:31 +00:00
if ( beam_OBX = = NULL ) {
2005-09-08 23:36:16 +01:00
# if !Fast_go
2006-03-24 16:19:31 +00:00
if ( beam_ABX ! = beam_top ) abort_eam ( " Erro no next_Alternative " ) ;
2005-09-08 23:36:16 +01:00
# endif
goto top_tree ;
}
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > nr_all_alternatives = = 0 ) {
beam_ABX = beam_OBX - > parent ;
2005-09-08 23:36:16 +01:00
goto fail ;
}
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > nr_all_alternatives = = 1 & & beam_ABX - > level > beam_OBX - > parent - > level ) {
beam_nr_alternative = beam_OBX - > alternatives ;
beam_ABX = beam_OBX - > alternatives - > alternative ;
if ( beam_ABX = = NULL ) {
beam_pc = beam_OBX - > alternatives - > code ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > parent - > parent = = NULL ) goto top_tree ;
2005-09-08 23:36:16 +01:00
goto unique_alternative ;
}
# if !START_ON_NEXT
2006-03-24 16:19:31 +00:00
beam_nr_alternative = beam_OBX - > alternatives ;
2005-09-08 23:36:16 +01:00
# else
2006-03-24 16:19:31 +00:00
/* if (beam_OBX->parent==beam_ABX) beam_nr_alternative=beam_OBX->alternatives;
else { if ( beam_nr_alternative ! = NULL ) beam_nr_alternative = beam_nr_alternative - > next ; } */
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
while ( beam_nr_alternative ! = NULL ) {
if ( beam_nr_alternative - > state & ( WAKE ) ) {
beam_ABX = beam_nr_alternative - > alternative ;
2005-09-08 23:36:16 +01:00
goto wake ;
}
2006-03-24 16:19:31 +00:00
if ( beam_nr_alternative - > state = = READY ) {
beam_pc = beam_nr_alternative - > code ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
2006-03-24 16:19:31 +00:00
beam_nr_alternative = beam_nr_alternative - > next ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
/* beam_nr_alternative==NULL -> No more alternatives */
beam_ABX = beam_OBX - > parent ;
beam_nr_call = beam_OBX - > nr_call - > next ;
2005-09-08 23:36:16 +01:00
goto next_call ;
unique_alternative :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Unique alternative, Does Promotion on and-box \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
# if GARBAGE_COLLECTOR
if ( HEAP_MEM_FULL ( ) ) garbage_collector ( ) ;
# endif
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > parent - > parent = = NULL ) {
2005-09-08 23:36:16 +01:00
goto top_tree ;
}
{ int nr_a ;
struct AND_BOX * a ;
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > side_effects > = CUT ) {
2005-09-08 23:36:16 +01:00
/* Cut -> Avoid doing the Promotion */
2006-03-24 16:19:31 +00:00
inc_level ( beam_ABX , beam_OBX - > parent - > level - beam_ABX - > level ) ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
delfrom_suspensions_list ( beam_ABX - > suspended ) ;
if ( verify_externals ( beam_ABX ) = = 0 ) goto fail_verify_externals ;
beam_nr_alternative = beam_ABX - > nr_alternative ;
if ( beam_ABX - > externals = = NULL ) {
beam_nr_call = beam_ABX - > calls ;
2005-09-08 23:36:16 +01:00
goto next_call ;
}
2006-03-24 16:19:31 +00:00
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , NORMAL_SUSPENSION ) ;
beam_nr_alternative - > state = SUSPEND ;
beam_nr_alternative = beam_nr_alternative - > next ;
2005-09-08 23:36:16 +01:00
goto next_alternative ;
}
2006-03-24 16:19:31 +00:00
a = beam_ABX ;
beam_ABX = beam_OBX - > parent ;
2005-09-08 23:36:16 +01:00
nr_a = a - > nr_all_calls ;
2006-03-24 16:19:31 +00:00
beam_nr_call = beam_OBX - > nr_call ;
beam_ABX - > side_effects + = a - > side_effects ;
2005-09-08 23:36:16 +01:00
if ( nr_a = = 0 ) { /* Means SUSPENDED ON END */
2006-03-24 16:19:31 +00:00
beam_nr_call - > call = NULL ;
beam_nr_call - > state = SUCCESS ;
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
2005-09-08 23:36:16 +01:00
} else { /* IF nr_all_calls==1 can be optimized ????? */
if ( nr_a = = 1 ) {
if ( a - > calls - > call ! = NULL ) {
2006-03-24 16:19:31 +00:00
a - > calls - > call - > nr_call = beam_nr_call ;
a - > calls - > call - > parent = beam_ABX ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_nr_call - > call = a - > calls - > call ;
beam_nr_call - > locals = a - > calls - > locals ;
beam_nr_call - > code = a - > calls - > code ;
beam_nr_call - > state = a - > calls - > state ;
2005-09-08 23:36:16 +01:00
free_memory ( ( Cell * ) a - > calls , STATUS_AND_SIZE ) ;
} else {
struct status_and * first , * last ;
int nr ;
2006-03-24 16:19:31 +00:00
nr = beam_ABX - > nr_all_calls ;
2005-09-08 23:36:16 +01:00
first = a - > calls ;
last = a - > calls ;
while ( 1 ) {
if ( last - > call ! = NULL ) {
2006-03-24 16:19:31 +00:00
last - > call - > parent = beam_ABX ;
2005-09-08 23:36:16 +01:00
}
if ( last - > next = = NULL ) break ;
last = last - > next ;
}
2006-03-24 16:19:31 +00:00
last - > next = beam_nr_call - > next ;
if ( beam_nr_call - > next ! = NULL ) beam_nr_call - > next - > previous = last ;
first - > previous = beam_nr_call - > previous ;
if ( beam_nr_call - > previous ! = NULL ) beam_nr_call - > previous - > next = first ;
else beam_ABX - > calls = first ; /* nr_call era o primeiro */
free_memory ( ( Cell * ) beam_nr_call , STATUS_AND_SIZE ) ;
beam_nr_call = first ;
beam_ABX - > nr_all_calls = nr + nr_a - 1 ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
/* Set local vars from a to point to new and_box beam_ABX */
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
move_perm_vars ( a , beam_ABX ) ;
2005-09-08 23:36:16 +01:00
/* change local vars suspensions to point to new andbox */
{ struct EXTERNAL_VAR * end , * e ;
e = a - > externals ;
end = NULL ;
while ( e ! = NULL ) {
struct SUSPENSIONS_VAR * s ;
s = e - > var - > suspensions ;
while ( s ! = NULL ) {
2006-03-24 16:19:31 +00:00
if ( s - > and_box = = a ) { s - > and_box = beam_ABX ; break ; }
2005-09-08 23:36:16 +01:00
s = s - > next ;
}
end = e ;
e = e - > next ;
}
/* Clear bindings made on externals so that we are able to
run the verify externals */
2006-03-24 16:19:31 +00:00
e = beam_ABX - > externals ;
2005-09-08 23:36:16 +01:00
while ( e ! = NULL ) {
struct PERM_VAR * v ;
v = e - > var ;
* ( ( Cell * ) v ) = ( Cell ) v ;
e = e - > next ;
}
if ( end ! = NULL ) {
2006-03-24 16:19:31 +00:00
end - > next = beam_ABX - > externals ;
beam_ABX - > externals = a - > externals ;
2005-09-08 23:36:16 +01:00
}
delfrom_suspensions_list ( a - > suspended ) ; /* remove suspensions */
free_memory ( ( Cell * ) a , ANDBOX_SIZE ) ;
2006-03-24 16:19:31 +00:00
free_memory ( ( Cell * ) beam_OBX - > alternatives , STATUS_OR_SIZE ) ;
free_memory ( ( Cell * ) beam_OBX , ORBOX_SIZE ) ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
if ( verify_externals ( beam_ABX ) = = 0 ) goto fail_verify_externals ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_nr_alternative = beam_ABX - > nr_alternative ;
if ( beam_ABX - > externals = = NULL ) {
beam_nr_call = beam_ABX - > calls ;
2005-09-08 23:36:16 +01:00
goto next_call ;
}
2006-03-24 16:19:31 +00:00
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , NORMAL_SUSPENSION ) ;
beam_nr_alternative - > state = SUSPEND ;
beam_nr_alternative = beam_nr_alternative - > next ;
2005-09-08 23:36:16 +01:00
goto next_alternative ;
}
2006-03-24 16:19:31 +00:00
abort_eam ( " cheguei aqui para tentar executar o prepare_tries antigo... \n " ) ;
2005-09-08 23:36:16 +01:00
prepare_tries :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->prepare_tries for %d clauses with arity=%d \n " , contador + + , ( int ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
if ( ! arg1 ) goto fail ;
2006-03-24 16:19:31 +00:00
{ register int nr ;
2005-09-08 23:36:16 +01:00
nr = arg1 ;
2006-03-24 16:19:31 +00:00
if ( nr = = 1 & & beam_ABX - > parent ! = NULL ) {
beam_ES = 0 ;
beam_nr_call - > state = RUNNING ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
/* execute_next(); */
goto only_1_clause ;
}
2006-03-24 16:19:31 +00:00
beam_OBX = ( struct OR_BOX * ) request_memory ( ORBOX_SIZE ) ;
beam_nr_call - > call = beam_OBX ;
beam_nr_call - > state = RUNNING ;
beam_OBX - > nr_call = beam_nr_call ;
beam_OBX - > parent = beam_ABX ;
beam_OBX - > eager_split = beam_ES ;
beam_ES = 0 ;
beam_OBX - > nr_all_alternatives = nr ;
2005-09-08 23:36:16 +01:00
{ register int i ;
register struct status_or * p = NULL ;
register Cell * a ;
if ( nr > 1 ) a = save_arguments ( arg2 ) ; else a = NULL ;
2006-03-24 16:19:31 +00:00
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
for ( i = 0 ; i < nr ; i + + ) {
2006-03-24 16:19:31 +00:00
beam_nr_alternative = ( struct status_or * ) request_memory ( STATUS_OR_SIZE ) ;
if ( i = = 0 ) beam_OBX - > alternatives = beam_nr_alternative ; else p - > next = beam_nr_alternative ;
beam_nr_alternative - > previous = p ;
p = beam_nr_alternative ;
beam_nr_alternative - > alternative = NULL ;
beam_nr_alternative - > code = beam_pc ;
beam_nr_alternative - > state = READY ;
beam_nr_alternative - > args = a ;
beam_pc + = 5 ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_nr_alternative - > next = NULL ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
}
beam_nr_alternative = beam_OBX - > alternatives ;
2005-09-08 23:36:16 +01:00
/* goto next_alternative; */
2006-03-24 16:19:31 +00:00
beam_pc = beam_nr_alternative - > code ;
2005-09-08 23:36:16 +01:00
goto try_me ;
execute_next ( ) ;
/* explore_alternative */
trust_me :
2006-03-24 16:19:31 +00:00
get_arguments ( arg2 , beam_nr_alternative - > args ) ;
remove_memory_arguments ( beam_nr_alternative - > args ) ;
2005-09-08 23:36:16 +01:00
goto try_me ;
retry_me :
2006-03-24 16:19:31 +00:00
get_arguments ( arg2 , beam_nr_alternative - > args ) ;
2005-09-08 23:36:16 +01:00
try_me :
2006-03-24 16:19:31 +00:00
beam_nr_alternative - > args = NULL ;
2005-09-08 23:36:16 +01:00
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Create AND_BOX for the %dth clause of predicate %s/%d (Yvars=%d) \n " , contador + + , ( int ) arg4 , ( ( struct Clauses * ) arg1 ) - > predi - > name , ( int ) arg2 , ( int ) arg3 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > nr_all_alternatives > 1 | | beam_OBX - > parent - > parent = = NULL ) {
beam_USE_SAME_ANDBOX = NULL ;
beam_ABX = ( struct AND_BOX * ) request_memory ( ANDBOX_SIZE ) ;
beam_nr_alternative - > alternative = beam_ABX ;
beam_nr_alternative - > state = RUNNING ;
beam_ABX - > nr_alternative = beam_nr_alternative ;
beam_ABX - > level = beam_OBX - > parent - > level + 1 ;
beam_ABX - > parent = beam_OBX ;
beam_ABX - > externals = NULL ;
beam_ABX - > suspended = NULL ;
beam_ABX - > perms = NULL ;
beam_ABX - > calls = NULL ;
beam_ABX - > nr_all_calls = 0 ;
beam_ABX - > side_effects = ( ( struct Clauses * ) arg1 ) - > side_effects ;
2005-09-08 23:36:16 +01:00
/* continue on middle of only_1_clause code */
} else {
2006-03-24 16:19:31 +00:00
beam_nr_call = beam_OBX - > nr_call ;
beam_ABX = beam_OBX - > parent ;
del_orbox_and_sons ( beam_OBX ) ;
beam_nr_call - > call = NULL ;
2005-09-08 23:36:16 +01:00
/* continue to only 1 clause */
only_1_clause :
# if Debug
printf ( " Only 1 Clause -> Use the same AND_BOX for the %dth clause of predicate %s/%d (Yvars=%d) \n " , ( int ) arg4 , ( ( struct Clauses * ) arg1 ) - > predi - > name , ( int ) arg2 , ( int ) arg3 ) ;
# endif
if ( ( ( struct Clauses * ) arg1 ) - > side_effects > = CUT ) {
/* printf("Must create or-box still the same ?????\n"); MUST SEE THIS CASE */
}
2006-03-24 16:19:31 +00:00
beam_USE_SAME_ANDBOX = beam_nr_call ;
beam_nr_alternative = beam_ABX - > nr_alternative ;
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
}
if ( arg3 ) {
register int nr_locals ;
nr_locals = arg3 ;
/* nr_locals=((struct Clauses *)arg1)->nr_vars; */
2006-03-24 16:19:31 +00:00
beam_varlocals = request_memory_locals ( nr_locals ) ;
// add_to_list_locals(beam_varlocals,beam_ABX);
2005-09-08 23:36:16 +01:00
} else {
2006-03-24 16:19:31 +00:00
beam_varlocals = NULL ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_pc = ( ( struct Clauses * ) arg1 ) - > code + 5 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
prepare_calls :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->prepare_calls %d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_USE_SAME_ANDBOX ! = NULL ) { /* only one alternative */
2005-09-08 23:36:16 +01:00
register int nr ;
nr = ( int ) arg1 ;
2006-03-24 16:19:31 +00:00
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
if ( nr ) {
2006-03-24 16:19:31 +00:00
beam_nr_call = beam_USE_SAME_ANDBOX ;
2005-09-08 23:36:16 +01:00
if ( nr = = 1 ) { /* ONLY ONE CALL , CHANGE DIRECTLY */
2006-03-24 16:19:31 +00:00
beam_nr_call - > call = NULL ;
beam_nr_call - > code = beam_pc + 1 ;
beam_nr_call - > locals = beam_varlocals ;
beam_nr_call - > state = READY ;
2005-09-08 23:36:16 +01:00
} else {
struct status_and * calls , * first = NULL , * last = NULL ;
int i , nr2 ;
2006-03-24 16:19:31 +00:00
nr2 = beam_ABX - > nr_all_calls ;
2005-09-08 23:36:16 +01:00
for ( i = 0 ; i < nr ; i + + ) {
calls = ( struct status_and * ) request_memory ( STATUS_AND_SIZE ) ;
if ( first = = NULL ) first = calls ;
if ( last ! = NULL ) last - > next = calls ;
calls - > previous = last ;
calls - > call = NULL ;
2006-03-24 16:19:31 +00:00
calls - > code = beam_pc + 1 ;
calls - > locals = beam_varlocals ;
2005-09-08 23:36:16 +01:00
calls - > state = READY ;
2006-03-24 16:19:31 +00:00
beam_pc = ( Cell * ) * beam_pc ;
2005-09-08 23:36:16 +01:00
last = calls ;
}
2006-03-24 16:19:31 +00:00
last - > next = beam_nr_call - > next ;
if ( beam_nr_call - > next ! = NULL ) beam_nr_call - > next - > previous = last ;
first - > previous = beam_nr_call - > previous ;
if ( beam_nr_call - > previous ! = NULL ) beam_nr_call - > previous - > next = first ;
else beam_ABX - > calls = first ; /* nr_call era o primeiro */
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
free_memory ( ( Cell * ) beam_nr_call , STATUS_AND_SIZE ) ;
beam_nr_call = first ;
beam_ABX - > nr_all_calls = nr + nr2 - 1 ;
2005-09-08 23:36:16 +01:00
}
} else {
2006-03-24 16:19:31 +00:00
beam_nr_call - > call = NULL ;
2005-09-08 23:36:16 +01:00
}
} else
{ /* there where more than one alternative */
register int nr ;
nr = ( int ) arg1 ;
2006-03-24 16:19:31 +00:00
beam_pc + = 2 ;
beam_ABX - > nr_all_calls = nr ;
2005-09-08 23:36:16 +01:00
if ( nr ) {
struct status_and * calls , * first = NULL , * last = NULL ;
register int i ;
for ( i = 0 ; i < nr ; i + + ) {
calls = ( struct status_and * ) request_memory ( STATUS_AND_SIZE ) ;
if ( first = = NULL ) first = calls ;
if ( last ! = NULL ) last - > next = calls ;
calls - > previous = last ;
calls - > call = NULL ;
2006-03-24 16:19:31 +00:00
calls - > code = beam_pc + 1 ;
calls - > locals = beam_varlocals ;
2005-09-08 23:36:16 +01:00
calls - > state = READY ;
2006-03-24 16:19:31 +00:00
beam_pc = ( Cell * ) * beam_pc ;
2005-09-08 23:36:16 +01:00
last = calls ;
}
last - > next = NULL ;
2006-03-24 16:19:31 +00:00
beam_ABX - > calls = first ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
} else beam_ABX - > calls = NULL ;
beam_nr_call = beam_ABX - > calls ;
2005-09-08 23:36:16 +01:00
}
/* goto scheduler;*/
scheduler :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Scheduler... \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
# if Debug_Dump_State
2005-09-08 23:36:16 +01:00
dump_eam_state ( ) ;
# endif
/* Have to decide if I go up or continue on same level */
/* If I go up the I have to suspend the and_box,
else I can continue to the next clause ( 1 st ) of the and_box
Another Alternative is to pick up a SUSPEND and_box */
/* for the meantime I Will always suspend unless there is a cut */
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > externals = = NULL | | beam_ABX - > side_effects > = CUT ) {
beam_pc = beam_nr_call - > code ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
2006-03-24 16:19:31 +00:00
beam_nr_alternative - > state = SUSPEND ;
2005-09-08 23:36:16 +01:00
/* goto suspend; */
suspend :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->SUSPEND on alternative %p \n " , contador + + , beam_nr_alternative ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
{ struct EXTERNAL_VAR * e ;
struct PERM_VAR * v ;
struct SUSPENSIONS_VAR * s ;
2006-03-24 16:19:31 +00:00
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , NORMAL_SUSPENSION ) ;
e = beam_ABX - > externals ;
2005-09-08 23:36:16 +01:00
while ( e ! = NULL ) {
v = e - > var ;
* ( ( Cell * ) v ) = ( Cell ) v ;
2006-03-24 16:19:31 +00:00
if ( v - > suspensions = = NULL | | v - > suspensions - > and_box ! = beam_ABX ) {
2005-09-08 23:36:16 +01:00
/* se a and_box ja esta na lista nao adiciona */
s = ( struct SUSPENSIONS_VAR * ) request_memory ( SUSPENSIONS_VAR_SIZE ) ;
2006-03-24 16:19:31 +00:00
s - > and_box = beam_ABX ;
2005-09-08 23:36:16 +01:00
s - > next = v - > suspensions ;
v - > suspensions = s ;
}
e = e - > next ;
}
}
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > eager_split ) goto split ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
beam_nr_alternative = beam_nr_alternative - > next ;
2005-09-08 23:36:16 +01:00
goto next_alternative ;
call_yap :
2006-03-24 16:19:31 +00:00
/* Must create term to call */
/* YAP_RunGoal(t_goal); */
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
if ( ! Yap_execute_goal ( beam_X [ 1 ] , 0 , CurrentModule ) ) goto success ;
2005-09-08 23:36:16 +01:00
else goto fail ;
2006-03-24 16:19:31 +00:00
2005-09-08 23:36:16 +01:00
call :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->call %s/%d \n " , contador + + , ( ( PredEntry * ) arg1 ) - > beamTable - > name , ( int ) ( ( PredEntry * ) arg1 ) - > beamTable - > arity ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_ES = ( ( PredEntry * ) arg1 ) - > beamTable - > eager_split ;
2005-09-08 23:36:16 +01:00
/* CUIDADO : vou tentar libertar a memoria caso seja o ultimo call */
# if DIRECT_JUMP
if ( ( void * ) arg3 = = & & exit_eam ) /* Estou no ultimo call deste predicado */
# else
if ( arg3 = = _exit_eam ) /* Estou no ultimo call deste predicado */
# endif
{
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > nr_all_calls = = 1 ) {
free_memory_locals ( beam_nr_call - > locals ) ;
2005-09-08 23:36:16 +01:00
} else {
struct status_and * calls ;
2006-03-24 16:19:31 +00:00
calls = beam_ABX - > calls ;
while ( calls ! = beam_nr_call ) {
if ( calls - > locals = = beam_nr_call - > locals ) break ;
2005-09-08 23:36:16 +01:00
calls = calls - > next ;
}
2006-03-24 16:19:31 +00:00
if ( calls = = beam_nr_call ) {
free_memory_locals ( beam_nr_call - > locals ) ;
2005-09-08 23:36:16 +01:00
}
}
}
2006-03-24 16:19:31 +00:00
beam_nr_call - > locals = NULL ;
bpEntry = ( PredEntry * ) arg1 ;
beam_ALTERNATIVES = beam_H ;
Yap_absmi ( - 9000 ) ;
{
int NR_INDEXED ;
NR_INDEXED = beam_ALTERNATIVES - beam_H ;
2005-09-08 23:36:16 +01:00
# if Debug
2006-03-24 16:19:31 +00:00
printf ( " Back from yap-index with %d alternativas \n " , NR_INDEXED ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( NR_INDEXED = = 0 ) goto fail ;
if ( NR_INDEXED = = 1 & & beam_ABX - > parent ! = NULL ) {
struct Clauses * clause = ( struct Clauses * ) * ( beam_H ) ;
beam_ES = 0 ;
beam_nr_call - > state = RUNNING ;
2005-09-08 23:36:16 +01:00
# if Debug
2006-03-24 16:19:31 +00:00
printf ( " Only 1 Alternative \n " ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( clause - > side_effects > = CUT ) {
/* printf("Must create or-box still the same ?????\n"); RSLOPES: MUST SEE THIS CASE */
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_USE_SAME_ANDBOX = beam_nr_call ;
beam_nr_alternative = beam_ABX - > nr_alternative ;
beam_OBX = beam_ABX - > parent ;
if ( clause - > nr_vars ) {
register int nr_locals ;
nr_locals = clause - > nr_vars ;
beam_varlocals = request_memory_locals ( nr_locals ) ;
// add_to_list_locals(beam_varlocals,beam_ABX);
} else {
beam_varlocals = NULL ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_pc = clause - > code + 5 ;
execute_next ( ) ;
} else {
int i , arity ;
2006-04-08 15:56:48 +01:00
struct status_or * p = NULL ;
Cell * a ;
2006-03-24 16:19:31 +00:00
arity = ( ( PredEntry * ) arg1 ) - > beamTable - > arity ;
beam_OBX = ( struct OR_BOX * ) request_memory ( ORBOX_SIZE ) ;
beam_nr_call - > call = beam_OBX ;
beam_nr_call - > state = RUNNING ;
beam_OBX - > nr_call = beam_nr_call ;
beam_OBX - > parent = beam_ABX ;
beam_OBX - > eager_split = beam_ES ;
beam_ES = 0 ;
beam_OBX - > nr_all_alternatives = NR_INDEXED ;
if ( NR_INDEXED > 1 ) a = save_arguments ( arity ) ; else a = NULL ;
for ( i = 0 ; i < NR_INDEXED ; i + + ) {
beam_nr_alternative = ( struct status_or * ) request_memory ( STATUS_OR_SIZE ) ;
if ( i = = 0 ) beam_OBX - > alternatives = beam_nr_alternative ; else p - > next = beam_nr_alternative ;
beam_nr_alternative - > previous = p ;
p = beam_nr_alternative ;
beam_nr_alternative - > alternative = NULL ;
beam_pc = ( ( struct Clauses * ) beam_H [ i ] ) - > code ;
# if DIRECT_JUMP
if ( i = = 0 ) {
if ( NR_INDEXED = = 1 ) * beam_pc = ( Cell ) & & only_1_clause ;
else * beam_pc = ( Cell ) & & try_me ;
} else if ( i = = NR_INDEXED - 1 ) * beam_pc = ( Cell ) & & trust_me ;
2006-04-08 15:56:48 +01:00
else * beam_pc = ( Cell ) & & retry_me ;
2006-03-24 16:19:31 +00:00
# else
if ( i = = 0 ) {
if ( NR_INDEXED = = 1 ) * beam_pc = _only_1_clause_op ;
else * beam_pc = _try_me_op ;
} else if ( i = = NR_INDEXED - 1 ) * beam_pc = _trust_me_op ;
2006-04-08 15:56:48 +01:00
else * beam_pc = _retry_me_op ;
2006-03-24 16:19:31 +00:00
# endif
arg2 = arity ;
arg1 = beam_H [ i ] ;
arg3 = ( ( struct Clauses * ) beam_H [ i ] ) - > nr_vars ;
arg4 = i ;
beam_nr_alternative - > code = beam_pc ;
beam_nr_alternative - > state = READY ;
beam_nr_alternative - > args = a ;
}
beam_nr_alternative - > next = NULL ;
beam_nr_alternative = beam_OBX - > alternatives ;
/* goto next_alternative; */
beam_pc = beam_nr_alternative - > code ;
execute_next ( ) ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
}
}
/* goto prepare_tries; */
2005-09-08 23:36:16 +01:00
safe_call :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->safe_call 0x%lX X1=%d (0x%lX) ,X2=%d (0x%lX) \n " , contador + + , ( unsigned long ) arg1 , ( int ) beam_X [ 1 ] , ( unsigned long ) beam_X [ 1 ] , ( int ) beam_X [ 2 ] , ( unsigned long ) beam_X [ 2 ] ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_S = ( Cell * ) arg1 ;
beam_S = ( Cell * ) ( * ( ( int long ( * ) ( void ) ) beam_S ) ) ( ) ;
if ( ! beam_S ) goto fail_body ;
2005-09-08 23:36:16 +01:00
/* we didn't get to created a or_box */
2006-03-24 16:19:31 +00:00
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
goto next_call ;
safe_call_unary :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->safe_call_unary 0x%lX X1=%d (0x%lX) ,X2=%d (0x%lX) \n " , contador + + , ( unsigned long ) arg1 , ( int ) beam_X [ 1 ] , ( unsigned long ) beam_X [ 1 ] , ( int ) beam_X [ 2 ] , ( unsigned long ) beam_X [ 2 ] ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_S = ( Cell * ) arg1 ;
beam_S = ( Cell * ) ( * ( ( int long ( * ) ( Term ) ) beam_S ) ) ( deref ( beam_X [ 1 ] ) ) ;
if ( ! beam_S ) goto fail_body ;
2005-09-08 23:36:16 +01:00
/* we didn't get to created a or_box */
2006-03-24 16:19:31 +00:00
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
goto next_call ;
safe_call_binary :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->safe_call_binary 0x%lX X1=%d (0x%lX) ,X2=%d (0x%lX) \n " , contador + + , ( unsigned long ) arg1 , ( int ) beam_X [ 1 ] , ( unsigned long ) beam_X [ 1 ] , ( int ) beam_X [ 2 ] , ( unsigned long ) beam_X [ 2 ] ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_S = ( Cell * ) arg1 ;
beam_S = ( Cell * ) ( * ( ( int long ( * ) ( Term , Term ) ) beam_S ) ) ( deref ( beam_X [ 1 ] ) , deref ( beam_X [ 2 ] ) ) ;
if ( ! beam_S ) goto fail_body ;
2005-09-08 23:36:16 +01:00
/* we didn't get to created a or_box */
2006-03-24 16:19:31 +00:00
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
goto next_call ;
direct_safe_call :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->direct_safe_call %p X1=%d,X2=%d \n " , contador + + , ( void * ) arg1 , ( int ) beam_X [ 1 ] , ( int ) beam_X [ 2 ] ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_S = ( Cell * ) arg1 ;
beam_S = ( Cell * ) ( * ( ( int long ( * ) ( void ) ) beam_S ) ) ( ) ;
/* beam_S=(Cell *) (* ((int long (*)(Term,Term)) beam_S))(beam_X[1],beam_X[2]); */
if ( ! beam_S ) goto fail_head ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
direct_safe_call_unary :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->direct_safe_call_unary %p X1=%d,X2=%d \n " , contador + + , ( void * ) arg1 , ( int ) beam_X [ 1 ] , ( int ) beam_X [ 2 ] ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_S = ( Cell * ) arg1 ;
beam_S = ( Cell * ) ( * ( ( int long ( * ) ( Term ) ) beam_S ) ) ( deref ( beam_X [ 1 ] ) ) ;
if ( ! beam_S ) goto fail_head ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
direct_safe_call_binary :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->direct_safe_call_binary %p X1=%d,X2=%d \n " , contador + + , ( void * ) arg1 , ( int ) beam_X [ 1 ] , ( int ) beam_X [ 2 ] ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_S = ( Cell * ) arg1 ;
beam_S = ( Cell * ) ( * ( ( int long ( * ) ( Term , Term ) ) beam_S ) ) ( deref ( beam_X [ 1 ] ) , deref ( beam_X [ 2 ] ) ) ;
if ( ! beam_S ) goto fail_head ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
skip_while_var :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Skip_while_var on call %p \n " , contador + + , beam_nr_call ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( exists_var_in ( ( Cell * ) beam_X [ 1 ] ) ) {
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , VAR_SUSPENSION ) ;
beam_nr_call = beam_nr_call - > next ;
2005-09-08 23:36:16 +01:00
goto next_call ;
}
2006-03-24 16:19:31 +00:00
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
wait_while_var :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Wait_while_var on call %p \n " , contador + + , beam_nr_call ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( exists_var_in ( ( Cell * ) beam_X [ 1 ] ) ) {
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , VAR_SUSPENSION ) ;
beam_OBX = beam_ABX - > parent ;
beam_nr_alternative = beam_ABX - > nr_alternative - > next ;
2005-09-08 23:36:16 +01:00
goto next_alternative ;
}
2006-03-24 16:19:31 +00:00
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
force_wait :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->Force Waiting on call %p \n " , contador + + , beam_nr_call ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
/* we didn't get to created a or_box */
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
if ( beam_nr_call - > previous ! = NULL ) {
beam_nr_call - > call = NULL ;
beam_nr_call - > state = WAITING_TO_BE_FIRST ;
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , WAIT_SUSPENSION ) ;
beam_nr_alternative = beam_ABX - > nr_alternative - > next ;
2005-09-08 23:36:16 +01:00
goto next_alternative ;
}
2006-03-24 16:19:31 +00:00
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
2005-09-08 23:36:16 +01:00
goto next_call ;
write_call :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_call \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
# if USE_LEFTMOST
2006-03-24 16:19:31 +00:00
if ( ! is_leftmost ( beam_ABX , beam_nr_call ) ) {
2005-09-08 23:36:16 +01:00
# if Debug
printf ( " Force Waiting Before write_call \n " ) ;
# endif
2006-03-24 16:19:31 +00:00
beam_nr_call - > call = NULL ;
beam_nr_call - > state = WAITING_TO_BE_LEFTMOST ;
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , LEFTMOST_SUSPENSION ) ;
2005-09-08 23:36:16 +01:00
goto top_tree ;
}
# endif
# ifdef DEBUG
2012-02-13 23:07:31 +00:00
Yap_plwrite ( ( Term ) beam_X [ 1 ] , NULL , 0 , 1200 ) ;
2005-09-08 23:36:16 +01:00
# else
extern int beam_write ( void ) ;
beam_write ( ) ;
# endif
2006-03-24 16:19:31 +00:00
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
beam_ABX - > side_effects = beam_ABX - > side_effects | WRITE ;
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
goto next_call ;
is_call :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->is_call \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{
Cell * _DR ;
/* BEAM_is is declared on C/eval.c */
_DR = ( Cell * ) BEAM_is ( ) ;
if ( _DR = = NULL ) { /* erro no Eval */
2006-03-24 16:19:31 +00:00
beam_top = NULL ;
2005-09-08 23:36:16 +01:00
return ( FALSE ) ;
}
2006-03-24 16:19:31 +00:00
if ( ! Unify ( ( Cell * ) beam_X [ 1 ] , _DR ) ) goto fail_body ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
goto next_call ;
equal_call :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->equal_call \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
if ( beam_ABX - > externals ! = NULL ) {
if ( beam_ABX - > nr_all_calls = = 0 ) {
beam_nr_alternative - > state = SUSPEND_END ;
} else beam_nr_alternative - > state = SUSPEND ;
2005-09-08 23:36:16 +01:00
goto suspend ;
}
goto next_call ;
pop :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->pop %d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
if ( arg1 > 1 ) {
2006-03-24 16:19:31 +00:00
beam_sp + = arg1 > > 2 ;
2005-09-08 23:36:16 +01:00
}
pop_mode_and_sreg ( ) ;
# if Debug
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) printf ( " Continues in READ mode \n " ) ;
2005-09-08 23:36:16 +01:00
else printf ( " Continues in WRITE mode \n " ) ;
# endif
2006-03-24 16:19:31 +00:00
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
do_nothing :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->do_nothing \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_pc + + ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
get_var_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->get_var_X X%d=X%d \n " , contador + + , ( int ) arg2 , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_X [ arg2 ] = beam_X [ arg1 ] ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
get_var_Y :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->get_var_Y Y%d=X%d \n " , contador + + , ( int ) arg2 , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_varlocals [ arg2 ] = beam_X [ arg1 ] ;
2005-09-08 23:36:16 +01:00
# if !Fast_go
{ Cell * a ;
2006-03-24 16:19:31 +00:00
a = ( Cell * ) deref ( beam_X [ arg1 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( a ) & & ! isappl ( a ) & & ! is_perm_var ( a ) )
abort_eam ( " S<EFBFBD> rio problema no get_var_Y \n " ) ;
/* acho que vou ter de criar uma variavel local nova no nivel superior */
}
# endif
2006-03-24 16:19:31 +00:00
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
get_val_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->get_val_X X%d,X%d \n " , contador + + , ( int ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( beam_X [ arg1 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) deref ( beam_X [ arg2 ] ) ;
2005-09-08 23:36:16 +01:00
if ( ! isvar ( ( Cell ) _DR1 ) ) {
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
2005-09-08 23:36:16 +01:00
} else {
UnifyCells ( _DR , _DR1 ) ;
}
} else {
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) deref ( beam_X [ arg2 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR1 ) ) {
* ( _DR1 ) = ( Cell ) _DR ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR1 ) ;
2005-09-08 23:36:16 +01:00
} else {
if ( ! Unify ( _DR1 , _DR ) ) goto fail_head ;
}
}
}
2006-03-24 16:19:31 +00:00
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
get_val_Y :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->get_val_Y X%d,Y%d \n " , contador + + , ( int ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( beam_X [ arg1 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) deref ( beam_varlocals [ arg2 ] ) ;
2005-09-08 23:36:16 +01:00
if ( ! isvar ( ( Cell ) _DR1 ) ) {
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
2005-09-08 23:36:16 +01:00
} else {
UnifyCells ( _DR , _DR1 ) ;
}
} else {
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) deref ( beam_varlocals [ arg2 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR1 ) ) {
* ( _DR1 ) = ( Cell ) _DR ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR1 ) ;
2005-09-08 23:36:16 +01:00
} else {
if ( ! Unify ( _DR1 , _DR ) ) goto fail_head ;
}
}
}
2006-03-24 16:19:31 +00:00
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
get_atom :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->get_atom X%d, 0x%lX \n " , contador + + , ( int ) arg1 , ( unsigned long ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( beam_X [ arg1 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
* ( _DR ) = arg2 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
2005-09-08 23:36:16 +01:00
} else {
if ( ( Cell ) _DR ! = arg2 ) goto fail_head ;
}
}
2006-03-24 16:19:31 +00:00
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
get_list :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->get_list X%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( beam_X [ arg1 ] ) ;
if ( isvar ( ( Cell ) _DR ) ) { beam_Mode = WRITE ;
beam_S = beam_H ;
beam_H + = 2 ;
_DR1 = ( Cell * ) abspair ( beam_S ) ;
2005-09-08 23:36:16 +01:00
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
if ( ! ispair ( ( Cell ) _DR ) ) goto fail_head ;
2006-03-24 16:19:31 +00:00
beam_Mode = READ ;
2005-09-08 23:36:16 +01:00
_DR1 = _DR ; /* SaveExpression in DR1*/
2006-03-24 16:19:31 +00:00
beam_S = ( Cell * ) reppair ( ( Cell ) _DR ) ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
}
get_struct :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->get_struct X%d, 0x%lX/%d \n " , contador + + , ( int ) arg1 , ( unsigned long ) arg2 , ( int ) arg3 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( beam_X [ arg1 ] ) ;
if ( isvar ( ( Cell ) _DR ) ) { beam_Mode = WRITE ;
_DR1 = ( Cell * ) absappl ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
2005-09-08 23:36:16 +01:00
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
* ( beam_H + + ) = arg2 ;
beam_S = beam_H ;
beam_H + = arg3 ; /* arg3 = arity */
beam_pc + = 4 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
if ( ! isappl ( ( Cell ) _DR ) ) goto fail_head ;
2006-03-24 16:19:31 +00:00
beam_Mode = READ ;
beam_S = ( Cell * ) repappl ( ( Cell ) _DR ) ;
if ( * beam_S ! = arg2 ) goto fail_head ;
beam_S + + ;
2005-09-08 23:36:16 +01:00
_DR1 = _DR ; /* SaveExpression in _DR1*/
2006-03-24 16:19:31 +00:00
beam_pc + = 4 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
}
unify_void :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_void \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = WRITE ) {
* beam_S = ( Cell ) request_permVar ( beam_ABX ) ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_S + + ;
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
unify_local_Y :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_local_Y Y%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
2005-09-08 23:36:16 +01:00
register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) deref ( beam_varlocals [ arg1 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR1 ) ) {
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( ( Cell ) beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
UnifyCells ( _DR1 , _DR ) ; /* var , var */
} else {
* ( _DR1 ) = ( Cell ) _DR ; /* var , nonvar */
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR1 ) ;
2005-09-08 23:36:16 +01:00
}
}
else {
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( ( Cell ) beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
* ( _DR ) = ( Cell ) _DR1 ; /* nonvar, var */
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
2005-09-08 23:36:16 +01:00
} else {
if ( ! Unify ( _DR , _DR1 ) ) goto fail_head ; /* nonvar, nonvar */
}
}
2006-03-24 16:19:31 +00:00
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else { /* write Mode */
register Cell * _DR ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( beam_varlocals [ arg1 ] ) ;
2005-10-09 22:13:57 +01:00
if ( isvar ( ( Cell ) _DR ) & & ! is_perm_var ( ( Cell * ) _DR ) ) {
2006-03-24 16:19:31 +00:00
* beam_S = ( Cell ) request_permVar ( beam_ABX ) ;
UnifyCells ( _DR , beam_S ) ;
2005-09-08 23:36:16 +01:00
} else {
2006-03-24 16:19:31 +00:00
* ( beam_S ) = ( Cell ) _DR ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_local_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_local_X X%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
2005-09-08 23:36:16 +01:00
register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) deref ( beam_X [ arg1 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR1 ) ) {
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( ( Cell ) beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
UnifyCells ( _DR1 , _DR ) ; /* var , var */
} else {
* ( _DR1 ) = ( Cell ) _DR ; /* var , nonvar */
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR1 ) ;
2005-09-08 23:36:16 +01:00
}
}
else {
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( ( Cell ) beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
* ( _DR ) = ( Cell ) _DR1 ; /* nonvar, var */
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
2005-09-08 23:36:16 +01:00
} else {
if ( ! Unify ( _DR , _DR1 ) ) goto fail_head ; /* nonvar, nonvar */
}
}
2006-03-24 16:19:31 +00:00
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else { /* write mode */
register Cell * _DR ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( beam_X [ arg1 ] ) ;
2005-09-08 23:36:16 +01:00
2005-10-09 22:13:57 +01:00
if ( isvar ( ( Cell ) _DR ) & & ! is_perm_var ( ( Cell * ) _DR ) ) {
2006-03-24 16:19:31 +00:00
* beam_S = ( Cell ) request_permVar ( beam_ABX ) ;
UnifyCells ( _DR , beam_S ) ;
2005-09-08 23:36:16 +01:00
} else {
2006-03-24 16:19:31 +00:00
* ( beam_S ) = ( Cell ) _DR ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_val_Y :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_val_Y Y%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
2005-09-08 23:36:16 +01:00
register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) deref ( beam_varlocals [ arg1 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR1 ) ) {
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( ( Cell ) beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
UnifyCells ( _DR1 , _DR ) ;
} else {
* ( _DR1 ) = ( Cell ) _DR ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR1 ) ;
2005-09-08 23:36:16 +01:00
}
}
else {
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( ( Cell ) beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
2005-09-08 23:36:16 +01:00
} else {
if ( ! Unify ( _DR , _DR1 ) ) goto fail_head ;
}
}
2006-03-24 16:19:31 +00:00
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else { /* write mode */
2006-03-24 16:19:31 +00:00
* ( beam_S ) = beam_varlocals [ arg1 ] ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_val_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_val_X X%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
2005-09-08 23:36:16 +01:00
register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) deref ( ( Cell ) beam_X [ arg1 ] ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR1 ) ) {
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( ( Cell ) beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
UnifyCells ( _DR1 , _DR ) ;
} else {
* ( _DR1 ) = ( Cell ) _DR ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR1 ) ;
2005-09-08 23:36:16 +01:00
}
}
else {
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( ( Cell ) beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
2005-09-08 23:36:16 +01:00
} else {
if ( ! Unify ( _DR , _DR1 ) ) goto fail_head ;
}
}
2006-03-24 16:19:31 +00:00
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
2006-03-24 16:19:31 +00:00
* ( beam_S ) = beam_X [ arg1 ] ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_var_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_var_X X%d=*S \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
beam_X [ arg1 ] = * ( beam_S + + ) ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
2006-03-24 16:19:31 +00:00
* beam_S = ( Cell ) request_permVar ( beam_ABX ) ;
beam_X [ arg1 ] = ( Cell ) beam_S ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_var_Y :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_var_Y Y%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
beam_varlocals [ arg1 ] = * ( beam_S + + ) ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
2006-03-24 16:19:31 +00:00
* beam_S = ( Cell ) request_permVar ( beam_ABX ) ;
beam_varlocals [ arg1 ] = * beam_S ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_last_atom :
unify_atom :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_atom 0x%lX \n " , contador + + , ( unsigned long ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
2005-09-08 23:36:16 +01:00
register Cell * _DR ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( ( Cell ) beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
* ( _DR ) = arg1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
2005-09-08 23:36:16 +01:00
} else {
if ( ( Cell ) _DR ! = arg1 ) goto fail_head ;
}
2006-03-24 16:19:31 +00:00
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
2006-03-24 16:19:31 +00:00
* ( beam_S ) = arg1 ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_list :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_list \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
2005-09-08 23:36:16 +01:00
register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( * beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) abspair ( ( Cell ) beam_H ) ; /* SavedExpression in _DR1 */
2005-09-08 23:36:16 +01:00
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
beam_S + + ;
2005-09-08 23:36:16 +01:00
push_mode_and_sreg ( ) ;
2006-03-24 16:19:31 +00:00
beam_Mode = WRITE ; /* goes int write mode */
beam_S = beam_H ;
beam_H + = 2 ;
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
if ( ! ispair ( ( Cell ) _DR ) ) goto fail_head ;
2006-03-24 16:19:31 +00:00
beam_S + + ;
2005-09-08 23:36:16 +01:00
push_mode_and_sreg ( ) ;
2006-03-24 16:19:31 +00:00
beam_S = ( Cell * ) reppair ( ( Cell ) _DR ) ;
2005-09-08 23:36:16 +01:00
_DR1 = _DR ; /* SavedExpression in _DR1 */
2006-03-24 16:19:31 +00:00
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
} else {
register Cell * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) abspair ( ( Cell ) beam_H ) ; /* SavedExpression in _DR1 */
* ( beam_S ) = ( Cell ) _DR1 ;
beam_S + + ;
2005-09-08 23:36:16 +01:00
push_mode_and_sreg ( ) ;
2006-03-24 16:19:31 +00:00
beam_S = beam_H ;
beam_H + = 2 ;
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_last_list :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_last_list \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
2005-09-08 23:36:16 +01:00
register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( * beam_S ) ;
if ( isvar ( ( Cell ) _DR ) ) { beam_Mode = WRITE ; /* goes into write mode */
_DR1 = ( Cell * ) abspair ( ( Cell ) beam_H ) ; /* SavedExpression in _DR1 */
2005-09-08 23:36:16 +01:00
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
beam_S = beam_H ;
beam_H + = 2 ;
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
if ( ! ispair ( ( Cell ) _DR ) ) goto fail_head ;
2006-03-24 16:19:31 +00:00
beam_S = ( Cell * ) reppair ( ( Cell ) _DR ) ;
2005-09-08 23:36:16 +01:00
_DR1 = _DR ; /* SavedExpression in _DR1 */
2006-03-24 16:19:31 +00:00
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
} else {
register Cell * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) abspair ( ( Cell ) beam_H ) ; /* SavedExpression in _DR1 */
* ( beam_S ) = ( Cell ) _DR1 ;
beam_S = beam_H ;
beam_H + = 2 ;
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_struct :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_struct 0x%lX,%d \n " , contador + + , ( unsigned long ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
2005-09-08 23:36:16 +01:00
register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( * beam_S ) ;
2005-09-08 23:36:16 +01:00
if ( isvar ( ( Cell ) _DR ) ) {
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) absappl ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
2005-09-08 23:36:16 +01:00
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
beam_S + + ;
2005-09-08 23:36:16 +01:00
push_mode_and_sreg ( ) ;
2006-03-24 16:19:31 +00:00
beam_Mode = WRITE ; /* goes into write mode */
* ( beam_H + + ) = arg1 ;
beam_S = beam_H ;
beam_H + = arg2 ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
if ( ! isappl ( ( Cell ) _DR ) ) goto fail_head ;
_DR1 = ( Cell * ) repappl ( ( Cell ) _DR ) ;
if ( * _DR1 ! = arg1 ) goto fail_head ;
2006-03-24 16:19:31 +00:00
+ + beam_S ;
2005-09-08 23:36:16 +01:00
push_mode_and_sreg ( ) ;
2006-03-24 16:19:31 +00:00
beam_S = + + _DR1 ;
2005-09-08 23:36:16 +01:00
_DR1 = _DR ; /* SaveExpression in _DR1*/
2006-03-24 16:19:31 +00:00
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
} else {
register Cell * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) absappl ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
* ( beam_S ) = ( Cell ) _DR1 ;
beam_S + + ;
2005-09-08 23:36:16 +01:00
push_mode_and_sreg ( ) ;
2006-03-24 16:19:31 +00:00
* ( beam_H + + ) = arg1 ;
beam_S = beam_H ;
beam_H + = arg2 ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
unify_last_struct :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->unify_last_struct 0x%lX, %d \n " , contador + + , ( unsigned long ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_Mode = = READ ) {
2005-09-08 23:36:16 +01:00
register Cell * _DR , * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR = ( Cell * ) deref ( * beam_S ) ;
if ( isvar ( ( Cell ) _DR ) ) { beam_Mode = WRITE ; /* goes into write mode */
_DR1 = ( Cell * ) absappl ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
2005-09-08 23:36:16 +01:00
* ( _DR ) = ( Cell ) _DR1 ;
2006-03-24 16:19:31 +00:00
trail ( beam_ABX , ( struct PERM_VAR * ) _DR ) ;
* ( beam_H + + ) = arg1 ;
beam_S = beam_H ;
beam_H + = arg2 ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
} else {
if ( ! isappl ( ( Cell ) _DR ) ) goto fail_head ;
_DR1 = ( Cell * ) repappl ( ( Cell ) _DR ) ;
if ( * _DR1 ! = arg1 ) goto fail_head ;
2006-03-24 16:19:31 +00:00
beam_S = + + _DR1 ;
2005-09-08 23:36:16 +01:00
_DR1 = _DR ; /* SaveExpression in _DR1*/
2006-03-24 16:19:31 +00:00
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
} else {
register Cell * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) absappl ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
* ( beam_S ) = ( Cell ) _DR1 ;
* ( beam_H + + ) = arg1 ;
beam_S = beam_H ;
beam_H + = arg2 ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
put_var_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->put_var_X X%d,X%d \n " , contador + + , ( int ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_X [ arg1 ] = ( Cell ) beam_H ;
beam_X [ arg2 ] = ( Cell ) beam_H ;
* ( beam_H ) = ( Cell ) beam_H ;
beam_H + + ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
put_val_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->put_val_X X%d,X%d \n " , contador + + , ( int ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_X [ arg1 ] = beam_X [ arg2 ] ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
put_var_P :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->put_var_P X%d,Y%d \n " , contador + + , ( int ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( isvar ( beam_varlocals [ arg2 ] ) & & ! is_perm_var ( ( Cell * ) beam_varlocals [ arg2 ] ) )
beam_varlocals [ arg2 ] = ( Cell ) request_permVar ( beam_ABX ) ;
beam_X [ arg1 ] = beam_varlocals [ arg2 ] ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
put_var_Y :
/*
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->put_var_Y X%d,Y%d \n " , contador + + , ( int ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * a ;
2006-03-24 16:19:31 +00:00
a = & ( beam_varlocals [ arg2 ] ) ;
2005-09-08 23:36:16 +01:00
* a = ( Cell ) a ;
2006-03-24 16:19:31 +00:00
beam_X [ arg1 ] = ( Cell ) a ; }
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
*/
put_val_Y :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->put_val_Y X%d,Y%d \n " , contador + + , ( int ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_X [ arg1 ] = beam_varlocals [ arg2 ] ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
put_unsafe :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->put_unsafe X%d, Y%d \n " , contador + + , ( int ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_X [ arg1 ] = beam_varlocals [ arg2 ] ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
put_atom :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->put_atom X%d, 0x%lX \n " , contador + + , ( int ) arg1 , ( unsigned long ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_X [ arg1 ] = arg2 ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
put_list :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->put_list X%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) abspair ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
beam_X [ arg1 ] = ( Cell ) _DR1 ;
beam_S = beam_H ;
beam_H + = 2 ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
put_struct :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->put_struct X%d, 0x%lX, %d \n " , contador + + , ( int ) arg1 , ( unsigned long ) arg2 , ( int ) arg3 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = absappl ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
beam_X [ arg1 ] = ( Cell ) _DR1 ;
* ( beam_H + + ) = arg2 ;
beam_S = beam_H ;
beam_H + = arg3 ;
beam_pc + = 4 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
write_var_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_var_X X%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
* beam_S = ( Cell ) request_permVar ( beam_ABX ) ;
beam_X [ arg1 ] = ( Cell ) beam_S ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
write_var_Y :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_var_Y Y%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ Cell * c ;
2006-03-24 16:19:31 +00:00
c = & beam_varlocals [ arg1 ] ;
2005-09-08 23:36:16 +01:00
* c = ( Cell ) c ;
2006-03-24 16:19:31 +00:00
* beam_S = ( Cell ) c ;
2005-09-08 23:36:16 +01:00
}
2006-03-24 16:19:31 +00:00
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
write_var_P :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_var_P Y%d \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( isvar ( beam_varlocals [ arg1 ] ) & & ! is_perm_var ( ( Cell * ) beam_varlocals [ arg1 ] ) )
beam_varlocals [ arg1 ] = ( Cell ) request_permVar ( beam_ABX ) ;
* ( beam_S ) = beam_varlocals [ arg1 ] ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
write_local_X :
write_val_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_val_X X%d (or write_local) \n " , contador + + , ( int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
* ( beam_S ) = beam_X [ arg1 ] ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
write_local_Y :
write_val_Y :
# if Debug
printf ( " write_val_Y Y%d (or write_local) \n " , ( int ) arg1 ) ;
# endif
2006-03-24 16:19:31 +00:00
* ( beam_S ) = beam_varlocals [ arg1 ] ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
write_void :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_void \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
* beam_S = ( Cell ) request_permVar ( beam_ABX ) ;
beam_S + + ;
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
write_atom :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_atom 0x%lX \n " , contador + + , ( unsigned long ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
* ( beam_S ) = arg1 ;
beam_S + + ;
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
write_list :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_list \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) abspair ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
* ( beam_S + + ) = ( Cell ) _DR1 ;
2005-09-08 23:36:16 +01:00
push_mode_and_sreg ( ) ;
2006-03-24 16:19:31 +00:00
beam_S = beam_H ;
beam_H + = 2 ;
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
write_last_list :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_last_list \n " , contador + + ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) abspair ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
* ( beam_S ) = ( Cell ) _DR1 ;
beam_S = beam_H ;
beam_H + = 2 ;
beam_pc + = 1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
write_struct :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_struct 0x%lX, %d \n " , contador + + , ( unsigned long ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) absappl ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
* ( beam_S + + ) = ( Cell ) _DR1 ;
2005-09-08 23:36:16 +01:00
push_mode_and_sreg ( ) ;
2006-03-24 16:19:31 +00:00
* ( beam_H + + ) = arg1 ;
beam_S = beam_H ;
beam_H + = arg2 ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
write_last_struct :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->write_last_struct 0x%lX, %d \n " , contador + + , ( unsigned long ) arg1 , ( int ) arg2 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
{ register Cell * _DR1 ;
2006-03-24 16:19:31 +00:00
_DR1 = ( Cell * ) absappl ( ( Cell ) beam_H ) ; /* SaveExpression in _DR1*/
* ( beam_S ) = ( Cell ) _DR1 ;
* ( beam_H + + ) = arg1 ;
beam_S = beam_H ;
beam_H + = arg2 ;
beam_pc + = 3 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
}
cut :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->cut na alternativa %p<> de %d \n " , contador + + , beam_ABX - > nr_alternative , beam_ABX - > parent - > nr_all_alternatives ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
{
struct status_or * new ;
2006-03-24 16:19:31 +00:00
if ( ! is_leftmost ( beam_ABX , beam_nr_call ) ) {
2005-09-08 23:36:16 +01:00
# if Debug
printf ( " Force Waiting Before Cut \n " ) ;
# endif
2006-03-24 16:19:31 +00:00
beam_nr_call - > call = NULL ;
beam_nr_call - > state = WAITING_TO_BE_LEFTMOST ;
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , LEFTMOST_SUSPENSION ) ;
beam_nr_call = beam_nr_call - > next ;
2005-09-08 23:36:16 +01:00
goto next_call ;
}
2006-03-24 16:19:31 +00:00
beam_ABX - > side_effects - = CUT ;
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
2005-09-08 23:36:16 +01:00
# if Debug
printf ( " Executando o cut \n " ) ;
2006-03-24 16:19:31 +00:00
if ( beam_ABX - > externals ! = NULL & & beam_OBX - > nr_all_alternatives > 1 ) printf ( " cut com externals (noisy) \n " ) ;
if ( beam_ABX - > externals ! = NULL & & beam_OBX - > nr_all_alternatives = = 1 ) printf ( " cut com externals (degenerate) \n " ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_nr_alternative = beam_ABX - > nr_alternative ;
new = beam_nr_alternative - > next ;
beam_nr_alternative - > next = NULL ;
2005-09-08 23:36:16 +01:00
if ( new ! = NULL ) {
do {
struct status_or * old ;
old = new ;
new = new - > next ;
del_andbox_and_sons ( old - > alternative ) ;
if ( new = = NULL ) remove_memory_arguments ( old - > args ) ;
free_memory ( ( Cell * ) old , STATUS_OR_SIZE ) ;
2006-03-24 16:19:31 +00:00
beam_OBX - > nr_all_alternatives - - ;
2005-09-08 23:36:16 +01:00
} while ( new ! = NULL ) ;
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > nr_all_alternatives = = 1 ) {
beam_nr_alternative = beam_OBX - > alternatives ;
2005-09-08 23:36:16 +01:00
goto unique_alternative ;
}
}
goto next_call ;
}
commit :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->commit na alternativa %p<> de %d \n " , contador + + , beam_ABX - > nr_alternative , beam_ABX - > parent - > nr_all_alternatives ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_OBX = beam_ABX - > parent ;
2005-09-08 23:36:16 +01:00
{
struct status_or * new ;
2006-03-24 16:19:31 +00:00
if ( ! is_leftmost ( beam_OBX - > parent , beam_OBX - > nr_call ) ) {
2005-09-08 23:36:16 +01:00
# if Debug
printf ( " Force Waiting Before Commit \n " ) ;
# endif
2006-03-24 16:19:31 +00:00
beam_nr_call - > call = NULL ;
beam_nr_call - > state = WAITING_TO_BE_LEFTMOST_PARENT ;
beam_ABX - > suspended = addto_suspensions_list ( beam_ABX , LEFTMOST_SUSPENSION ) ;
beam_nr_call = beam_nr_call - > next ;
2005-09-08 23:36:16 +01:00
goto next_call ;
}
2006-03-24 16:19:31 +00:00
beam_ABX - > side_effects - = CUT ;
beam_nr_call = remove_call_from_andbox ( beam_nr_call , beam_ABX ) ;
2005-09-08 23:36:16 +01:00
# if Debug
2006-03-24 16:19:31 +00:00
printf ( " Executando o commit (apaga %d alternatives) \n " , beam_OBX - > nr_all_alternatives - 1 ) ;
if ( beam_ABX - > externals ! = NULL & & beam_OBX - > nr_all_alternatives > 1 ) printf ( " commit com externals (noisy) \n " ) ;
if ( beam_ABX - > externals ! = NULL & & beam_OBX - > nr_all_alternatives = = 1 ) printf ( " commit com externals (degenerate) \n " ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
if ( beam_OBX - > nr_all_alternatives > 1 ) {
beam_nr_alternative = beam_ABX - > nr_alternative ;
beam_OBX - > nr_all_alternatives = 1 ;
new = beam_OBX - > alternatives ;
beam_OBX - > alternatives = beam_nr_alternative ; /* fica a ser a unica alternativa */
2005-09-08 23:36:16 +01:00
do {
struct status_or * old ;
old = new ;
new = new - > next ;
2006-03-24 16:19:31 +00:00
if ( old ! = beam_nr_alternative ) {
2005-09-08 23:36:16 +01:00
del_andbox_and_sons ( old - > alternative ) ;
if ( new = = NULL ) remove_memory_arguments ( old - > args ) ;
free_memory ( ( Cell * ) old , STATUS_OR_SIZE ) ;
}
} while ( new ! = NULL ) ;
2006-03-24 16:19:31 +00:00
beam_nr_alternative - > next = NULL ;
beam_nr_alternative - > previous = NULL ;
2005-09-08 23:36:16 +01:00
}
goto unique_alternative ;
}
jump :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->jump inst %ld \n " , contador + + , ( long int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
2006-03-24 16:19:31 +00:00
beam_pc = ( Cell * ) arg1 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
save_pair_Y :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->save_pair Y%ld \n " , contador + + , ( long int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
abort_eam ( " save_exp no emulador ????? " ) ;
- - S ;
2006-03-24 16:19:31 +00:00
beam_varlocals [ arg1 ] = abspair ( beam_S ) ;
2005-09-08 23:36:16 +01:00
+ + S ;
2006-03-24 16:19:31 +00:00
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
save_appl_Y :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->save_appl Y%ld \n " , contador + + , ( long int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
abort_eam ( " save_exp no emulador ????? " ) ;
- - S ;
2006-03-24 16:19:31 +00:00
beam_varlocals [ arg1 ] = absappl ( beam_S ) ;
2005-09-08 23:36:16 +01:00
+ + S ;
2006-03-24 16:19:31 +00:00
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
save_appl_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->save_appl X%ld \n " , contador + + , ( long int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
abort_eam ( " save_exp no emulador ????? " ) ;
- - S ;
2006-03-24 16:19:31 +00:00
beam_X [ arg1 ] = absappl ( beam_S ) ;
2005-09-08 23:36:16 +01:00
+ + S ;
2006-03-24 16:19:31 +00:00
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
save_pair_X :
# if Debug
2006-04-12 18:26:14 +01:00
printf ( " %5d->save_pair X%ld \n " , contador + + , ( long int ) arg1 ) ;
break_debug ( contador ) ;
2005-09-08 23:36:16 +01:00
# endif
abort_eam ( " save_exp no emulador ????? " ) ;
- - S ;
2006-03-24 16:19:31 +00:00
beam_X [ arg1 ] = abspair ( beam_S ) ;
2005-09-08 23:36:16 +01:00
+ + S ;
2006-03-24 16:19:31 +00:00
beam_pc + = 2 ;
2005-09-08 23:36:16 +01:00
execute_next ( ) ;
p_atom :
p_atomic :
p_integer :
p_nonvar :
p_number :
p_var :
p_db_ref :
p_primitive :
p_cut_by :
2013-02-13 15:06:06 +00:00
p_save_by :
2005-09-08 23:36:16 +01:00
p_succ :
p_predc :
p_plus :
p_minus :
p_times :
p_div :
p_equal :
p_dif :
p_eq :
p_arg :
p_functor :
abort_eam ( " std_pred no emulador ????? " ) ;
orelse :
orlast :
either :
abort_eam ( " either/orelse/orlast ainda nao implementadas ????? " ) ;
save_b_X :
save_b_Y :
comit_b_X :
comit_b_Y :
abort_eam ( " save_b_X/Y ou comit_b_X/Y no emulador ????? \n " ) ;
}
2006-04-08 15:56:48 +01:00
return ( TRUE ) ;
2005-09-08 23:36:16 +01:00
}
/* The Inst_am instruction is used in eamamasm.c */
2006-03-24 16:19:31 +00:00
Cell inst_am ( int n ) ;
Cell am_to_inst ( Cell inst ) ;
2005-09-08 23:36:16 +01:00
2006-03-24 16:19:31 +00:00
Cell inst_am ( int n )
2005-09-08 23:36:16 +01:00
{
# if DIRECT_JUMP
2006-03-24 16:19:31 +00:00
if ( TABLE_OPS = = NULL ) eam_am ( NULL ) ;
return TABLE_OPS [ n ] ;
2005-09-08 23:36:16 +01:00
# else
return ( n ) ;
# endif
}
2006-03-24 16:19:31 +00:00
Cell am_to_inst ( Cell inst )
2005-09-08 23:36:16 +01:00
{
# if DIRECT_JUMP
int n ;
2006-03-24 16:19:31 +00:00
for ( n = 0 ; n < = _p_functor ; n + + ) if ( ( Cell ) TABLE_OPS [ n ] = = inst ) return ( n ) ;
2005-09-08 23:36:16 +01:00
# endif
return ( inst ) ;
}
# if Debug_Dump_State
/************************************************************************\
* MORE DEBUG STUFF *
\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
# define DUMP_BOXES 0
# define DUMP_STATES 1
# define DUMP_VARS 2
void dump_eam_orbox ( struct OR_BOX * o , struct AND_BOX * pai , struct status_and * pai2 ) ;
void dump_eam_andbox ( struct AND_BOX * a , struct OR_BOX * pai , struct status_or * pai2 ) ;
char * SPACES ( int level ) ;
# define SPACE_MULT 4
char * SPACES ( int level ) {
static char spaces [ 2000 ] ;
int i ;
for ( i = 0 ; i < level * SPACE_MULT ; i + + ) {
spaces [ i ] = ' ' ;
}
spaces [ level * SPACE_MULT ] = 0 ;
return ( spaces ) ;
}
void dump_eam_state ( ) {
static int nr_state = 0 ;
int nr = 0 ;
printf ( " State %d: \n " , + + nr_state ) ;
/* verify suspended boxes */
2006-03-24 16:19:31 +00:00
if ( beam_su ! = NULL ) {
2005-09-08 23:36:16 +01:00
struct SUSPENSIONS * s , * l ;
2006-03-24 16:19:31 +00:00
l = beam_su - > prev ;
s = beam_su ;
2005-09-08 23:36:16 +01:00
do {
nr + + ;
if ( s - > prev ! = l ) abort_eam ( " Invalid list of Suspended boxes \b " ) ;
l = s ;
s = s - > next ;
2006-03-24 16:19:31 +00:00
} while ( s ! = beam_su ) ;
2005-09-08 23:36:16 +01:00
}
printf ( " %d suspended boxes \n " , nr ) ;
2006-03-24 16:19:31 +00:00
dump_eam_andbox ( beam_top , NULL , NULL ) ;
2005-09-08 23:36:16 +01:00
}
void dump_eam_andbox ( struct AND_BOX * a , struct OR_BOX * pai , struct status_or * pai2 ) {
struct status_and * calls , * last ;
if ( a = = NULL ) return ;
if ( pai ! = a - > parent ) abort_eam ( " Pai diferente do parent \n " ) ;
if ( pai2 ! = a - > nr_alternative ) abort_eam ( " Status call Pai diferente do nralternative \n " ) ;
2006-03-24 16:19:31 +00:00
if ( a = = beam_ABX ) printf ( " -> " ) ; else printf ( " " ) ;
2005-09-08 23:36:16 +01:00
if ( a - > suspended ) printf ( " * " ) ; else printf ( " " ) ;
printf ( " %s+ANDBOX with %d goals \n " , SPACES ( 2 * ( a - > level ) ) , a - > nr_all_calls ) ;
calls = a - > calls ;
last = NULL ;
while ( calls ! = NULL ) {
if ( calls - > previous ! = last ) abort_eam ( " link errado nos calls \n " ) ;
if ( calls - > locals = = NULL ) printf ( " %sNO local vars \n " , SPACES ( 2 * ( a - > level ) + 1 ) ) ;
else printf ( " %s%d local vars \n " , SPACES ( 2 * ( a - > level ) + 1 ) , calls - > locals [ - 1 ] ) ;
if ( calls - > call = = NULL ) {
printf ( " %s>ORBOX EMPTY \n " , SPACES ( 2 * ( a - > level ) + 1 ) ) ;
2006-04-08 15:56:48 +01:00
} else {
dump_eam_orbox ( calls - > call , a , calls ) ;
}
2005-09-08 23:36:16 +01:00
last = calls ;
calls = calls - > next ;
}
2006-04-08 15:56:48 +01:00
// printf("Exit from dum_eam_andbox\n");
2005-09-08 23:36:16 +01:00
}
void dump_eam_orbox ( struct OR_BOX * o , struct AND_BOX * pai , struct status_and * pai2 ) {
struct status_or * i , * last ;
if ( o = = NULL ) return ;
if ( pai ! = o - > parent ) abort_eam ( " Pai diferente do parent \n " ) ;
if ( pai2 ! = o - > nr_call ) abort_eam ( " Status call Pai diferente do nrcall \n " ) ;
2006-03-24 16:19:31 +00:00
if ( o = = beam_OBX ) printf ( " => " ) ; else printf ( " " ) ;
2005-09-08 23:36:16 +01:00
printf ( " %s>ORBOX with %d alternatives \n " , SPACES ( 2 * ( o - > parent - > level ) + 1 ) , o - > nr_all_alternatives ) ;
i = o - > alternatives ;
last = NULL ;
while ( i ! = NULL ) {
if ( i - > previous ! = last ) abort_eam ( " link errado nas alternativas \n " ) ;
2006-04-08 15:56:48 +01:00
if ( i - > args ) {
printf ( " %s+%d Arguments \n " , SPACES ( 2 * ( o - > parent - > level + 1 ) ) , i - > args [ 0 ] ) ;
if ( i - > args [ 0 ] < 0 | | i - > args [ 0 ] > 1000 ) abort_eam ( " Num Invalido de Args \n " ) ;
}
2005-09-08 23:36:16 +01:00
if ( i - > alternative = = NULL ) {
2006-04-08 15:56:48 +01:00
printf ( " %s+ANDBOX EMPTY \n " , SPACES ( 2 * ( o - > parent - > level + 2 ) ) ) ;
} else {
dump_eam_andbox ( i - > alternative , o , i ) ;
}
2005-09-08 23:36:16 +01:00
last = i ;
i = i - > next ;
}
}
# endif
# include <sys/time.h>
# include <sys/resource.h>
# include <unistd.h>
int showTime ( void ) /* MORE PRECISION */
{
static int call_time = 0 ;
static struct timeval StartTime ;
static struct timezone TimeZone = { 0 , 0 } ;
# if MICRO_TIME
if ( ! call_time ) {
gettimeofday ( & StartTime , & TimeZone ) ;
call_time = 1 ;
} else {
struct timeval time , diff ;
call_time = 0 ;
gettimeofday ( & time , & TimeZone ) ;
diff . tv_sec = time . tv_sec - StartTime . tv_sec ;
diff . tv_usec = time . tv_usec - StartTime . tv_usec ;
if ( diff . tv_usec < 0 ) {
diff . tv_usec + = 1000000 ;
diff . tv_sec - = 1 ;
}
printf ( " CPU Time %ld (Microseconds) \n " , ( diff . tv_sec * 1000000 ) + ( diff . tv_usec ) ) ;
}
return ( TRUE ) ;
# else
struct rusage rusage ;
/* InitTime() and cputime() from sysbits.c */
if ( ! call_time ) {
getrusage ( RUSAGE_SELF , & rusage ) ;
StartTime . tv_sec = rusage . ru_utime . tv_sec ;
StartTime . tv_usec = rusage . ru_utime . tv_usec ;
call_time = 1 ;
} else {
struct timeval diff ;
call_time = 0 ;
getrusage ( RUSAGE_SELF , & rusage ) ;
diff . tv_sec = rusage . ru_utime . tv_sec - StartTime . tv_sec ;
diff . tv_usec = rusage . ru_utime . tv_usec - StartTime . tv_usec ;
if ( diff . tv_usec < 0 ) {
diff . tv_usec + = 1000000 ;
diff . tv_sec - = 1 ;
}
printf ( " CPU Time %ld (Miliseconds) \n " , ( diff . tv_sec * 1000 ) + ( diff . tv_usec / 1000 ) ) ;
}
return ( TRUE ) ;
# endif
}
# if USE_SPLIT
# include "eam_split.c"
# endif
# if GARBAGE_COLLECTOR
/************************************************************************\
* GC *
\ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
# include "eam_gc.c"
# endif
# endif /* BEAM */