static pointer cconv(context *ctx, int n, pointer *argv)
{
iconv_t cd;
size_t inbytesleft, outbytesleft;
char *outbufp1, *outbufp2, *instrp;
size_t ret;
pointer instr=argv[2], outstr;
size_t len=vecsize(instr);
inbytesleft=len;
outbytesleft=len*2;
outbufp1= outbufp2= malloc(outbytesleft);
instrp= &(instr->c.str.chars[0]);
/* get acceptable codings by 'iconv --list' */
/* cd=iconv_open(to_code, from_code); */
/* cd=iconv_open("Shift_JIS", "EUC-JP"); */
cd=iconv_open(argv[1]->c.str.chars, argv[0]->c.str.chars);
if (cd == (iconv_t)-1) { outstr= (pointer)makeint(errno); goto conv_end;}
ret=iconv(cd, &instrp, &inbytesleft, &outbufp2, &outbytesleft);
if (ret == -1) { outstr=makeint(-errno); goto conv_end;}
else outstr=makestring(outbufp1, len*2-outbytesleft);
conv_end:
iconv_close(cd);
cfree(outbufp1);
return(outstr);
}
static u16 global_add(struct global_state *gstate,
struct string *name, value val)
{
struct symbol *pos;
ivalue old_size, aindex;
GCCHECK(val);
GCPRO2(gstate, name);
old_size = vector_len(gstate->environment->values);
aindex = env_add_entry(gstate->environment, val);
if (vector_len(gstate->environment->values) != old_size) /* Increase mvars too */
{
struct vector *new_mvars = alloc_vector(vector_len(gstate->environment->values));
memcpy(new_mvars->data, gstate->mvars->data,
gstate->mvars->o.size - sizeof(struct obj));
gstate->mvars = new_mvars;
}
GCPOP(2);
gstate->mvars->data[aindex] = makeint(var_normal);
pos = table_add_fast(gstate->global, name, makeint(aindex));
SET_READONLY(pos); /* index of global vars never changes */
return aindex;
}
/*
Input:
Arg1: +Substr
Arg2: + String
Arg3: +forward/reverse (checks only f/r)
f means the first match from the start of String
r means the first match from the end of String
Output:
Arg4: Beg
Beg is the offset where Substr matches. Must be a variable or an
integer
Arg5: End
End is the offset of the next character after the end of Substr
Must be a variable or an integer.
Both Beg and End can be negative, in which case they represent the offset
from the 2nd character past the end of String.
For instance, -1 means the next character past the end of String,
so End = -1 means that Substr must be a suffix of String..
The meaning of End and of negative offsets is consistent with substring
and string_substitute predicates.
*/
xsbBool str_match(CTXTdecl)
{
static char *subptr, *stringptr, *direction, *matchptr;
static size_t substr_beg, substr_end;
int reverse=TRUE; /* search in reverse */
int beg_bos_offset=TRUE; /* measure beg offset from the beg of string */
int end_bos_offset=TRUE; /* measure end offset from the beg of string */
Integer str_len, sub_len; /* length of string and substring */
Cell beg_offset_term, end_offset_term;
term = ptoc_tag(CTXTc 1);
term2 = ptoc_tag(CTXTc 2);
term3 = ptoc_tag(CTXTc 3);
beg_offset_term = ptoc_tag(CTXTc 4);
end_offset_term = ptoc_tag(CTXTc 5);
if (!isatom(term) || !isatom(term2) || !isatom(term3)) {
xsb_abort("STR_MATCH: Arguments 1,2,3 must be bound to strings");
}
subptr = string_val(term);
stringptr = string_val(term2);
direction = string_val(term3);
if (*direction == 'f')
reverse=FALSE;
else if (*direction != 'r')
xsb_abort("STR_MATCH: Argument 3 must be bound to forward/reverse");
str_len=strlen(stringptr);
sub_len=strlen(subptr);
if (isointeger(beg_offset_term)) {
if (oint_val(beg_offset_term) < 0) {
beg_bos_offset = FALSE;
}
}
if (isointeger(end_offset_term)) {
if (oint_val(end_offset_term) < 0) {
end_bos_offset = FALSE;
}
}
if (reverse)
matchptr = xsb_strrstr(stringptr, subptr);
else
matchptr = strstr(stringptr, subptr);
if (matchptr == NULL) return FALSE;
substr_beg = (beg_bos_offset?
matchptr - stringptr : -(str_len - (matchptr - stringptr))
);
substr_end = (end_bos_offset?
(matchptr - stringptr) + sub_len
: -(str_len + 1 - (matchptr - stringptr) - sub_len)
);
return
(p2p_unify(CTXTc beg_offset_term, makeint(substr_beg))
&& p2p_unify(CTXTc end_offset_term, makeint(substr_end)));
}
void motlle_run1(void)
{
int err = protect(exec, NULL);
if (err >= 0)
mthrow(SIGNAL_ERROR, makeint(err));
}
void CalculateInfoData()
{
int i,cn,crewQ;
ref mchref,chref;
crewQ = 0;
mchref = GetMainCharacter();
for(i=0; i<4; i++)
{
cn = GetCompanionIndex(mchref,i);
if( cn>=0 && GetRemovable(&Characters[cn]) )
{
chref = GetCharacter(cn);
crewQ += GetCrewQuantity(chref);
}
}
int nLeaderShip = GetSummonSkillFromName(mchref,SKILL_LEADERSHIP);
nPaymentQ = 5 + crewQ*(16-nLeaderShip);
if( CheckAttribute(mchref,"CrewPayment") ) {
nPaymentQ += makeint( stf(mchref.CrewPayment)*(11.0-SKILL_LEADERSHIP)/10.0 );
}
nMoraleDecreaseQ = 30-nLeaderShip;
if( CheckCharacterPerk(mchref,"IronWill") ) nMoraleDecreaseQ /= 2;
CreateString(true,"payment",""+nPaymentQ,FONT_NORMAL,COLOR_NORMAL,320,258,SCRIPT_ALIGN_CENTER,1.0);
if( sti(mchref.Money) < nPaymentQ )
{
SetSelectable("B_OK",false);
SetCurrentNode("B_CANCEL");
}
}
Statement *ParseCatchStatement()
{
Statement *snp;
SYM *sp;
TYP *tp,*tp1,*tp2;
snp = NewStatement(st_catch, TRUE);
if (lastst != openpa) {
snp->label = NULL;
snp->s2 = 99999;
snp->s1 = ParseStatement();
return snp;
}
needpunc(openpa);
tp = head;
tp1 = tail;
catchdecl = TRUE;
ParseAutoDeclarations();
catchdecl = FALSE;
tp2 = head;
head = tp;
tail = tp1;
needpunc(closepa);
if( (sp = search(declid,&lsyms)) == NULL)
sp = makeint(declid);
snp->s1 = ParseStatement();
snp->label = (char *)sp; // save off symbol pointer
if (sp->tp->typeno >= bt_last)
error(ERR_CATCHSTRUCT);
snp->s2 = GetTypeHash(sp->tp);
return snp;
}
int immediate_depends_ptrlist(CTXTdeclc callnodeptr call1){
VariantSF subgoal;
int count = 0;
CPtr oldhreg = NULL;
calllistptr cl;
reg[4] = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
if(IsNonNULL(call1)){ /* This can be called from some non incremental predicate */
cl= call1->inedges;
while(IsNonNULL(cl)){
subgoal = (VariantSF) cl->inedge_node->callnode->goal;
if(IsNonNULL(subgoal)){/* fact check */
count++;
check_glstack_overflow(4,pcreg,2);
oldhreg = hreg-2;
follow(oldhreg++) = makeint(subgoal);
follow(oldhreg) = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
}
cl=cl->next;
}
if (count>0)
follow(oldhreg) = makenil;
else
reg[4] = makenil;
}
return unify(CTXTc reg_term(CTXTc 3),reg_term(CTXTc 4));
}
pointer ICONVCLOSE(context *ctx, int n, pointer *argv)
{ int cd, ret;
ckarg(1);
cd=bigintval(argv[0]);
ret=iconv_close(cd);
return(makeint(ret));
}
CellCardImpl( InputDeck& deck, const token_list_t& tokens ) :
CellCard( deck ), trcl(NULL), fill(NULL), universe(0), likenbut(false), likeness_cell_n(0),
lat_type(NONE), lattice(NULL)
{
unsigned int idx = 0;
ident = makeint(tokens.at(idx++));
if(tokens.at(idx) == "like"){
idx++;
likenbut = true;
likeness_cell_n = makeint(tokens.at(idx++));
idx++; // skip the "but" token
while(idx < tokens.size()){
data.push_back(tokens[idx++]);
}
return;
}
material = makeint(tokens.at(idx++));
rho = 0.0;
if(material != 0){
rho = makedouble(tokens.at(idx++)); // material density
}
token_list_t temp_geom;
// while the tokens appear in geometry-specification syntax, store them into temporary list
while(idx < tokens.size() && tokens.at(idx).find_first_of("1234567890:#-+()") == 0){
temp_geom.push_back(tokens[idx++]);
}
// retokenize the geometry list, which follows a specialized syntax.
retokenize_geometry( temp_geom );
shunt_geometry();
// store the rest of the tokens into the data list
while(idx < tokens.size()){
data.push_back(tokens[idx++]);
}
makeData();
}
void spn_dbg_emit_source_location(
SpnHashMap *debug_info,
size_t begin,
size_t end,
SpnHashMap *ast,
int regno
)
{
SpnValue vinsns;
SpnArray *insns;
SpnValue vexpr;
SpnValue line, column;
SpnValue vbegin, vend;
SpnValue vregno;
SpnHashMap *expr;
/* if we are not asked to emit debug info, give up */
if (debug_info == NULL) {
return;
}
vinsns = spn_hashmap_get_strkey(debug_info, "insns");
insns = arrayvalue(&vinsns);
vexpr = makehashmap();
expr = hashmapvalue(&vexpr);
line = spn_hashmap_get_strkey(ast, "line");
column = spn_hashmap_get_strkey(ast, "column");
vbegin = makeint(begin);
vend = makeint(end);
vregno = makeint(regno);
spn_hashmap_set_strkey(expr, "line", &line);
spn_hashmap_set_strkey(expr, "column", &column);
spn_hashmap_set_strkey(expr, "begin", &vbegin);
spn_hashmap_set_strkey(expr, "end", &vend);
spn_hashmap_set_strkey(expr, "register", &vregno);
spn_array_push(insns, &vexpr);
spn_value_release(&vexpr);
}
SurfaceCard::SurfaceCard( InputDeck& deck, const token_list_t tokens ):
Card(deck)
{
size_t idx = 0;
std::string token1 = tokens.at(idx++);
if(token1.find_first_of("*+") != token1.npos){
std::cerr << "Warning: no special handling for reflecting or white-boundary surfaces" << std::endl;
token1[0] = ' ';
}
ident = makeint(token1);
std::string token2 = tokens.at(idx++);
if(token2.find_first_of("1234567890-") != 0){
//token2 is the mnemonic
coord_xform = new NullRef<Transform>();
mnemonic = token2;
}
else{
// token2 is a coordinate transform identifier
int tx_id = makeint(token2);
if( tx_id == 0 ){
std::cerr << "I don't think 0 is a valid surface transformation ID, so I'm ignoring it." << std::endl;
coord_xform = new NullRef<Transform>();
}
else if ( tx_id < 0 ){
// abs(tx_id) is the ID of surface with respect to which this surface is periodic.
std::cerr << "Warning: surface " << ident << " periodic, but this program has no special handling for periodic surfaces";
}
else{ // tx_id is positive and nonzero
coord_xform = new CardRef<Transform>( deck, DataCard::TR, makeint(token2) );
}
mnemonic = tokens.at(idx++);
}
while( idx < tokens.size() ){
args.push_back( makedouble(tokens[idx++]) );
}
}
Statement *ParseCatchStatement()
{
Statement *snp;
SYM *sp;
TYP *tp,*tp1,*tp2;
ENODE *node;
static char buf[200];
snp = NewStatement(st_catch, TRUE);
currentStmt = snp;
if (lastst != openpa) {
snp->label = (int64_t *)NULL;
snp->s2 = (Statement *)99999;
snp->s1 = ParseStatement();
// Empty statements return NULL
if (snp->s1)
snp->s1->outer = snp;
return snp;
}
needpunc(openpa,33);
tp = head;
tp1 = tail;
catchdecl = TRUE;
AutoDeclaration::Parse(NULL,&snp->ssyms);
cseg();
catchdecl = FALSE;
tp2 = head;
head = tp;
tail = tp1;
needpunc(closepa,34);
if( (sp = snp->ssyms.Find(*declid,false)) == NULL)
sp = makeint((char *)declid->c_str());
node = makenode(sp->storage_class==sc_static ? en_labcon : en_autocon,NULL,NULL);
// nameref looks up the symbol using lastid, so we need to back it up and
// restore it.
strncpy(buf,lastid,199);
strncpy(lastid, declid->c_str(),sizeof(lastid)-1);
nameref(&node,FALSE);
strcpy(lastid,buf);
snp->s1 = ParseStatement();
// Empty statements return NULL
if (snp->s1)
snp->s1->outer = snp;
snp->label = (int64_t *)node; // save name reference
if (sp->tp->typeno >= bt_last)
error(ERR_CATCHSTRUCT);
snp->s2 = (Statement *)GetTypeHash(sp->tp);
// Empty statements return NULL
// if (snp->s2)
// snp->s2->outer = snp;
return snp;
}
int
setbuiltin(char *p)
{
int i;
p += strlen("_set");
while (strncmp(p, " ", 1) == 0) p++; // chomp spaces
if (strncmp("uid", p, 3) == 0) {
p += strlen("uid");
while (strncmp(p, " ", 1) == 0) p++; // chomp spaces
i = makeint(p); // ugly
return (setuid(i));
} else
if (strncmp("gid", p, 3) == 0) {
p += strlen("gid");
while (strncmp(p, " ", 1) == 0) p++; // chomp spaces
i = makeint(p); // ugly
return (setgid(i));
}
printf(2, "Invalid _set parameter\n");
return -1;
}
void printprogram(FILE * f, unsigned char * program)
{
int i;
OPCODE op;
// header
int size = makeint(program[0], program[1]);
int variables = makeint(program[2], program[3]);
int code = makeint(program[4], program[5]);
int stack = makeint(program[6], program[7]);
fprintf(f, "header->\n");
fprintf(f, " size = 0x%04x\n", size);
fprintf(f, " variables = 0x%04x\n", variables);
fprintf(f, " code = 0x%04x\n", code);
fprintf(f, " stack = 0x%04x\n", stack);
fprintf(f, "<-header\n");
// static variables
fprintf(f, "static variables->\n");
i = variables;
fprintf(f, " 0x%04x bytes reserved\n", code - variables);
fprintf(f, "<-static variables\n");
// code
fprintf(f, "code->\n");
i = code;
do
{
op = (OPCODE)program[i];
i = printopcode(f, program, i);
}
while (op != OPCODE_EXIT);
fprintf(f, "<-code\n");
// stack
fprintf(f, "stack->\n");
fprintf(f, " 0x%04x bytes reserved\n", size - stack);
fprintf(f, "<-stack\n");
}
static struct vector *make_arg_types(function f)
{
if (f->varargs)
return NULL;
int i = 0;
for (vlist a = f->args; a; a = a->next)
++i;
struct vector *result = alloc_vector(i);
for (vlist a = f->args; a; a = a->next)
result->data[--i] = makeint(a->typeset);
result->o.flags |= OBJ_READONLY | OBJ_IMMUTABLE;
return result;
}
static value make_gsymbol(const char *name, fncode fn)
{
struct table *gsymbols = (fn ? fnglobals(fn) : globals)->gsymbols;
struct symbol *gsym;
if (!table_lookup(gsymbols, name, &gsym))
{
struct string *s;
GCPRO1(gsymbols);
s = alloc_string(name);
SET_READONLY(s);
GCPOP(1);
gsym = table_add_fast(gsymbols, s, makeint(table_entries(gsymbols)));
}
return gsym;
}
int return_scc_list(CTXTdeclc SCCNode * nodes, int num_nodes){
VariantSF subgoal;
TIFptr tif;
int cur_node = 0,arity, j;
Psc psc;
CPtr oldhreg = NULL;
reg[4] = makelist(hreg);
new_heap_free(hreg); new_heap_free(hreg);
do {
subgoal = (VariantSF) nodes[cur_node].node;
tif = (TIFptr) subgoal->tif_ptr;
psc = TIF_PSC(tif);
arity = get_arity(psc);
// printf("subgoal %p, %s/%d\n",subgoal,get_name(psc),arity);
check_glstack_overflow(4,pcreg,2+arity*200); // don't know how much for build_subgoal_args..
oldhreg=hreg-2; // ptr to car
if(arity>0){
sreg = hreg;
follow(oldhreg++) = makecs(sreg);
new_heap_functor(sreg,get_ret_psc(2)); // car pts to ret/2 psc
hreg += 3; // hreg pts past ret/2
sreg = hreg;
follow(hreg-1) = makeint(nodes[cur_node].component); // arg 2 of ret/2 pts to component
follow(hreg-2) = makecs(sreg);
new_heap_functor(sreg, psc); // arg 1 of ret/2 pts to goal psc
hreg += arity + 1;
for (j = 1; j <= arity; j++) {
new_heap_free(sreg);
cell_array1[arity-j] = cell(sreg-1);
}
build_subgoal_args(subgoal);
} else{
follow(oldhreg++) = makestring(get_name(psc));
}
follow(oldhreg) = makelist(hreg); // cdr points to next car
new_heap_free(hreg); new_heap_free(hreg);
cur_node++;
} while (cur_node < num_nodes);
follow(oldhreg) = makenil; // cdr points to next car
return unify(CTXTc reg_term(CTXTc 3),reg_term(CTXTc 4));
}
value make_constant(constant c)
{
struct obj *cst;
switch (c->vclass)
{
case cst_string:
cst = (value)alloc_string_length(c->u.string.str, c->u.string.len);
cst->flags |= OBJ_READONLY | OBJ_IMMUTABLE;
return cst;
case cst_list: return make_list(c->u.constants);
case cst_array: return make_array(c->u.constants);
case cst_int: return makeint(c->u.integer);
case cst_float: return (value)alloc_mudlle_float(c->u.mudlle_float);
case cst_bigint: return make_bigint(c->u.bigint_str);
case cst_table: return make_table(c->u.constants);
case cst_symbol: return make_symbol(c->u.constpair);
default:
abort();
}
}
static void generate_typeset_check(unsigned typeset, unsigned arg,
fncode newfn)
{
if (typeset == TYPESET_ANY)
return;
mtype t;
if (typeset == TYPESET_FUNCTION)
t = stype_function;
else if (typeset == TYPESET_LIST)
t = stype_list;
else if (typeset == 0)
t = stype_none;
else if ((typeset & (typeset - 1)) == 0)
t = ffs(typeset) - 1;
else
{
ins_constant(makeint(typeset), newfn);
ins1(op_typeset_check, arg, newfn);
return;
}
ins1(op_typecheck + t, arg, newfn);
}
value make_constant(constant c, bool save_location, fncode fn)
{
struct obj *cst;
switch (c->vclass)
{
case cst_string:
cst = (value)alloc_string(c->u.string);
SET_READONLY(cst); SET_IMMUTABLE(cst);
return cst;
case cst_gsymbol: return make_gsymbol(c->u.string, fn);
case cst_quote: return make_quote(c, save_location, fn);
case cst_list: return make_list(c, c->u.constants, 1, save_location, fn);
case cst_array: return make_array(c->u.constants, fn);
case cst_int: return makeint(c->u.integer);
case cst_float: return alloc_mudlle_float(c->u.mudlle_float);
case cst_table: return make_table(c->u.constants, fn);
case cst_symbol: return make_symbol(c->u.constpair, fn);
default:
abort();
}
}
int immediate_affects_ptrlist(CTXTdeclc callnodeptr call1){
VariantSF subgoal;
int count = 0;
CPtr oldhreg = NULL;
struct hashtable *h;
struct hashtable_itr *itr;
callnodeptr cn;
reg[4] = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
if(IsNonNULL(call1)){ /* This can be called from some non incremental predicate */
h=call1->outedges->hasht;
itr = hashtable1_iterator(h);
if (hashtable1_count(h) > 0){
do {
cn = hashtable1_iterator_value(itr);
if(IsNonNULL(cn->goal)){
count++;
subgoal = (VariantSF) cn->goal;
check_glstack_overflow(4,pcreg,2);
oldhreg=hreg-2;
follow(oldhreg++) = makeint(subgoal);
follow(oldhreg) = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
}
} while (hashtable1_iterator_advance(itr));
}
if (count>0)
follow(oldhreg) = makenil;
else
reg[4] = makenil;
}
return unify(CTXTc reg_term(CTXTc 3),reg_term(CTXTc 4));
}
u16 global_add(struct global_state *gstate, const char *name, mtype t)
/* Effects: adds name to global environment gstate, along with its type (t)
If variable already exists, change its type to t.
Returns: the new variable's index
Modifies: gstate
*/
{
struct string *tname;
mtype current_type;
u16 pos = global_lookup(gstate, name, ¤t_type);
if (pos != GLOBAL_INVALID)
{
gstate->types->data[pos] = makeint(t);
return pos;
}
GCPRO1(gstate);
tname = alloc_string(name);
GCPOP(1);
return global_add1(gstate, tname, t, NULL);
}
void ProcessDialogEvent()
{
ref NPChar;
DeleteAttribute(&Dialog,"Links");
aref Link, NextDiag;
makeref(NPChar,CharacterRef);
makearef(Link, Dialog.Links);
makearef(NextDiag, NPChar.Dialog);
int iTest;
itest = 0;
ref PChar;
PChar = GetMainCharacter();
switch(Dialog.CurrentNode)
{
// -----------------------------------ƒиалог первый - перва¤ встреча
case "First time":
Dialog.defAni = "dialog_stay1";
Dialog.defCam = "1";
Dialog.defSnd = "dialogs\0\017";
Dialog.defLinkAni = "dialog_1";
Dialog.defLinkCam = "1";
Dialog.defLinkSnd = "dialogs\woman\024";
Dialog.ani = "dialog_stay2";
Dialog.cam = "1";
Dialog.snd = "dialogs\0\009";
if (Characters[GetCharacterIndex("Milon Blacque")].quest.first_talk == "1")
{
Dialog.Text = DLG_TEXT[0] + Address_Form.Fra + DLG_TEXT[1] + Characters[GetCharacterIndex(DLG_TEXT[2])].name + DLG_TEXT[3];
Link.l1 = DLG_TEXT[4];
Link.l1.go = "exit";
Link.l2 = DLG_TEXT[5];
Link.l2.go = "MilonTalk_1";
}
else
{
Dialog.Text = DLG_TEXT[6] + Address_Form.Fra + DLG_TEXT[7];
Link.l1 = DLG_TEXT[8] + PChar.ship.name + DLG_TEXT[9];
Link.l1.go = "node_2";
NextDiag.TempNode = "Second Time";
}
break;
case "node_2":
Dialog.Text = DLG_TEXT[10];
Link.l1 = DLG_TEXT[11];
Link.l1.go = "node_3";
break;
case "node_3":
Dialog.Text = DLG_TEXT[12];
Link.l1 = DLG_TEXT[13];
Link.l1.go = "node_4";
break;
case "node_4":
Dialog.Text = DLG_TEXT[14] + Address_Form.Fra + DLG_TEXT[15] + NPChar.name + " " + NPChar.lastname + DLG_TEXT[16];
Link.l1 = DLG_TEXT[17] + PChar.name + " " + PChar.lastname + DLG_TEXT[18] + PChar.ship.name + DLG_TEXT[19];
Link.l1.go = "node_5";
break;
case "node_5":
Dialog.Text = DLG_TEXT[20] + Address_Form.fra + DLG_TEXT[21];
Link.l1 = DLG_TEXT[22];
Link.l1.go = "node_6";
break;
case "node_6":
Dialog.Text = DLG_TEXT[23];
Link.l1 = DLG_TEXT[24];
Link.l1.go = "node_7";
if (makeint(PChar.money) > 1)
{
Link.l2 = DLG_TEXT[25];
Link.l2.go = "node_9";
}
break;
case "node_7":
Dialog.Text = DLG_TEXT[26] + Address_Form.Fra + DLG_TEXT[27];
Link.l1 = DLG_TEXT[28];
Link.l1.go = "Exit";
if (makeint(PChar.money) > 1)
{
Link.l2 = DLG_TEXT[29];
Link.l2.go = "node_9";
}
break;
case "node_9":
AddMoneyToCharacter(pchar, -1);
Dialog.Text = DLG_TEXT[30] + Address_Form.Fra + DLG_TEXT[31];
Link.l1 = DLG_TEXT[32];
if (Characters[GetCharacterIndex("Turpin Cabanel")].quest.smugglers == "0")
{
Link.l1.go = "node_10";
}
else
{
if (Characters[GetCharacterIndex("Thierry Bosquet")].quest.gambling == "0")
{
Link.l1.go = "node_12";
}
else
{
Link.l1.go = "rumours";
}
}
break;
case "node_10":
Dialog.Text = DLG_TEXT[33] + Characters[GetCharacterIndex(DLG_TEXT[34])].name + " " + Characters[GetCharacterIndex(DLG_TEXT[35])].lastname + DLG_TEXT[36];
Characters[GetCharacterIndex("Turpin Cabanel")].quest.smugglers = "1";
Link.l1 = DLG_TEXT[37];
Link.l1.go = "node_11";
Link.l2 = DLG_TEXT[38];
Link.l2.go = "port watcher";
break;
case "node_11":
Dialog.Text = DLG_TEXT[39];
Link.l1 = DLG_TEXT[40];
Link.l1.go = "node_12";
Link.l2 = DLG_TEXT[41] + NPChar.name + DLG_TEXT[42];
Link.l2.go = "exit";
break;
case "node_12":
Dialog.Text = DLG_TEXT[43];
Link.l1 = DLG_TEXT[44];
Link.l1.go = "exit";
Link.l2 = DLG_TEXT[45];
Link.l2.go = "node_13";
break;
case "node_13":
Dialog.Text = DLG_TEXT[46];
Link.l1 = DLG_TEXT[47];
Link.l1.go = "exit";
Link.l2 = DLG_TEXT[48];
Link.l2.go = "Rumours";
break;
case "port watcher":
Dialog.Text = DLG_TEXT[49];
Link.l1 = DLG_TEXT[50];
Link.l1.go = "exit";
Link.l2 = DLG_TEXT[51];
Link.l2.go = "node_12";
break;
// -----------------------------------ƒиалог если игрок поговорил с Milon Blacque
case "MilonTalk_1":
Dialog.Text = DLG_TEXT[52] + Address_Form.Fra + DLG_TEXT[53] + Characters[GetCharacterIndex(DLG_TEXT[54])].name + DLG_TEXT[55];
Link.l1 = DLG_TEXT[56];
Link.l1.go = "MilonTalk_11";
break;
case "MilonTalk_11":
Dialog.Text = DLG_TEXT[57];
Link.l1 = DLG_TEXT[58];
Link.l1.go = "exit";
Link.l2 = DLG_TEXT[59];
Link.l2.go = "MilonTalk_2";
break;
case "MilonTalk_2":
Dialog.Text = DLG_TEXT[60];
Link.l1 = DLG_TEXT[61];
Link.l1.go = "MilonTalk_3";
break;
case "MilonTalk_3":
Characters[GetCharacterIndex("Milon Blacque")].quest.first_talk = "done";
Dialog.Text = DLG_TEXT[62] + Characters[GetCharacterIndex(DLG_TEXT[63])].name + DLG_TEXT[64];
Link.l1 = DLG_TEXT[65];
Link.l1.go = "Exit";
Link.l2 = DLG_TEXT[66];
Link.l2.go = "node_6";
break;
// -----------------------------------ƒиалог при последующих встречах
case "Second Time":
if (Characters[GetCharacterIndex("Milon Blacque")].quest.first_talk == "1")
{
Dialog.Text = DLG_TEXT[67] + Address_Form.Fra + DLG_TEXT[68] + Characters[GetCharacterIndex(DLG_TEXT[69])].name + DLG_TEXT[70];
Link.l1 = DLG_TEXT[71];
Link.l1.go = "exit";
Link.l2 = DLG_TEXT[72];
Link.l2.go = "MilonTalk_1";
}
else
{
Dialog.Text = DLG_TEXT[73] + Address_Form.Fra + DLG_TEXT[74];
Link.l1 = DLG_TEXT[75];
if (Characters[GetCharacterIndex("Turpin Cabanel")].quest.smugglers == "0")
{
Link.l1.go = "node_10";
}
else
{
if (Characters[GetCharacterIndex("Thierry Bosquet")].quest.gambling == "0")
{
Link.l1.go = "node_12";
}
else
{
Link.l1.go = "rumours";
}
}
iTest = iTest + 1;
if ((Characters[GetCharacterIndex("rachel Blacque")].quest.badguy == "1")&&(iTest < QUEST_COUNTER))
{
Link.l2 = DLG_TEXT[76] + characters[getCharacterIndex(DLG_TEXT[77])].name + DLG_TEXT[78];
Link.l2.go = "Rachel";
iTest = iTest + 1;
}
if ((characters[GetCharacterIndex("Turpin Cabanel")].quest.smugglers == "teodoro")&&(iTest < QUEST_COUNTER))
{
dialog.text = DLG_TEXT[79] + address_form.fra + DLG_TEXT[80];
link.l3 = pcharrepphrase(DLG_TEXT[81], DLG_TEXT[82]);
link.l3.go = "smugglers";
iTest = iTest + 1;
}
Link.l99 = DLG_TEXT[83];
Link.l99.go = "exit";
}
break;
case "smugglers":
dialog.text = DLG_TEXT[84] + address_form.fra + DLG_TEXT[85];
link.l1 = pcharrepphrase(DLG_TEXT[86], DLG_TEXT[87]);
link.l1.go = "smugglers_1";
break;
case "smugglers_1":
dialog.text = DLG_TEXT[88];
link.l1 = pcharrepphrase(DLG_TEXT[89], DLG_TEXT[90]);
link.l1.go = "smugglers_2";
break;
case "smugglers_2":
dialog.text = DLG_TEXT[91];
link.l1 = pcharrepphrase(DLG_TEXT[92], DLG_TEXT[93]);
link.l1.go = "smugglers_3";
break;
case "smugglers_3":
dialog.text = DLG_TEXT[94];
link.l1 = pcharrepphrase(DLG_TEXT[95], DLG_TEXT[96]);
link.l1.go = "exit";
///////////////////////////////////////////////
//активизируем ветку, когда на игрока нападают!
characters[GetCharacterIndex("Turpin Cabanel")].quest.smugglers = "orable";
///////////////////////////////////////////////
link.l2 = pcharrepphrase(DLG_TEXT[97], DLG_TEXT[98]);
link.l2.go = pcharrepphrase("smugglers_good", "smugglers_bad");
break;
case "smugglers_good":
dialog.text = DLG_TEXT[99] + address_form.fra + DLG_TEXT[100];
if (makeint(pchar.money)>=500)
{
link.l1 = DLG_TEXT[101];
link.l1.go = "smugglers_good_1";
}
link.l2 = DLG_TEXT[102];
link.l2.go = "smugglers_good_denied";
break;
case "smugglers_good_denied":
dialog.text = DLG_TEXT[103] + address_form.fra + DLG_TEXT[104];
link.l1 = DLG_TEXT[105];
characters[GetCharacterIndex("Turpin Cabanel")].quest.smugglers = "orable";
break;
case "smugglers_good_1":
dialog.text = DLG_TEXT[106] + characters[GetCharacterIndex(DLG_TEXT[107])].name + " " + characters[GetCharacterIndex(DLG_TEXT[108])].lastname + DLG_TEXT[109];
link.l1 = DLG_TEXT[110];
link.l1.go = "exit";
AddMoneyToCharacter(pchar, -500);
characters[GetCharacterIndex("Turpin Cabanel")].quest.smugglers = "orable_truth";
break;
case "smugglers_bad":
dialog.text = DLG_TEXT[111];
link.l1 = DLG_TEXT[112];
link.l1.go = "smugglers_bad_1";
break;
case "smugglers_bad_1":
dialog.text = DLG_TEXT[113];
link.l1 = DLG_TEXT[114];
link.l1.go = "smugglers_bad_2";
break;
case "smugglers_bad_2":
dialog.text = DLG_TEXT[115];
link.l1 = DLG_TEXT[116];
link.l1.go = "smugglers_good_1";
break;
case "Rumours":
Dialog.Text = SelectRumour();
Link.l1 = DLG_TEXT[117];
Link.l1.go = "exit";
break;
case "Rachel":
Dialog.Text = DLG_TEXT[118] + Address_Form.Fra + DLG_TEXT[119];
Link.l1 = DLG_TEXT[120];
Link.l1.go = "Rachel_good";
Link.l2 = DLG_TEXT[121];
Link.l2.go = "Rachel_bad";
break;
case "Rachel_good":
Dialog.Text = DLG_TEXT[122];
Link.l1 = DLG_TEXT[123];
Link.l1.go = "exit";
Characters[GetCharacterIndex("Rachel Blacque")].quest.badguy = "done";
break;
case "Rachel_bad":
Dialog.Text = DLG_TEXT[124] + Address_Form.Fra + DLG_TEXT[125];
Link.l1 = DLG_TEXT[126];
Link.l1.go = "Rachel_good";
Link.l2 = DLG_TEXT[127];
Link.l2.go = "Rachel_bad_2";
break;
case "Rachel_bad_2":
Dialog.Text = DLG_TEXT[128];
Link.l1 = DLG_TEXT[129] + Characters[GetCharacterIndex(DLG_TEXT[130])].name + DLG_TEXT[131];
Link.l1.go = "Rachel_bad_3";
break;
case "Rachel_bad_3":
Dialog.Text = DLG_TEXT[132] + Address_Form.Fra + DLG_TEXT[133];
Link.l1 = DLG_TEXT[134];
Link.l1.go = "exit";
Characters[GetCharacterIndex("Rachel Blacque")].quest.badguy = "money";
NextDiag.TempNode = "MilonTalk";
characters[GetCharacterIndex("Rachel Blacque")].location = "none";
npchar.location = "none";
Rumour[3].state = "active";
break;
case "Exit":
NextDiag.CurrentNode = NextDiag.TempNode;
DialogExit();
break;
}
}
int printopcode(FILE * f, unsigned char * program, int i)
{
REGISTER r1;
REGISTER r2;
unsigned char valh;
unsigned char vall;
unsigned char var1h;
unsigned char var1l;
unsigned char var2h;
unsigned char var2l;
unsigned char deltah;
unsigned char deltal;
unsigned char addrh;
unsigned char addrl;
TURTLE_OPERATION t;
// print memory address first
fprintf(f, " %04x ", i & 0xffff);
// find the opcode
OPCODE op = program[i++];
switch (op)
{
case OPCODE_LOAD_R:
r1 = program[i++];
valh = program[i++];
vall = program[i++];
fprintf(f, "LOAD_R %s %04x\n", registername(r1), makeint(valh, vall));
break;
case OPCODE_LOAD_V:
var1h = program[i++];
var1l = program[i++];
valh = program[i++];
vall = program[i++];
fprintf(f, "LOAD_V %04x %04x\n", makeint(var1h, var1l), makeint(valh, vall));
break;
case OPCODE_MOVE_RR:
r1 = program[i++];
r2 = program[i++];
fprintf(f, "MOVE_RR %s %s\n", registername(r1), registername(r2));
break;
case OPCODE_MOVE_RV:
r1 = program[i++];
var1h = program[i++];
var1l = program[i++];
fprintf(f, "MOVE_RV %s %04x\n", registername(r1), makeint(var1h, var1l));
break;
case OPCODE_MOVE_VR:
var1h = program[i++];
var1l = program[i++];
r1 = program[i++];
fprintf(f, "MOVE_VR %04x %s\n", makeint(var1h, var1l), registername(r1));
break;
case OPCODE_MOVE_VV:
var1h = program[i++];
var1l = program[i++];
var2h = program[i++];
var2l = program[i++];
fprintf(f, "MOVE_VV %04x %04x\n", makeint(var1h, var1l), makeint(var2h, var2l));
break;
case OPCODE_CMP_RR:
r1 = program[i++];
r2 = program[i++];
fprintf(f, "CMP_RR %s %s\n", registername(r1), registername(r2));
break;
case OPCODE_JMPRe:
deltah = program[i++];
deltal = program[i++];
fprintf(f, "JMPRe %04x\n", makeint(deltah, deltal));
break;
case OPCODE_JMPTo:
addrh = program[i++];
addrl = program[i++];
fprintf(f, "JMPTo %04x\n", makeint(addrh, addrl));
break;
case OPCODE_JEq:
deltah = program[i++];
deltal = program[i++];
fprintf(f, "JEq %04x\n", makeint(deltah, deltal));
break;
case OPCODE_JGt:
deltah = program[i++];
deltal = program[i++];
fprintf(f, "JGt %04x\n", makeint(deltah, deltal));
break;
case OPCODE_JLt:
deltah = program[i++];
deltal = program[i++];
fprintf(f, "JLt %04x\n", makeint(deltah, deltal));
break;
case OPCODE_DEC_R:
r1 = program[i++];
fprintf(f, "DEC_R %s\n", registername(r1));
break;
//Added this case to solve unknown listing
case OPCODE_INC_R:
r1 = program[i++];
fprintf(f, "INC_R %s\n", registername(r1));
break;
case OPCODE_ADD_R:
r1 = program[i++];
r2 = program[i++];
fprintf(f, "ADD_R %s %s\n", registername(r1), registername(r2));
break;
case OPCODE_SUB_R:
r1 = program[i++];
r2 = program[i++];
fprintf(f, "SUB_R %s %s\n", registername(r1), registername(r2));
break;
case OPCODE_MUL_R:
r1 = program[i++];
r2 = program[i++];
fprintf(f, "MUL_R %s %s\n", registername(r1), registername(r2));
break;
case OPCODE_DIV_R:
r1 = program[i++];
r2 = program[i++];
fprintf(f, "DIV_R %s %s\n", registername(r1), registername(r2));
break;
case OPCODE_PUSH_R:
r1 = program[i++];
fprintf(f, "PUSH_R %s\n", registername(r1));
break;
case OPCODE_POP_R:
r1 = program[i++];
fprintf(f, "POP_R %s\n", registername(r1));
break;
case OPCODE_PEEK_R:
r1 = program[i++];
fprintf(f, "PEEK_R %s\n", registername(r1));
break;
case OPCODE_TURTLE:
t = (TURTLE_OPERATION)program[i++];
fprintf(f, "TURTLE %s\n", turtle_operation_string(t));
break;
case OPCODE_EXIT:
fprintf(f, "EXIT\n");
break;
default:
fprintf(f, "UNKNOWN\n");
break;
}
return i;
}
int getprogramsize(unsigned char * program)
{
return makeint(program[0], program[1]);
}
void find_the_visitors(CTXTdeclc VariantSF subgoal) {
CPtr cp_top1,cp_bot1 ; CPtr cp_root; CPtr cp_first;
byte cp_inst; Cell listHead;
int ans_subst_num, i, attv_num;
BTNptr trieNode;
ALNptr ALNlist;
// printf("find the visitors: subg %p trie root %p\n",subgoal,subg_ans_root_ptr(subgoal));
cp_top1 = breg ;
cp_bot1 = (CPtr)(tcpstack.high) - CP_SIZE;
if (xwammode && hreg < hfreg) {
printf("uh-oh! hreg was less than hfreg in in find the visitors\n");
hreg = hfreg;
}
while ( cp_top1 < cp_bot1 ) {
// printf("1 cp_top1 %p cp_bot1 %p prev %p\n",cp_top1,cp_bot1,cp_prevtop(cp_top1));
cp_inst = *(byte *)*cp_top1;
// Want trie insts, but need to distinguish from asserted and interned tries
// printf("cp_inst %x\n",cp_inst);
if ( is_trie_instruction(cp_inst) ) {
// printf("found trie instr\n");
// Below we want basic_answer_trie_tt, ts_answer_trie_tt
trieNode = TrieNodeFromCP(cp_top1);
if (IsInAnswerTrie(trieNode)) {
// printf("in answer trie\n");
if (subgoal == get_subgoal_frame_for_answer_trie_cp(CTXTc trieNode)) {
// printf("found top of run %p \n",cp_top1);
// print_subgoal(CTXTc stdout, subgoal); printf("\n");
cp_root = cp_top1; cp_first = cp_top1;
while (*cp_pcreg(cp_root) != trie_fail) {
cp_first = cp_root;
cp_root = cp_prevbreg(cp_root);
if (*cp_pcreg(cp_root) != trie_fail && subgoal != get_subgoal_frame_for_answer_trie_cp(CTXTc TrieNodeFromCP(cp_root)))
printf(" couldn't find incr trie root -- whoa, whu? (%p\n",cp_root);
}
ALNlist = traverse_variant_answer_trie(subgoal, cp_root,cp_top1);
ans_subst_num = (int)int_val(cell(cp_root + CP_SIZE + 1)) ; // account for sf ptr of trie root cp
attv_num = (int)int_val(cell(breg+CP_SIZE+1+ans_subst_num)) + 1;;
// printf("found root %p first %p top %p ans_subst_num %d & %p attv_num %d\n",cp_root,cp_first,cp_top1,ans_subst_num,breg+CP_SIZE, attv_num);
listHead = list_of_answers_from_answer_list(subgoal,ans_subst_num,attv_num,ALNlist);
// Free ALNlist;
cp_pcreg(cp_top1) = (byte *) &completed_trie_member_inst;
cp_ebreg(cp_top1) = cp_ebreg(cp_root);
cp_hreg(cp_top1) = hreg;
cp_ereg(cp_top1) = cp_ereg(cp_root);
cp_trreg(cp_top1) = cp_trreg(cp_root);
cp_prevbreg(cp_top1) = cp_prevbreg(cp_root); cp_prevtop(cp_top1) = cp_prevtop(cp_root);
// cpreg, ereg, pdreg, ptcpreg should not need to be reset (prob not ebreg?)
// printf("sf %p\n",* (cp_root + CP_SIZE + 2));
* (cp_top1 + CP_SIZE) = makeint(ans_subst_num);
for (i = 0;i < ans_subst_num ;i++) { // Use registers for root of trie, not leaf (top)
* (cp_top1 + CP_SIZE + 1 + i) = * (cp_root + CP_SIZE + 2 +i); // account for sf ptr or root
}
* (cp_top1 + CP_SIZE + 1+ ans_subst_num) = listHead;
* (cp_top1 + CP_SIZE + 2+ ans_subst_num) = (Cell)hfreg;
// printf("4 cp_root %p prev %p\n",cp_root,cp_prevtop(cp_root));
// printf("constructed listhead hreg %x\n",hreg);
// cp_top1 = cp_root; // next iteration
// printf("7 cp_top1 %p cp_bot1 %p prev %p\n",cp_top1,cp_bot1,cp_prevtop(cp_top1));
}
}
}
cp_top1 = cp_prevtop(cp_top1);
}
if (xwammode) hfreg = hreg;
// printf("constructed listhead hreg %x hfreg %x\n",hreg,hfreg);
subg_visitors(subgoal) = 0;
// instr_flag = 1; printf("setting instr_flag\n"); hreg_pos = hreg;
}
int gc_heap(int arity)
{
#ifdef GC
CPtr p;
unsigned long begin_marktime, end_marktime,
end_slidetime, end_copy_time;
int marked = 0, marked_dregs = 0, i;
int start_heap_size;
DECL_GC_PROFILE;
INIT_GC_PROFILE;
if (flags[GARBAGE_COLLECT] != NO_GC) {
num_gc++ ;
GC_PROFILE_PRE_REPORT;
slide = (flags[GARBAGE_COLLECT] == SLIDING_GC) |
(flags[GARBAGE_COLLECT] == INDIRECTION_SLIDE_GC);
if (fragmentation_only)
slide = FALSE;
heap_early_reset = ls_early_reset = 0;
GC_PROFILE_START_SUMMARY;
begin_marktime = cpu_time();
start_heap_size = hreg+1-(CPtr)glstack.low;
/* make sure the top choice point heap pointer
that might not point into heap, does */
if (hreg == cp_hreg(breg)) {
*hreg = makeint(666) ;
hreg++ ;
}
#ifdef SLG_GC
/* same for the freeze heap pointer */
if (hfreg == hreg && hreg == cp_hreg(bfreg)) {
*hreg = makeint(66600);
hreg++;
}
#endif
/* copy the aregs to the top of the heap - only if sliding */
/* just hope there is enough space */
/* this happens best before the stack_boundaries are computed */
if (slide) {
if (delayreg != NULL) {
arity++;
reg[arity] = (Cell)delayreg;
}
for (i = 1; i <= arity; i++) {
*hreg = reg[i];
hreg++;
}
}
#ifdef SLG_GC
/* in SLGWAM, copy hfreg to the heap */
if (slide) {
*hreg = (unsigned long) hfreg;
hreg++;
}
#endif
marked = mark_heap(arity, &marked_dregs);
end_marktime = cpu_time();
if (fragmentation_only) {
/* fragmentation is expressed as ratio not-marked/total heap in use
this is internal fragmentation only. we print marked and total,
so that postprocessing can do what it wants with this info. */
xsb_dbgmsg((LOG_GC, "marked_used_missed(%d,%d,%d,%d).",
marked,hreg+1-(CPtr)glstack.low,
heap_early_reset,ls_early_reset));
free_marks:
/* get rid of the marking areas - if they exist */
if (heap_marks) { free((heap_marks-1)); heap_marks = NULL; }
if (tr_marks) { free(tr_marks); tr_marks = NULL; }
if (ls_marks) { free(ls_marks); ls_marks = NULL; }
if (cp_marks) { free(cp_marks); cp_marks = NULL; }
goto end;
}
GC_PROFILE_MARK_SUMMARY;
/* An attempt to add some gc/expansion policy;
ideally this should be user-controlled */
#if (! defined(GC_TEST))
if (marked > ((hreg+1-(CPtr)glstack.low)*mark_threshold))
{
GC_PROFILE_QUIT_MSG;
if (slide)
hreg -= arity;
total_time_gc += (double)
(end_marktime-begin_marktime)*1000/CLOCKS_PER_SEC;
goto free_marks; /* clean-up temp areas and get out of here... */
}
#endif
total_collected += (start_heap_size - marked);
if (slide)
{
GC_PROFILE_SLIDE_START_TIME;
hreg = slide_heap(marked) ;
if (hreg != (heap_bot+marked))
xsb_dbgmsg((LOG_GC, "heap sliding gc - inconsistent hreg"));
#ifdef SLG_GC
/* copy hfreg back from the heap */
hreg--;
hfreg = (unsigned long*) *hreg;
#endif
/* copy the aregs from the top of the heap back */
hreg -= arity;
hbreg = cp_hreg(breg);
p = hreg;
for (i = 1; i <= arity; i++)
reg[i] = *p++ ;
if (delayreg != NULL)
delayreg = (CPtr)reg[arity--];
end_slidetime = cpu_time();
total_time_gc += (double)
(end_slidetime - begin_marktime)*1000/CLOCKS_PER_SEC;
GC_PROFILE_SLIDE_FINAL_SUMMARY;
}
else
{ /* else we call the copying collector a la Cheney */
CPtr begin_new_heap, end_new_heap;
GC_PROFILE_COPY_START_TIME;
begin_new_heap = (CPtr)malloc(marked*sizeof(Cell));
if (begin_new_heap == NULL)
xsb_exit("copying garbage collection could not allocate new heap");
end_new_heap = begin_new_heap+marked;
hreg = copy_heap(marked,begin_new_heap,end_new_heap,arity);
free(begin_new_heap);
adapt_hfreg_from_choicepoints(hreg);
hbreg = cp_hreg(breg);
#ifdef SLG_GC
hfreg = hreg;
#endif
end_copy_time = cpu_time();
total_time_gc += (double)
(end_copy_time - begin_marktime)*1000/CLOCKS_PER_SEC;
GC_PROFILE_COPY_FINAL_SUMMARY;
}
if (print_on_gc) print_all_stacks(arity);
/* get rid of the marking areas - if they exist */
if (heap_marks) {
check_zero(heap_marks,(heap_top - heap_bot),"heap") ;
free((heap_marks-1)) ; /* see its calloc */
heap_marks = NULL ;
}
if (tr_marks) {
check_zero(tr_marks,(tr_top - tr_bot + 1),"tr") ;
free(tr_marks) ;
tr_marks = NULL ;
}
if (ls_marks) {
check_zero(ls_marks,(ls_bot - ls_top + 1),"ls") ;
free(ls_marks) ;
ls_marks = NULL ;
}
if (cp_marks) {
check_zero(cp_marks,(cp_bot - cp_top + 1),"cp") ;
free(cp_marks) ;
cp_marks = NULL ;
}
#ifdef SAFE_GC
p = hreg;
while (p < heap_top)
*p++ = 0;
#endif
} /* if (flags[GARBAGE_COLLECT]) */
#else
/* for no-GC, there is no gc, but stack expansion can be done */
#endif
#ifdef GC
end:
GC_PROFILE_POST_REPORT;
#endif /* GC */
return(TRUE);
} /* gc_heap */
void ProcessDialogEvent()
{
ref NPChar, PChar, d;
PChar = GetMainCharacter();
aref Link, Diag;
string NPC_Meeting, PeaceGroup;
int Nation, Sum;
DeleteAttribute(&Dialog,"Links");
makeref(NPChar,CharacterRef);
makearef(Link, Dialog.Links);
makeref(d, Dialog);
makearef(Diag, NPChar.Dialog);
switch(Dialog.CurrentNode)
{
// -----------------------------------Диалог первый - первая встреча
case "exit":
Diag.CurrentNode = Diag.TempNode;
NPChar.quest.meeting = NPC_Meeting;
DialogExit();
break;
case "First time":
Dialog.defAni = "dialog_stay2";
Dialog.defCam = "2";
Dialog.defSnd = "dialogs\0\017";
Dialog.defLinkAni = "dialog_1";
Dialog.defLinkCam = "1";
Dialog.defLinkSnd = "dialogs\woman\024";
Dialog.ani = "dialog_stay2";
Dialog.cam = "1";
if(Pchar.quest.RelationAgentMet == "0")
{
Dialog.snd = "voice\REDI\REDI001";
d.Text = DLG_TEXT[0] + address_form.eng + DLG_TEXT[1];
Link.l1 = DLG_TEXT[2];
Link.l1.go = "Tutorial";
NPC_Meeting = "1";
}
else
{
if(NPChar.quest.meeting == "0")
{
Dialog.snd = "voice\REDI\REDI002";
d.Text = DLG_TEXT[3];
Link.l1 = DLG_TEXT[4] + Pchar.name + DLG_TEXT[5];
Link.l1.go = "Service";
Link.l2 = DLG_TEXT[6];
Link.l2.go = "Exit";
}
else
{
Dialog.snd = "voice\REDI\REDI003";
d.Text = DLG_TEXT[7] + Pchar.name"?" ;
Link.l1 = DLG_TEXT[8];
Link.l1.go = "Service";
Link.l2 = DLG_TEXT[9];
Link.l2.go = "exit";
}
}
break;
case "Service":
Dialog.snd = "voice\REDI\REDI004";
d.Text = DLG_TEXT[10];
if(GetNationRelation2MainCharacter(ENGLAND) == RELATION_ENEMY)
{
Link.l1 = DLG_TEXT[11];
Link.l1.go = "England";
}
if(GetNationRelation2MainCharacter(SPAIN) == RELATION_ENEMY)
{
Link.l2 = DLG_TEXT[12];
Link.l2.go = "Spain";
}
if(GetNationRelation2MainCharacter(PORTUGAL) == RELATION_ENEMY)
{
Link.l3 = DLG_TEXT[13];
Link.l3.go = "Portugal";
}
if(GetNationRelation2MainCharacter(HOLLAND) == RELATION_ENEMY)
{
Link.l4 = DLG_TEXT[14];
Link.l4.go = "Holland";
}
if(GetNationRelation2MainCharacter(FRANCE) == RELATION_ENEMY)
{
Link.l5 = DLG_TEXT[15];
Link.l5.go = "France";
}
Link.l6 = DLG_TEXT[16];
Link.l6.go = "exit";
break;
case "Tutorial":
Dialog.snd = "voice\REDI\REDI005";
d.Text = DLG_TEXT[17];
Link.l99 = DLG_TEXT[18];
Link.l99.go = "Tutorial_1";
break;
case "Tutorial_1":
Dialog.snd = "voice\REDI\REDI006";
d.Text = DLG_TEXT[19];
Link.l99 = DLG_TEXT[20];
Link.l99.go = "Tutorial_2";
break;
case "Tutorial_2":
Dialog.snd = "voice\REDI\REDI007";
d.Text = DLG_TEXT[21];
Link.l99 = DLG_TEXT[22];
Link.l99.go = "Tutorial_3";
break;
case "Tutorial_3":
Dialog.snd = "voice\REDI\REDI008";
d.Text = DLG_TEXT[23];
Link.l99 = DLG_TEXT[24];
Link.l99.go = "Tutorial_4";
break;
case "Tutorial_4":
Dialog.snd = "voice\REDI\REDI009";
d.Text = DLG_TEXT[25];
Link.l99 = DLG_TEXT[26];
Link.l99.go = "Service";
break;
case "England":
Pchar.quest.Relations.nation = ENGLAND;
Pchar.quest.Relations.PeaceGroup = "ENGLAND_SOLDIERS";
Pchar.quest.Relations.sum = makeint(stf(Pchar.rank)/stf(Pchar.reputation)*20000);
Dialog.snd = "voice\REDI\REDI010";
d.Text = DLG_TEXT[27] + Pchar.quest.Relations.sum + DLG_TEXT[28];
Link.l1 = DLG_TEXT[29];
if(makeint(Pchar.money) < makeint(Pchar.quest.Relations.sum))
{
Link.l1.go = "No_money";
}
else
{
Link.l1.go = "Agreed";
}
Link.l2 = DLG_TEXT[30];
Link.l2.go = "exit";
break;
case "Spain":
Pchar.quest.Relations.nation = SPAIN;
Pchar.quest.Relations.PeaceGroup = "SPAIN_SOLDIERS";
Pchar.quest.Relations.sum = makeint(stf(Pchar.rank)/stf(Pchar.reputation)*20000);
Dialog.snd = "voice\REDI\REDI011";
d.Text = DLG_TEXT[31] + Pchar.quest.Relations.sum + DLG_TEXT[32];
Link.l1 = DLG_TEXT[33];
if(makeint(Pchar.money) < makeint(Pchar.quest.Relations.sum))
{
Link.l1.go = "No_money";
}
else
{
Link.l1.go = "Agreed";
}
Link.l2 = DLG_TEXT[34];
Link.l2.go = "exit";
break;
case "France":
Pchar.quest.Relations.nation = FRANCE;
Pchar.quest.Relations.PeaceGroup = "FRANCE_SOLDIERS";
Pchar.quest.Relations.sum = makeint(stf(Pchar.rank)/stf(Pchar.reputation)*20000);
Dialog.snd = "voice\REDI\REDI012";
d.Text = DLG_TEXT[35] + Pchar.quest.Relations.sum + DLG_TEXT[36];
Link.l1 = DLG_TEXT[37];
if(makeint(Pchar.money) < makeint(Pchar.quest.Relations.sum))
{
Link.l1.go = "No_money";
}
else
{
Link.l1.go = "Agreed";
}
Link.l2 = DLG_TEXT[38];
Link.l2.go = "exit";
break;
case "Portugal":
Pchar.quest.Relations.nation = PORTUGAL;
Pchar.quest.Relations.PeaceGroup = "CONCEICAO_SOLDIERS";
Pchar.quest.Relations.sum = makeint(stf(Pchar.rank)/stf(Pchar.reputation)*20000);
Dialog.snd = "voice\REDI\REDI013";
d.Text = DLG_TEXT[39] + Pchar.quest.Relations.sum + DLG_TEXT[40];
Link.l1 = DLG_TEXT[41];
if(makeint(Pchar.money) < makeint(Pchar.quest.Relations.sum))
{
Link.l1.go = "No_money";
}
else
{
Link.l1.go = "Agreed";
}
Link.l2 = DLG_TEXT[42];
Link.l2.go = "exit";
break;
case "Holland":
Pchar.quest.Relations.nation = HOLLAND;
Pchar.quest.Relations.PeaceGroup = "DOUWESEN_SOLDIERS";
Pchar.quest.Relations.sum = makeint(stf(Pchar.rank)/stf(Pchar.reputation)*20000);
Dialog.snd = "voice\REDI\REDI014";
d.Text = DLG_TEXT[43] + Pchar.quest.Relations.sum + DLG_TEXT[44];
Link.l1 = DLG_TEXT[45];
if(makeint(Pchar.money) < makeint(Pchar.quest.Relations.sum))
{
Link.l1.go = "No_money";
}
else
{
Link.l1.go = "Agreed";
}
Link.l2 = DLG_TEXT[46];
Link.l2.go = "exit";
break;
case "No_Money":
Dialog.snd = "voice\REDI\REDI015";
d.Text = DLG_TEXT[47];
Link.l1 = DLG_TEXT[48];
Link.l1.go = "exit";
break;
case "Agreed":
Dialog.snd = "voice\REDI\REDI016";
SetNationRelation2MainCharacter(makeint(Pchar.quest.Relations.nation), RELATION_FRIEND);
LAi_group_SetRelation(Pchar.quest.Relations.PeaceGroup, LAI_GROUP_PLAYER, LAI_GROUP_FRIEND);
AddMoneyToCharacter(PChar, -(makeint(Pchar.quest.Relations.sum)));
DeleteAttribute(Pchar, "quest.Relations");
d.Text = DLG_TEXT[49];
Link.l1 = DLG_TEXT[50];
Link.l1.go = "Exit";
Link.l2 = DLG_TEXT[51];
Link.l2.go = "Service";
break;
}
}
/* TLS: making a conservative guess at which system calls need to be
mutexed. I'm doing it whenever I see the process table altered or
affected, so this is the data structure that its protecting.
At some point, the SET_FILEPTRs should be protected against other
threads closing that stream. Perhaps for such things a
thread-specific stream table should be used.
*/
xsbBool sys_system(CTXTdeclc int callno)
{
// int pid;
Integer pid;
switch (callno) {
case PLAIN_SYSTEM_CALL: /* dumb system call: no communication with XSB */
/* this call is superseded by shell and isn't used */
ctop_int(CTXTc 3, system(ptoc_string(CTXTc 2)));
return TRUE;
case SLEEP_FOR_SECS:
#ifdef WIN_NT
Sleep((int)iso_ptoc_int_arg(CTXTc 2,"sleep/1",1) * 1000);
#else
sleep(iso_ptoc_int_arg(CTXTc 2,"sleep/1",1));
#endif
return TRUE;
case GET_TMP_FILENAME:
ctop_string(CTXTc 2,tempnam(NULL,NULL));
return TRUE;
case IS_PLAIN_FILE:
case IS_DIRECTORY:
case STAT_FILE_TIME:
case STAT_FILE_SIZE:
return file_stat(CTXTc callno, ptoc_longstring(CTXTc 2));
case EXEC: {
#ifdef HAVE_EXECVP
/* execs a new process in place of XSB */
char *params[MAX_SUBPROC_PARAMS+2];
prolog_term cmdspec_term;
int index = 0;
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term)) {
prolog_term temp, head;
char *string_head=NULL;
if (isnil(cmdspec_term))
xsb_abort("[exec] Arg 1 must not be an empty list.");
temp = cmdspec_term;
do {
head = p2p_car(temp);
temp = p2p_cdr(temp);
if (isstring(head))
string_head = string_val(head);
else
xsb_abort("[exec] non-string argument passed in list.");
params[index++] = string_head;
if (index > MAX_SUBPROC_PARAMS)
xsb_abort("[exec] Too many arguments.");
} while (!isnil(temp));
params[index] = NULL;
} else if (isstring(cmdspec_term)) {
char *string = string_val(cmdspec_term);
split_command_arguments(string, params, "exec");
} else
xsb_abort("[exec] 1st argument should be term or list of strings.");
if (execvp(params[0], params))
xsb_abort("[exec] Exec call failed.");
#else
xsb_abort("[exec] builtin not supported in this architecture.");
#endif
}
case SHELL: /* smart system call: like SPAWN_PROCESS, but returns error code
instead of PID. Uses system() rather than execvp.
Advantage: can pass arbitrary shell command. */
case SPAWN_PROCESS: { /* spawn new process, reroute stdin/out/err to XSB */
/* +CallNo=2, +ProcAndArgsList,
-StreamToProc, -StreamFromProc, -StreamFromProcStderr,
-Pid */
static int pipe_to_proc[2], pipe_from_proc[2], pipe_from_stderr[2];
int toproc_stream=-1, fromproc_stream=-1, fromproc_stderr_stream=-1;
int pid_or_status;
FILE *toprocess_fptr=NULL,
*fromprocess_fptr=NULL, *fromproc_stderr_fptr=NULL;
char *params[MAX_SUBPROC_PARAMS+2]; /* one for progname--0th member,
one for NULL termination*/
prolog_term cmdspec_term, cmdlist_temp_term;
prolog_term cmd_or_arg_term;
xsbBool toproc_needed=FALSE, fromproc_needed=FALSE, fromstderr_needed=FALSE;
char *cmd_or_arg=NULL, *shell_cmd=NULL;
int idx = 0, tbl_pos;
char *callname=NULL;
xsbBool params_are_in_a_list=FALSE;
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (callno == SPAWN_PROCESS)
callname = "spawn_process/5";
else
callname = "shell/[1,2,5]";
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term))
params_are_in_a_list = TRUE;
else if (isstring(cmdspec_term))
shell_cmd = string_val(cmdspec_term);
else if (isref(cmdspec_term))
xsb_instantiation_error(CTXTc callname,1);
else
xsb_type_error(CTXTc "atom or list e.g. [command, arg, ...]",cmdspec_term,callname,1);
// xsb_abort("[%s] Arg 1 must be an atom or a list [command, arg, ...]",
// callname);
/* the user can indicate that he doesn't want either of the streams created
by putting an atom in the corresponding argument position */
if (isref(reg_term(CTXTc 3)))
toproc_needed = TRUE;
if (isref(reg_term(CTXTc 4)))
fromproc_needed = TRUE;
if (isref(reg_term(CTXTc 5)))
fromstderr_needed = TRUE;
/* if any of the arg streams is already used by XSB, then don't create
pipes --- use these streams instead. */
if (isointeger(reg_term(CTXTc 3))) {
SET_FILEPTR(toprocess_fptr, oint_val(reg_term(CTXTc 3)));
}
if (isointeger(reg_term(CTXTc 4))) {
SET_FILEPTR(fromprocess_fptr, oint_val(reg_term(CTXTc 4)));
}
if (isointeger(reg_term(CTXTc 5))) {
SET_FILEPTR(fromproc_stderr_fptr, oint_val(reg_term(CTXTc 5)));
}
if (!isref(reg_term(CTXTc 6)))
xsb_type_error(CTXTc "variable (to return process id)",reg_term(CTXTc 6),callname,5);
// xsb_abort("[%s] Arg 5 (process id) must be a variable", callname);
if (params_are_in_a_list) {
/* fill in the params[] array */
if (isnil(cmdspec_term))
xsb_abort("[%s] Arg 1 must not be an empty list", callname);
cmdlist_temp_term = cmdspec_term;
do {
cmd_or_arg_term = p2p_car(cmdlist_temp_term);
cmdlist_temp_term = p2p_cdr(cmdlist_temp_term);
if (isstring(cmd_or_arg_term)) {
cmd_or_arg = string_val(cmd_or_arg_term);
}
else
xsb_abort("[%s] Non string list member in the Arg",
callname);
params[idx++] = cmd_or_arg;
if (idx > MAX_SUBPROC_PARAMS)
xsb_abort("[%s] Too many arguments passed to subprocess",
callname);
} while (!isnil(cmdlist_temp_term));
params[idx] = NULL; /* null termination */
} else { /* params are in a string */
if (callno == SPAWN_PROCESS)
split_command_arguments(shell_cmd, params, callname);
else {
/* if callno==SHELL => call system() => don't split shell_cmd */
params[0] = shell_cmd;
params[1] = NULL;
}
}
/* -1 means: no space left */
if ((tbl_pos = get_free_process_cell()) < 0) {
xsb_warn(CTXTc "Can't create subprocess because XSB process table is full");
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
/* params[0] is the progname */
pid_or_status = xsb_spawn(CTXTc params[0], params, callno,
(toproc_needed ? pipe_to_proc : NULL),
(fromproc_needed ? pipe_from_proc : NULL),
(fromstderr_needed ? pipe_from_stderr : NULL),
toprocess_fptr, fromprocess_fptr,
fromproc_stderr_fptr);
if (pid_or_status < 0) {
xsb_warn(CTXTc "[%s] Subprocess creation failed, Error: %d, errno: %d, Cmd: %s", callname,pid_or_status,errno,params[0]);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
if (toproc_needed) {
toprocess_fptr = fdopen(pipe_to_proc[1], "w");
toproc_stream = xsb_intern_fileptr(CTXTc toprocess_fptr,callname,"pipe","w",CURRENT_CHARSET);
ctop_int(CTXTc 3, toproc_stream);
}
if (fromproc_needed) {
fromprocess_fptr = fdopen(pipe_from_proc[0], "r");
fromproc_stream = xsb_intern_fileptr(CTXTc fromprocess_fptr,callname,"pipe","r",CURRENT_CHARSET);
ctop_int(CTXTc 4, fromproc_stream);
}
if (fromstderr_needed) {
fromproc_stderr_fptr = fdopen(pipe_from_stderr[0], "r");
fromproc_stderr_stream
= xsb_intern_fileptr(CTXTc fromproc_stderr_fptr,callname,"pipe","r",CURRENT_CHARSET);
ctop_int(CTXTc 5, fromproc_stderr_stream);
}
ctop_int(CTXTc 6, pid_or_status);
xsb_process_table.process[tbl_pos].pid = pid_or_status;
xsb_process_table.process[tbl_pos].to_stream = toproc_stream;
xsb_process_table.process[tbl_pos].from_stream = fromproc_stream;
xsb_process_table.process[tbl_pos].stderr_stream = fromproc_stderr_stream;
concat_array(CTXTc params, " ",
xsb_process_table.process[tbl_pos].cmdline,MAX_CMD_LEN);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case GET_PROCESS_TABLE: { /* sys_system(3, X). X is bound to the list
of the form [process(Pid,To,From,Stderr,Cmdline), ...] */
int i;
prolog_term table_term_tail, listHead;
prolog_term table_term=reg_term(CTXTc 2);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!isref(table_term))
xsb_abort("[GET_PROCESS_TABLE] Arg 1 must be a variable");
table_term_tail = table_term;
for (i=0; i<MAX_SUBPROC_NUMBER; i++) {
if (!FREE_PROC_TABLE_CELL(xsb_process_table.process[i].pid)) {
c2p_list(CTXTc table_term_tail); /* make it into a list */
listHead = p2p_car(table_term_tail);
c2p_functor(CTXTc "process", 5, listHead);
c2p_int(CTXTc xsb_process_table.process[i].pid, p2p_arg(listHead,1));
c2p_int(CTXTc xsb_process_table.process[i].to_stream, p2p_arg(listHead,2));
c2p_int(CTXTc xsb_process_table.process[i].from_stream, p2p_arg(listHead,3));
c2p_int(CTXTc xsb_process_table.process[i].stderr_stream,
p2p_arg(listHead,4));
c2p_string(CTXTc xsb_process_table.process[i].cmdline, p2p_arg(listHead,5));
table_term_tail = p2p_cdr(table_term_tail);
}
}
c2p_nil(CTXTc table_term_tail); /* bind tail to nil */
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return p2p_unify(CTXTc table_term, reg_term(CTXTc 2));
}
case PROCESS_STATUS: {
prolog_term pid_term=reg_term(CTXTc 2), status_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isointeger(pid_term)))
xsb_abort("[PROCESS_STATUS] Arg 1 (process id) must be an integer");
pid = (int)oint_val(pid_term);
if (!isref(status_term))
xsb_abort("[PROCESS_STATUS] Arg 2 (process status) must be a variable");
switch (process_status(pid)) {
case RUNNING:
c2p_string(CTXTc "running", status_term);
break;
case STOPPED:
c2p_string(CTXTc "stopped", status_term);
break;
case EXITED_NORMALLY:
c2p_string(CTXTc "exited_normally", status_term);
break;
case EXITED_ABNORMALLY:
c2p_string(CTXTc "exited_abnormally", status_term);
break;
case ABORTED:
c2p_string(CTXTc "aborted", status_term);
break;
case INVALID:
c2p_string(CTXTc "invalid", status_term);
break;
default:
c2p_string(CTXTc "unknown", status_term);
}
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case PROCESS_CONTROL: {
/* sys_system(PROCESS_CONTROL, +Pid, +Signal). Signal: wait, kill */
int status;
prolog_term pid_term=reg_term(CTXTc 2), signal_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isointeger(pid_term)))
xsb_abort("[PROCESS_CONTROL] Arg 1 (process id) must be an integer");
pid = (int)oint_val(pid_term);
if (isstring(signal_term) && strcmp(string_val(signal_term), "kill")==0) {
if (KILL_FAILED(pid)) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
CloseHandle((HANDLE) pid);
#endif
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
if (isconstr(signal_term)
&& strcmp(p2c_functor(signal_term),"wait") == 0
&& p2c_arity(signal_term)==1) {
int exit_status;
if (WAIT(pid, status) < 0) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
exit_status = status;
#else
if (WIFEXITED(status))
exit_status = WEXITSTATUS(status);
else
exit_status = -1;
#endif
p2p_unify(CTXTc p2p_arg(signal_term,1), makeint(exit_status));
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
xsb_warn(CTXTc "[PROCESS_CONTROL] Arg 2: Invalid signal specification. Must be `kill' or `wait(Var)'");
return FALSE;
}
case LIST_DIRECTORY: {
/* assume all type- and mode-checking is done in Prolog */
prolog_term handle = reg_term(CTXTc 2); /* ref for handle */
char *dir_name = ptoc_longstring(CTXTc 3); /* +directory name */
prolog_term filename = reg_term(CTXTc 4); /* reference for name of file */
if (is_var(handle))
return xsb_find_first_file(CTXTc handle,dir_name,filename);
else
return xsb_find_next_file(CTXTc handle,dir_name,filename);
}
default:
xsb_abort("[SYS_SYSTEM] Wrong call number (an XSB bug)");
} /* end case */
return TRUE;
}
int gc_heap(CTXTdeclc int arity, int ifStringGC)
{
#ifdef GC
CPtr p;
double begin_marktime, end_marktime,
end_slidetime, end_copy_time,
begin_stringtime, end_stringtime;
size_t marked = 0, marked_dregs = 0, i;
int ii;
size_t start_heap_size;
size_t rnum_in_trieinstr_unif_stk = (trieinstr_unif_stkptr-trieinstr_unif_stk)+1;
DECL_GC_PROFILE;
garbage_collecting = 1; // flag for profiling that we are gc-ing
// printf("start gc(%ld): e:%p,h:%p,hf:%p\n",(long)(cpu_time()*1000),ereg,hreg,hfreg);
INIT_GC_PROFILE;
if (pflags[GARBAGE_COLLECT] != NO_GC) {
num_gc++ ;
GC_PROFILE_PRE_REPORT;
slide = (pflags[GARBAGE_COLLECT] == SLIDING_GC) |
(pflags[GARBAGE_COLLECT] == INDIRECTION_SLIDE_GC);
if (fragmentation_only)
slide = FALSE;
heap_early_reset = ls_early_reset = 0;
GC_PROFILE_START_SUMMARY;
begin_marktime = cpu_time();
start_heap_size = hreg+1-(CPtr)glstack.low;
/* make sure the top choice point heap pointer
that might not point into heap, does */
if (hreg == cp_hreg(breg)) {
*hreg = makeint(666) ;
hreg++;
}
#ifdef SLG_GC
/* same for the freeze heap pointer */
if (hfreg == hreg && hreg == cp_hreg(bfreg)) {
*hreg = makeint(66600);
hreg++;
}
#endif
/* copy the aregs to the top of the heap - only if sliding */
/* just hope there is enough space */
/* this happens best before the stack_boundaries are computed */
if (slide) {
if (delayreg != NULL) {
arity++;
reg[arity] = (Cell)delayreg;
}
for (ii = 1; ii <= arity; ii++) {
// printf("reg[%d] to heap: %lx\n",ii,(size_t)reg[i]);
*hreg = reg[ii];
hreg++;
}
arity += (int)rnum_in_trieinstr_unif_stk;
for (i = 0; i < rnum_in_trieinstr_unif_stk; i++) {
// printf("trieinstr_unif_stk[%d] to heap: %lx\n",i,(size_t)trieinstr_unif_stk[i]);
*hreg = trieinstr_unif_stk[i];
hreg++;
}
// printf("extended heap: hreg=%p, arity=%d, rnum_in=%d\n",hreg,arity, rnum_in_trieinstr_unif_stk);
#ifdef SLG_GC
/* in SLGWAM, copy hfreg to the heap */
// printf("hfreg to heap is %p at %p, rnum_in_trieinstr_unif_stk=%d,arity=%d,delay=%p\n",hfreg,hreg,rnum_in_trieinstr_unif_stk,arity,delayreg);
*(hreg++) = (Cell) hfreg;
#endif
}
if (top_of_localstk < hreg) {
fprintf(stderr,"stack clobbered: no space for gc_heap\n");
xsb_exit( "stack clobbered");
}
gc_strings = ifStringGC; /* default */
gc_strings = should_gc_strings(); // collect strings for any reason?
marked = mark_heap(CTXTc arity, &marked_dregs);
end_marktime = cpu_time();
if (fragmentation_only) {
/* fragmentation is expressed as ratio not-marked/total heap in use
this is internal fragmentation only. we print marked and total,
so that postprocessing can do what it wants with this info. */
xsb_dbgmsg((LOG_GC, "marked_used_missed(%d,%d,%d,%d).",
marked,hreg+1-(CPtr)glstack.low,
heap_early_reset,ls_early_reset));
free_marks:
#ifdef PRE_IMAGE_TRAIL
/* re-tag pre image cells in trail */
for (p = tr_bot; p <= tr_top ; p++ ) {
if (tr_pre_marked(p-tr_bot)) {
*p = *p | PRE_IMAGE_MARK;
tr_clear_pre_mark(p-tr_bot);
}
}
#endif
/* get rid of the marking areas - if they exist */
if (heap_marks) { mem_dealloc((heap_marks-1),heap_marks_size,GC_SPACE); heap_marks = NULL; }
if (tr_marks) { mem_dealloc(tr_marks,tr_top-tr_bot+1,GC_SPACE); tr_marks = NULL; }
if (ls_marks) { mem_dealloc(ls_marks,ls_bot - ls_top + 1,GC_SPACE); ls_marks = NULL; }
if (cp_marks) { mem_dealloc(cp_marks,cp_bot - cp_top + 1,GC_SPACE); cp_marks = NULL; }
if (slide_buf) { mem_dealloc(slide_buf,(slide_buf_size+1)*sizeof(CPtr),GC_SPACE); slide_buf = NULL; }
goto end;
}
GC_PROFILE_MARK_SUMMARY;
/* An attempt to add some gc/expansion policy;
ideally this should be user-controlled */
#if (! defined(GC_TEST))
if (marked > ((hreg+1-(CPtr)glstack.low)*mark_threshold))
{
GC_PROFILE_QUIT_MSG;
if (slide)
hreg -= arity;
total_time_gc += (double)
(end_marktime-begin_marktime);
goto free_marks; /* clean-up temp areas and get out of here... */
}
#endif
total_collected += (start_heap_size - marked);
if (slide)
{
GC_PROFILE_SLIDE_START_TIME;
hreg = slide_heap(CTXTc marked) ;
#ifdef DEBUG_VERBOSE
if (hreg != (heap_bot+marked))
xsb_dbgmsg((LOG_GC, "heap sliding gc - inconsistent hreg"));
#endif
#ifdef SLG_GC
/* copy hfreg back from the heap */
hreg--;
hfreg = (CPtr) *hreg;
#endif
/* copy the aregs from the top of the heap back */
hreg -= arity;
hbreg = cp_hreg(breg);
p = hreg;
arity -= (int)rnum_in_trieinstr_unif_stk;
for (ii = 1; ii <= arity; ii++) {
reg[ii] = *p++;
// printf("heap to reg[%d]: %lx\n",ii,(size_t)reg[i]);
}
if (delayreg != NULL)
delayreg = (CPtr)reg[arity--];
for (i = 0; i < rnum_in_trieinstr_unif_stk; i++) {
trieinstr_unif_stk[i] = *p++;
// printf("heap to trieinstr_unif_stk[%d]: %lx\n",i,(size_t)trieinstr_unif_stk[i]);
}
end_slidetime = cpu_time();
total_time_gc += (double)
(end_slidetime - begin_marktime);
GC_PROFILE_SLIDE_FINAL_SUMMARY;
}
else
{ /* else we call the copying collector a la Cheney */
CPtr begin_new_heap, end_new_heap;
GC_PROFILE_COPY_START_TIME;
begin_new_heap = (CPtr)mem_alloc(marked*sizeof(Cell),GC_SPACE);
if (begin_new_heap == NULL)
xsb_exit( "copying garbage collection could not allocate new heap");
end_new_heap = begin_new_heap+marked;
hreg = copy_heap(CTXTc marked,begin_new_heap,end_new_heap,arity);
mem_dealloc(begin_new_heap,marked*sizeof(Cell),GC_SPACE);
adapt_hfreg_from_choicepoints(CTXTc hreg);
hbreg = cp_hreg(breg);
#ifdef SLG_GC
hfreg = hreg;
#endif
end_copy_time = cpu_time();
total_time_gc += (double)
(end_copy_time - begin_marktime);
GC_PROFILE_COPY_FINAL_SUMMARY;
}
if (print_on_gc) print_all_stacks(CTXTc arity);
/* get rid of the marking areas - if they exist */
if (heap_marks) {
check_zero(heap_marks,(heap_top - heap_bot),"heap") ;
mem_dealloc((heap_marks-1),heap_marks_size,GC_SPACE) ; /* see its calloc */
heap_marks = NULL ;
}
if (tr_marks) {
check_zero(tr_marks,(tr_top - tr_bot + 1),"tr") ;
mem_dealloc(tr_marks,tr_top-tr_bot+1,GC_SPACE) ;
tr_marks = NULL ;
}
if (ls_marks) {
check_zero(ls_marks,(ls_bot - ls_top + 1),"ls") ;
mem_dealloc(ls_marks,ls_bot - ls_top + 1,GC_SPACE) ;
ls_marks = NULL ;
}
if (cp_marks) {
check_zero(cp_marks,(cp_bot - cp_top + 1),"cp") ;
mem_dealloc(cp_marks,cp_bot - cp_top + 1,GC_SPACE) ;
cp_marks = NULL ;
}
if (slide_buf) {
mem_dealloc(slide_buf,(slide_buf_size+1)*sizeof(CPtr),GC_SPACE);
slide_buf = NULL;
}
#ifdef SAFE_GC
p = hreg;
while (p < heap_top)
*p++ = 0;
#endif
} /* if (pflags[GARBAGE_COLLECT]) */
#else
/* for no-GC, there is no gc, but stack expansion can be done */
#endif
#ifdef GC
end:
/*************** GC STRING-TABLE (already marked from heap) *******************/
#ifndef NO_STRING_GC
#ifdef MULTI_THREAD
if (flags[NUM_THREADS] == 1) {
#endif
if (gc_strings && (flags[STRING_GARBAGE_COLLECT] == 1)) {
num_sgc++;
begin_stringtime = cpu_time();
mark_nonheap_strings(CTXT);
free_unused_strings();
// printf("String GC reclaimed: %d bytes\n",beg_string_space_size - pspacesize[STRING_SPACE]);
gc_strings = FALSE;
end_stringtime = cpu_time();
total_time_gc += end_stringtime - begin_stringtime;
}
/* update these even if no GC, to avoid too many calls just to gc strings */
last_string_space_size = pspacesize[STRING_SPACE];
last_assert_space_size = pspacesize[ASSERT_SPACE];
force_string_gc = FALSE;
#ifdef MULTI_THREAD
}
#endif
#endif /* ndef NO_STRING_GC */
GC_PROFILE_POST_REPORT;
garbage_collecting = 0;
#endif /* GC */
// printf(" end gc(%ld), hf:%p,h:%p, space=%d\n",(long)(cpu_time()*1000),hfreg,hreg,(pb)top_of_localstk - (pb)top_of_heap);
return(TRUE);
} /* gc_heap */