int const_eq(Const const1, Const const2) /*;const_eq*/ { /* checks to see if 2 Consts have the same value */ switch (const_cmp_kind(const1, const2)) { case CONST_OM: case CONST_CONSTRAINT_ERROR: return TRUE; case CONST_INT: return (INTV(const1) == INTV(const2)); case CONST_FIXED: return (FIXEDV(const1) == FIXEDV(const2)); case CONST_UINT: return int_eql(UINTV(const1), UINTV(const2)); case CONST_REAL: return (RATV(const1) == RATV(const2)); case CONST_RAT: return rat_eql(RATV(const1), RATV(const2)); case CONST_STR: return streq(const1->const_value.const_str, const2->const_value.const_str); default: return const_cmp_undef(const1, const2); } }
int compute_index(Tuple subscript_list_arg, Tuple index_list_arg) /*;compute_index*/ { /* Evaluate mono-dimensional offset from the given subscripts */ Node subscript, low_node, high_node; Symbol indx_type; int ndex, delta; /* use ndex for index, index is builtin */ int sb_val, lw_val, hg_val; Tuple tup; Const lw, hg, sb; Tuple subscript_list, index_list; /* copy arguments - needed since they are used desctructively in * tup_frome calls below */ subscript_list = tup_copy(subscript_list_arg); index_list = tup_copy(index_list_arg); ndex = 0; delta = 1; while (tup_size(index_list)) { indx_type = (Symbol) tup_frome(index_list); subscript = (Node) tup_frome(subscript_list); tup = SIGNATURE(indx_type); low_node = (Node) tup[2]; high_node = (Node) tup[3]; lw = get_ivalue(low_node); hg = get_ivalue(high_node); sb = get_ivalue(subscript); if (!( lw->const_kind != CONST_OM && hg->const_kind != CONST_OM && sb->const_kind != CONST_OM)) { tup_free(subscript_list); tup_free(index_list); return -1; } sb_val = INTV(sb); lw_val = INTV(lw); hg_val = INTV(hg); if (sb_val<lw_val || sb_val>hg_val) { /* here, raise constraint_error */ gen_s(I_LOAD_EXCEPTION_REGISTER, symbol_constraint_error); gen(I_RAISE); tup_free(subscript_list); tup_free(index_list); return -1; } ndex += delta*(sb_val-lw_val); delta *= (hg_val-lw_val+1); } tup_free(subscript_list); tup_free(index_list); return ndex; }
t_stat rtc_cntr_svc (UNIT *uptr) { uint32 cn = uptr - rtc_cntr_unit; io_sclr_req (INTV (INTG_OVR, cn), 1); /* set cntr intr */ return SCPE_OK; }
int const_lt(Const cleft, Const cright) /*;const_lt*/ { switch (const_cmp_kind(cleft, cright)) { case CONST_INT : return (INTV(cleft)<INTV(cright)); case CONST_UINT : return int_lss(UINTV(cleft), UINTV(cright)); case CONST_FIXED : return (FIXEDV(cleft)<FIXEDV(cright)); case CONST_RAT : return rat_lss(RATV(cleft), RATV(cright)); case CONST_REAL : return REALV(cleft) < REALV(cright); default : const_cmp_undef(cleft, cright); return 0; } }
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"); } }
#define MUXDAT_V_LIN 0 /* line num */ #define MUXDAT_M_LIN (MUX_LINES - 1) #define MUXDAT_V_CHR 8 /* output char */ #define MUXDAT_M_CHR 0xFF #define MUXDAT_GETLIN(x) (((x) >> MUXDAT_V_LIN) & MUXDAT_M_LIN) #define MUXDAT_GETCHR(x) (((x) >> MUXDAT_V_CHR) & MUXDAT_M_CHR) uint8 mux_rbuf[MUX_LINES]; /* rcv buf */ uint8 mux_xbuf[MUX_LINES]; /* xmt buf */ uint8 mux_sta[MUX_LINES]; /* status */ uint32 mux_tps = RTC_HZ_50; /* polls/second */ uint32 mux_scan = 0; /* scanner */ uint32 mux_slck = 0; /* scanner locked */ uint32 muxc_cmd = MUXC_IDLE; /* channel state */ uint32 mux_rint = INTV (INTG_E2, 0); uint32 mux_xint = INTV (INTG_E2, 1); TMLN mux_ldsc[MUX_LINES] = { 0 }; /* line descrs */ TMXR mux_desc = { MUX_LINES_DFLT, 0, 0, mux_ldsc }; /* mux descrr */ extern uint32 chan_ctl_time; extern uint32 CC; extern uint32 *R; uint32 mux_disp (uint32 op, uint32 dva, uint32 *dvst); uint32 mux_dio (uint32 op, uint32 rn, uint32 ad); uint32 mux_tio_status (void); t_stat mux_chan_err (uint32 st); t_stat muxc_svc (UNIT *uptr); t_stat muxo_svc (UNIT *uptr);
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); }
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; }