Symbol getsymptr(int seq, int unit) /*;getsymptr*/ { /* here to convert seq and unit to pointer to symbol. * we require that the symbol has already been allocated */ Tuple symptr; Symbol sym; int items; /* here to convert seq and unit to pointer to symbol. * we require that the symbol has already been allocated */ /* TBSL: need to get SEQPTR table for unit, and return address */ if (unit == 0 ) { if (seq == 0) return (Symbol)0; if (seq>0 && seq <= tup_size(init_symbols)) { sym = (Symbol) init_symbols[seq]; return sym; } else chaos("unit 0 error getsymptr"); } if (unit <= unit_numbers) { struct unit *pUnit = pUnits[unit]; symptr = (Tuple) pUnit->aisInfo.symbols; if (symptr == (Tuple)0) { items = pUnit->aisInfo.numberSymbols; symptr = tup_new(items); pUnit->aisInfo.symbols = (char *) symptr; } if (seq <= tup_size(symptr)) { sym = (Symbol) symptr[seq]; if (sym == (Symbol)0) { sym = sym_new_noseq(na_void); symptr[seq] = (char *) sym; S_SEQ(sym) = seq; S_UNIT(sym) = unit; } #ifdef DEBUG if (trapss>0 && seq == trapss && unit == trapsu) traps(sym); #endif return sym; /* return newly allocated symbol */ } else chaos("getsymptr error"); return (Symbol) 0; } chaos("getsymptr unable to find node"); return (Symbol) 0; }
static int const_cmp_kind(Const cleft, Const cright) /*;const_cmp_kind*/ { int ckind; ckind = cleft->const_kind; if (ckind == CONST_OM) chaos("const comparison left operand not defined"); if (ckind != cright->const_kind) { #ifdef DEBUG zpcon(cleft); zpcon(cright); #endif chaos("const comparison operands differing kinds"); } return ckind; }
static void put_slot(IFILE *file, Tuple tup) /*;put_slot*/ { /* This procedure writes out the SLOTS information. These are maps from * symbols to unit names. The interpreter needs only to know the names * of the symbols so we write their names if available, else * an empty string. */ int i, n; Slot slot; n = tup_size(tup); putnum(file, "slot-entries", n); for (i = 1; i <= n; i++) { slot = (Slot) tup[i]; if (slot == (Slot)0) { if (compiling_predef) chaos("undefined slot compiling predef"); putnum(file, "slot-exists", 0); } else { putnum(file, "slot-exists", 1); putnum(file, "slot-seq", slot->slot_seq); putnum(file, "slot-unit", slot->slot_unit); putnum(file, "slot-number", slot->slot_number); putstr(file, "slot-name", slot->slot_name); } } }
void predef_exceptions(Tuple tup) /*;predef_exceptions*/ { /* This procedure writes out the SLOTS information. * This variant of put_slot writes out definitions of predefined exceptions * when compiling predef, in a form suitable for inclusion as the body * of init_predef_exceptions (cf. init.c). */ int i, n; Slot slot; n = tup_size(tup); printf("exception slots\n"); /* first five exceptions defined in standard */ for (i = 6; i <= n; i++) { slot = (Slot) tup[i]; if (slot == (Slot)0) { if (compiling_predef) chaos("undefined slot compiling predef"); } else { printf(" init_predef_exception(%d, %d, %d, \"%s\");\n", slot->slot_seq, slot->slot_unit, slot->slot_number, slot->slot_name); } } }
void on() { if(mode == 0) dim_all(); else if(mode == 1) run(red,1); else if(mode == 2) run(red,0); else if(mode == 3) run(yellow,0); else if(mode == 4) run(lightblue,0); else if(mode == 5) run(green,1); else if(mode == 6) run(green,0); else if(mode == 7) chaos(); else if(mode == 8) cu_mode(); else if(mode == 9) run(red,1);//PWM(); else if(mode < 0) mode = total_modes; else if(mode > total_modes) mode = 0; else run(orange,0); }
int segment_get_int(Segment s, int i) /*;segment_get_int*/ { /* get value of word from location i in segment seg. */ int *resp; seg_check(s); if (i >= s->seg_maxpos) { chaos("segment.c: get_int retrieving from undefined location\n"); return 0; } if (s->seg_kind == SEGMENT_KIND_DATA) { resp = (int *) s->seg_data + i; return *resp; } else { #ifdef ALIGN_WORD /* retrieve byte by byte to avoid alignment problems */ register int j; int v; register char *sp, *tp; resp = (int *) (s->seg_data + i); sp = (char *) resp; tp = (char *) &v; for (j = 0; j < sizeof(int); j++) *tp++ = *sp++; return v; #else resp = (int *) (s->seg_data + i); return *resp; #endif } }
/* Not used */ void node_free(Node node) /*;node_free*/ { /* free nodeentry. Since state of allocated fields not clear * only free the node block itself */ chaos("node free"); if (node != (Node)0) efreet((char *) node, "node-free"); }
char *unit_name_names(char *u) /*;unit_name_names*/ { char *s1; if (u == NULL || strlen(u) <= 2) chaos("unit_name_names: invalid unit name"); s1 = u+2; /* point to start of names fields */ return strjoin("", s1); }
int const_cmp_undef(Const cleft, Const cright) /*;const_cmp_undef*/ { #ifdef DEBUG zpcon(cleft); zpcon(cright); #endif chaos("const comparison not defined for these constant types"); return 0; /* for sake of lint */ }
static int jump_true_code(Symbol op) /*;jump_true_code*/ { if (op == symbol_eq) return I_JUMP_IF_TRUE; else if (op == symbol_ne) return I_JUMP_IF_FALSE; else if (op == symbol_lt) return I_JUMP_IF_LESS; else if (op == symbol_gt) return I_JUMP_IF_GREATER; else if (op == symbol_le) return I_JUMP_IF_LESS_OR_EQUAL; else if (op == symbol_ge) return I_JUMP_IF_GREATER_OR_EQUAL; else chaos("jump_true_code"); return I_JUMP_IF_TRUE; /* return junk value for lint's sake */ }
Span get_left_span(Node node) /*;get_left_span */ { Span lspan; lspan = retrieve_l_span(node); if (lspan == (Span)0 && node != current_node) lspan = retrieve_l_span(current_node); if (lspan == (Span)0) chaos("get_left_span: cannot find spans"); return lspan; }
int predef_code(char *name) /*;predef_code*/ { /* return code given predef opcode name */ int i; for (i = 0; ; i++) { if (pretab[i].pretab_name == (char *)0) chaos("predef_code failed"); if (strcmp(pretab[i].pretab_name, name) == 0 ) break; } return pretab[i].pretab_code; }
Span get_right_span(Node node) /*;get_right_span */ { Span rspan; rspan = retrieve_r_span(node); if (rspan == (Span)0 && node != current_node) rspan = retrieve_r_span(current_node); if (rspan == (Span)0) chaos("get_right_span: cannot find spans"); return rspan; }
void morph_ifs ( void ) { FILE *stream; stream= fopen( "hilist.dat", "rb" ); while( fread( morph_list, 4, _MAX_POINT, stream ) == _MAX_POINT ) { morph(); chaos(); wait_count( 70 * 1 ); } fclose( stream ); }
int is_subunit(char *u) /*;is_subunit*/ { char *s1, *s2; if (u == NULL) chaos("is_subunit: null pointer"); if (strlen(u) <= 2) return FALSE; s1 = u+2; /* point to start of name*/ s2 = strchr(s1, '.'); /* look for dot after first name */ if (s2 == NULL) /* if no dot take rest of string */ return FALSE; return TRUE; /* if subunit*/ }
void chaos_update(void) { region *r; /* Chaos */ for (r = regions; r; r = r->next) { int i; if (fval(r, RF_CHAOTIC)) { chaos(r); } i = get_chaoscount(r); if (i) { add_chaoscount(r, -(int)(i * ((double)(rng_int() % 10)) / 100.0)); } } }
void segment_append(Segment s, Segment sa) /*;segment_append*/ { /* append segment sa at end of segment s */ int i, la; seg_check(s); if (s->seg_kind != SEGMENT_KIND_DATA) chaos("segment_append not appending a data segment"); s->seg_pos = s->seg_maxpos; la = sa->seg_maxpos; for (i = 0; i < la; i++) { segment_put_int(s, ((int *)(sa->seg_data))[i]); } }
void segment_put_byte(Segment s, int v) /*;segment_put_byte*/ { unsigned newpos, pos; seg_check(s); if (s->seg_kind != SEGMENT_KIND_CODE) chaos("segment.c: segment_put_byte called on data segment"); pos = s->seg_pos; newpos = pos + 1; if (newpos >= s->seg_dim) { segment_realloc(s, newpos); } s->seg_data[pos] = (char) v; s->seg_pos = newpos; if (s->seg_maxpos < newpos) s->seg_maxpos = newpos; }
void segment_set_pos(Segment s, unsigned pos, unsigned offtyp) /*;segment_set_pos*/ { /* set position of segment to offset pos. offtyp is type of offset, * interpreted similarly to lseek(2); i.e., offtyp is 0 for offset * from start of segment, 1 for offset from current position, and 2 * for offset from end of segment. Only the cases 0 and 2 are supported now. */ seg_check(s); if (offtyp == 2) { /* to position at end ignore pos */ s->seg_pos = s->seg_maxpos; return; } if (offtyp != 0) chaos("segment_set_pos bad offset type"); s->seg_pos = pos; }
void segment_put_const(Segment seg, Const con) /*;segment_put_const*/ { if (con->const_kind == CONST_INT) { /* can safely put integers - defer others for later */ segment_put_word(seg, INTV(con)); } else if(con->const_kind == CONST_REAL) { segment_put_real(seg, REALV(con)); } else if(con->const_kind == CONST_FIXED) { segment_put_long(seg, FIXEDV(con)); } else { #ifdef DEBUG zpcon(con); #endif chaos("segment.c - meaningless kind of literal"); } }
static int is_subunit(char *u) /*;is_subunit*/ { /* In C, IS_SUBUNIT is procedure is_subunit(): * IS_SUBUNIT(na); (#na > 2) endm; */ int n; char *s1, *s2; if (u == (char *)0) chaos("is_subunit: null pointer"); n = strlen(u); if (n <= 2) return FALSE; s1 = u + 2; /* point to start of name*/ s2 = strchr(s1, '.'); /* look for dot after first name */ if (s2 == (char *)0) /* if no dot take rest of string */ return FALSE; return TRUE; /* if subunit*/ }
void segment_put_off(Segment s, int i, int v) /*;segment_put_off*/ { /* put value of v, interpreted as offset (16 bits) at location i * in segment seg. * We assume this is used to overwrite a previously defined location * and raise chaos if this is not the case. */ unsigned pos, oldpos; int *d; seg_check(s); if (i >= s->seg_maxpos) chaos("segment.c: segment_put_off of undefined location"); pos = i; if (s->seg_kind == SEGMENT_KIND_DATA) { d = (int *) s->seg_data; d[pos] = v; } else { #ifdef ALIGN_WORD { int iv; iv = v; oldpos = s->seg_pos; /* save pos since segment_put_n may alter it */ segment_put_n(s, i, sizeof(int), (char *)&iv); s->seg_pos = oldpos; } #else d = (int *) (s->seg_data + pos); *d = v; #endif } }
void randomevents(void) { region *r; faction *monsters = get_monsters(); icebergs(); godcurse(); orc_growth(); demon_skillchanges(); /* Orkifizierte Regionen mutieren und mutieren zurück */ for (r = regions; r; r = r->next) { if (fval(r, RF_ORCIFIED)) { direction_t dir; double probability = 0.0; for (dir = 0; dir < MAXDIRECTIONS; dir++) { region *rc = rconnect(r, dir); if (rc && rpeasants(rc) > 0 && !fval(rc, RF_ORCIFIED)) probability += 0.02; } if (chance(probability)) { ADDMSG(&r->msgs, msg_message("deorcified", "region", r)); freset(r, RF_ORCIFIED); } } else { attrib *a = a_find(r->attribs, &at_orcification); if (a != NULL) { double probability = 0.0; if (rpeasants(r) <= 0) continue; probability = a->data.i / (double)rpeasants(r); if (chance(probability)) { fset(r, RF_ORCIFIED); a_remove(&r->attribs, a); ADDMSG(&r->msgs, msg_message("orcified", "region", r)); } else { a->data.i -= _max(10, a->data.i / 10); if (a->data.i <= 0) a_remove(&r->attribs, a); } } } } /* Vulkane qualmen, brechen aus ... */ for (r = regions; r; r = r->next) { if (r->terrain == newterrain(T_VOLCANO_SMOKING)) { if (a_find(r->attribs, &at_reduceproduction)) { ADDMSG(&r->msgs, msg_message("volcanostopsmoke", "region", r)); rsetterrain(r, T_VOLCANO); } else { if (rng_int() % 100 < 12) { ADDMSG(&r->msgs, msg_message("volcanostopsmoke", "region", r)); rsetterrain(r, T_VOLCANO); } else if (r->age > 20 && rng_int() % 100 < 8) { volcano_outbreak(r); } } } else if (r->terrain == newterrain(T_VOLCANO)) { if (rng_int() % 100 < 4) { ADDMSG(&r->msgs, msg_message("volcanostartsmoke", "region", r)); rsetterrain(r, T_VOLCANO_SMOKING); } } } /* Monumente zerfallen, Schiffe verfaulen */ for (r = regions; r; r = r->next) { building **blist = &r->buildings; while (*blist) { building *b = *blist; if (fval(b->type, BTF_DECAY) && !building_owner(b)) { b->size -= _max(1, (b->size * 20) / 100); if (b->size == 0) { remove_building(blist, r->buildings); } } if (*blist == b) blist = &b->next; } } /* monster-einheiten desertieren */ if (monsters) { for (r = regions; r; r = r->next) { unit *u; for (u = r->units; u; u = u->next) { if (u->faction && !is_monsters(u->faction) && (u_race(u)->flags & RCF_DESERT)) { if (fval(u, UFL_ISNEW)) continue; if (rng_int() % 100 < 5) { ADDMSG(&u->faction->msgs, msg_message("desertion", "unit region", u, r)); u_setfaction(u, monsters); } } } } } /* Chaos */ for (r = regions; r; r = r->next) { int i; if (fval(r, RF_CHAOTIC)) { chaos(r); } i = chaoscount(r); if (i) { chaoscounts(r, -(int)(i * ((double)(rng_int() % 10)) / 100.0)); } } #ifdef HERBS_ROT rotting_herbs(); #endif dissolve_units(); }
static Const fold_unop(Node node) /*;fold_unop*/ { Node opn, oplist; Const result, op1; int op1_kind; Symbol sym; opn = N_AST1(node); oplist = N_AST2(node); op1 = const_fold((Node) (N_LIST(oplist))[1]); if (is_const_om(op1)) return op1; op1_kind = op1->const_kind; sym = N_UNQ(opn); if (sym == symbol_addui) { /* the "+" can be ignored if it is used as a unary op */ result = op1; } else if (sym == symbol_addufl) { result = op1; } else if (sym == symbol_addufx) { result = op1; } else if (sym == symbol_subui || sym == symbol_subufl || sym == symbol_subufx) { if (is_simple_value(op1)) { if (sym == symbol_subui) { if (is_const_int(op1)) { if (INTV(op1) == ADA_MIN_INTEGER) { create_raise(node, symbol_constraint_error); result = const_new(CONST_OM); } else { result = int_const(-INTV(op1)); } } else if (is_const_uint(op1)) result = uint_const(int_umin(UINTV(op1))); else chaos("eval:subui bad type"); } else if (sym == symbol_subufl) { const_check(op1, CONST_REAL); result = real_const(-REALV(op1)); } } else { const_check(op1, CONST_RAT); result= rat_const(rat_umin(RATV(op1))); } } else if ( sym == symbol_not) { if (is_simple_value (op1)) { if (op1_kind == CONST_INT) result = int_const(1-INTV(op1)); /*bnot in setl */ else chaos("fold_unop: bad kind"); } else { /*TBSL*/ result = const_new(CONST_OM); } } else if ( sym == symbol_absi || sym == symbol_absfl || sym == symbol_absfx) { if (is_simple_value(op1)) { if (sym == symbol_absi) { if (op1_kind == CONST_INT) result = int_const(abs(INTV(op1))); else if (op1_kind == CONST_UINT)chaos("fold_unit absi in uint"); else chaos("fold_unop: bad kind"); } else if (sym == symbol_absfl) { result = real_const(fabs(REALV(op1))); } } else { result= rat_const(rat_abs(RATV(op1))); } } return result; }
static Const fold_op(Node node) /*;fold_op*/ { Node opn, arg1, arg2, oplist; Const result, op1, op2, tryc; Symbol sym, op_name; int *uint; int rm; Tuple tup; int res, overflow; opn = N_AST1(node); oplist = N_AST2(node); tup = N_LIST(oplist); arg1 = (Node) tup[1]; arg2 = (Node) tup[2]; op1 = const_fold(arg1); op2 = const_fold(arg2); op_name = N_UNQ(opn); /* If either operand raises and exception, so does the operation */ if (N_KIND(arg1) == as_raise) { copy_attributes(arg1, node); return const_new(CONST_OM); } if (N_KIND(arg2) == as_raise && op_name != symbol_andthen && op_name != symbol_orelse) { copy_attributes(arg2, node); return const_new(CONST_OM); } if (is_const_om(op1) || (is_const_om(op2) && (op_name != symbol_in || op_name != symbol_notin))) { return const_new(CONST_OM); } sym = op_name; if ( sym == symbol_addi || sym == symbol_addfl) { if (sym == symbol_addi) { res = word_add(INTV(op1), INTV(op2), &overflow); if (overflow) { create_raise(node, symbol_constraint_error); result = const_new(CONST_OM); } else result = int_const(res); } else result = real_const(REALV(op1) + REALV(op2)); } else if ( sym == symbol_addfx) { const_check(op1, CONST_RAT); const_check(op2, CONST_RAT); result= rat_const(rat_add(RATV(op1), RATV(op2))); } else if ( sym == symbol_subi) { if (is_const_int(op1)) { if (is_const_int(op2)) { res = word_sub(INTV(op1), INTV(op2), &overflow); if (overflow) { create_raise(node, symbol_constraint_error); result = const_new(CONST_OM); } else result = int_const(res); } else { chaos("fold_op: subi operand types"); } } } else if (sym == symbol_subfl) { result = real_const(REALV(op1) - REALV(op2)); } else if ( sym == symbol_subfx) { const_check(op1, CONST_RAT); const_check(op2, CONST_RAT); result= rat_const(rat_sub(RATV(op1), RATV(op2))); } else if ( sym == symbol_muli) { #ifdef TBSL -- need to check for overflow and convert result back to int if not -- note that low-level setl is missing calls to check_overflow that -- are present in high-level and should be in low-level as well result = int_mul(int_fri(op1), int_fri(op2)); #endif /* until overflow check in */ const_check(op1, CONST_INT); const_check(op2, CONST_INT); res = word_mul(INTV(op1), INTV(op2), &overflow); if (overflow) { create_raise(node, symbol_constraint_error); result = const_new(CONST_OM); } else result = int_const(res); }
char *predef_name(int op) /*;predef_name*/ { /* return name given predef opcode */ if (op < 1 || op > 130 ) chaos("predef_name failed"); return pretab[op]; }
void main ( void ) { uint pos,count; for( pos=0; pos<_MAX_POINT; pos++ ) { point_list[ pos ].x= 320L << _FP; point_list[ pos ].y= 240L << _FP; point_list[ pos ].sx= ( rand() - rand() /2 ) * 16L; point_list[ pos ].sy= ( rand() - rand() /2 ) * 16L; point_list[ pos ].old_offset=0; point_list[ pos ].old_mask=255; } videomode(0x12); outpw( 0x3c4, 0x0f02 ); while( !kbhit() ) { wvbl(); draw( point_list, _MAX_POINT, 0 ); move( point_list, _MAX_POINT ); } getch(); morph_ifs(); for( pos=0; pos<_MAX_POINT; pos++ ) { point_list[ pos ].sx= ( ( ( long ) ( 65536.0 * ( 320.0 + 220 * sin ( ( double ) pos * 6.28 / _MAX_POINT ) ) ) ) - point_list[ pos ].x ) / ( 70 * 1 ); point_list[ pos ].sy= ( ( ( long ) ( 65536.0 * ( 240.0 + 220 * cos ( ( double ) pos * 6.28 / _MAX_POINT ) ) ) ) - point_list[ pos ].y ) / ( 70 * 1 ); } chaos(); wait_count( 70 * 1 ); for( pos=0; pos<_MAX_POINT; pos++ ) { point_list[ pos ].sx= ( ( ( long ) ( 65536.0 * ( 320.0 + ( 220.0 * pos / _MAX_POINT ) * sin ( ( double ) pos * 6.28 * 8 / _MAX_POINT ) ) ) ) - point_list[ pos ].x ) / ( 70 * 1 ); point_list[ pos ].sy= ( ( ( long ) ( 65536.0 * ( 240.0 + ( 220.0 * pos / _MAX_POINT ) * cos ( ( double ) pos * 6.28 * 8 / _MAX_POINT ) ) ) ) - point_list[ pos ].y ) / ( 70 * 1 ); } chaos(); wait_count( 70 * 1 ); for( pos=0; pos<_MAX_POINT; pos++ ) { point_list[ pos ].sx= ( ( ( long ) ( 65536.0 * ( 320.0 + ( 220.0 * pos / _MAX_POINT ) * cos ( ( double ) pos * 6.28 * 8 / _MAX_POINT ) ) ) ) - point_list[ pos ].x ) / ( 70 * 1 ); point_list[ pos ].sy= ( ( ( long ) ( 65536.0 * ( 240.0 + ( 220.0 * pos / _MAX_POINT ) * sin ( ( double ) pos * 6.28 * 8 / _MAX_POINT ) ) ) ) - point_list[ pos ].y ) / ( 70 * 1 ); } chaos(); wait_count( 70 * 1 ); while( !kbhit() ) { wvbl(); draw( point_list, _MAX_POINT, 0 ); move_gravity ( point_list, _MAX_POINT, 65536L ); } getch(); while( !kbhit() ) { wvbl(); border( 1 ); draw( point_list, _MAX_POINT, 0 ); border( 2 ); move( point_list, _MAX_POINT ); border( 0 ); } videomode(3); }
void seg_check(Segment seg) /*;seg_check*/ { if (seg->seg_id != SEG_ID) chaos("invalid segment - check word invalid "); }