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 */