# vcg_load2 --- load expression values for code generator (part 2) # load_divaa --- perform division, assign quotient to left operand ipointer function load_divaa (expr, regs) tpointer expr regset regs include VCG_COMMON logical safe procedure p1 forward procedure p2 forward ipointer prep, l, r ipointer gen_generic, gen_mr, ld, st, reach, seq, div_a_by, div_l_by, load_field_asg_op regset opreg, lregs, rregs integer lres, rres, lad (ADDR_DESC_SIZE), rad (ADDR_DESC_SIZE), tad (ADDR_DESC_SIZE), opsize, opins tpointer left_op, right_op left_op = Tmem (expr + 2) right_op = Tmem (expr + 3) if (Tmem (left_op) == FIELD_OP) return (load_field_asg_op (expr, regs)) select (Tmem (expr + 1)) when (INT_MODE) { if (Tmem (right_op) == CONST_OP) { l = reach (left_op, regs, lres, lad) regs |= A_REG return (seq (l, ld (A_REG, lres, lad), div_a_by (Tmem (right_op + 3), INT_MODE), st (A_REG, lad))) } opreg = A_REG # and L register; we treat them similarly prep = gen_generic (PIDA_INS) opsize = 1 opins = DIV_INS } when (UNS_MODE) { if (Tmem (right_op) == CONST_OP) { l = reach (left_op, regs, lres, lad) regs |= A_REG return (seq (l, ld (A_REG, lres, lad), div_a_by (Tmem (right_op + 3), UNS_MODE), st (A_REG, lad))) } opreg = A_REG prep = gen_generic (XCA_INS) opsize = 1 opins = DIV_INS } when (LONG_INT_MODE) { if (Tmem (right_op) == CONST_OP) { l = reach (left_op, regs, lres, lad) regs |= L_REG return (seq (l, ld (L_REG, lres, lad), div_l_by (Tmem (right_op + 3), INT_MODE), st (L_REG, lad))) } opreg = L_REG # and also E, but we ignore that for now prep = gen_generic (PIDL_INS) opsize = 2 opins = DVL_INS } when (LONG_UNS_MODE) { if (Tmem (right_op) == CONST_OP) { l = reach (left_op, regs, lres, lad) regs |= L_REG return (seq (l, ld (L_REG, lres, lad), div_l_by (Tmem (right_op + 3), UNS_MODE), st (L_REG, lad))) } opreg = L_REG prep = seq (gen_generic (ILE_INS), gen_generic (CRL_INS)) opsize = 2 opins = DVL_INS } when (FLOAT_MODE) { opreg = F_REG prep = 0 opsize = 2 opins = FDV_INS } when (LONG_FLOAT_MODE) { opreg = LF_REG prep = 0 opsize = 4 opins = DFDV_INS } else call panic ("load_divaa: bad operand mode *i*n"p, Tmem (expr + 1)) r = reach (Tmem (expr + 3), rregs, rres, rad) call alloc_temp (opsize, tad) l = reach (Tmem (expr + 2), lregs, lres, lad) if (lres ~= IN_MEMORY) { call warning ("load_divaa: left operand not lvalue*n"p) return (0) } select when (safe (opreg, lregs) && safe (opreg, rregs)) if (safe (lregs, rregs)) p1 else p2 when (safe (opreg, lregs) && ~safe (opreg, rregs)) p2 when (~safe (opreg, lregs) && safe (opreg, rregs)) if (safe (lregs, rregs)) p1 else p2 else p2 call free_temp (tad) regs = or (opreg, or (lregs, rregs)) return procedure p1 { load_divaa = seq (l, ld (opreg, lres, lad), prep, r, gen_mr (opins, rad), st (opreg, lad)) } procedure p2 { load_divaa = seq (r, ld (opreg, rres, rad)) load_divaa = seq (load_divaa, st (opreg, tad), l, ld (opreg, lres, lad), prep, gen_mr (opins, tad), st (opreg, lad)) } end # load_div --- perform division, leave result in accumulator ipointer function load_div (expr, regs) tpointer expr regset regs include VCG_COMMON logical safe procedure p1 forward procedure p2 forward ipointer prep, l, r ipointer gen_generic, gen_mr, ld, st, reach, seq, div_a_by, div_l_by, load regset opreg, lregs, rregs integer lres, rres, lad (ADDR_DESC_SIZE), rad (ADDR_DESC_SIZE), tad (ADDR_DESC_SIZE), opsize, opins tpointer left_op, right_op left_op = Tmem (expr + 2) right_op = Tmem (expr + 3) select (Tmem (expr + 1)) when (INT_MODE) { if (Tmem (right_op) == CONST_OP) return (seq (load (left_op, regs), div_a_by (Tmem (right_op + 3), INT_MODE))) opreg = A_REG # and L register; we treat them similarly prep = gen_generic (PIDA_INS) opsize = 1 opins = DIV_INS } when (UNS_MODE) { if (Tmem (right_op) == CONST_OP) return (seq (load (left_op, regs), div_a_by (Tmem (right_op + 3), UNS_MODE))) opreg = A_REG prep = gen_generic (XCA_INS) opsize = 1 opins = DIV_INS } when (LONG_INT_MODE) { if (Tmem (right_op) == CONST_OP) return (seq (load (left_op, regs), div_l_by (Tmem (right_op + 3), INT_MODE))) opreg = L_REG # and also E, but we ignore that for now prep = gen_generic (PIDL_INS) opsize = 2 opins = DVL_INS } when (LONG_UNS_MODE) { if (Tmem (right_op) == CONST_OP) return (seq (load (left_op, regs), div_l_by (Tmem (right_op + 3), UNS_MODE))) opreg = L_REG prep = seq (gen_generic (ILE_INS), gen_generic (CRL_INS)) opsize = 2 opins = DVL_INS } when (FLOAT_MODE) { opreg = F_REG prep = 0 opsize = 2 opins = FDV_INS } when (LONG_FLOAT_MODE) { opreg = LF_REG prep = 0 opsize = 4 opins = DFDV_INS } else call panic ("load_div: bad operand mode *i*n"p, Tmem (expr + 1)) r = reach (Tmem (expr + 3), rregs, rres, rad) call alloc_temp (opsize, tad) l = reach (Tmem (expr + 2), lregs, lres, lad) select when (safe (opreg, lregs) && safe (opreg, rregs)) p1 when (safe (opreg, lregs) && ~safe (opreg, rregs)) p2 when (~safe (opreg, lregs) && safe (opreg, rregs)) p1 else p2 call free_temp (tad) regs = or (opreg, or (lregs, rregs)) return procedure p1 { load_div = seq (l, ld (opreg, lres, lad), prep, r, gen_mr (opins, rad)) } procedure p2 { load_div = seq (r, ld (opreg, rres, rad)) load_div = seq (load_div, st (opreg, tad), l, ld (opreg, lres, lad), prep, gen_mr (opins, tad)) } end # load_do_loop --- generate a test-at-the-bottom loop ipointer function load_do_loop (expr, regs) tpointer expr regset regs include VCG_COMMON integer cad (ADDR_DESC_SIZE) integer mklabel ipointer seq, gen_label, gen_mr, gen_generic, void, flow regset cregs if (Break_sp + 1 > MAX_BREAK_SP) call panic ("do loops nested too deeply: break stack overflow*n"p) Break_sp += 1 Break_stack (Break_sp) = mklabel (1) if (Continue_sp + 1 > MAX_CONTINUE_SP) call panic ("do loops nested too deeply: continue stack overflow*n"p) Continue_sp += 1 Continue_stack (Continue_sp) = mklabel (1) if (Tmem (expr + 2) == 0) { # no condition AD_MODE (cad) = LABELED_AM AD_LABEL (cad) = Continue_stack (Continue_sp) load_do_loop = seq (gen_label (AD_LABEL (cad)), void (Tmem (expr + 1), regs), gen_mr (JMP_INS, cad), gen_generic (FIN_INS), gen_label (Break_stack (Break_sp))) } else { # got a condition AD_MODE (cad) = LABELED_AM AD_LABEL (cad) = mklabel (1) load_do_loop = seq (gen_label (AD_LABEL (cad)), void (Tmem (expr + 1), regs), gen_label (Continue_stack (Continue_sp))) load_do_loop = seq (load_do_loop, flow (Tmem (expr + 2), cregs, FALSE, AD_LABEL (cad)), gen_label (Break_stack (Break_sp))) regs |= cregs } Break_sp -= 1 Continue_sp -= 1 return end # load_eq --- test for equality of operands, put 1 or 0 in A ipointer function load_eq (expr, regs) tpointer expr regset regs include VCG_COMMON logical lzero, rzero logical safe, op_has_value ipointer l, r ipointer seq, reach, ld, st, gen_generic, gen_mr, load regset lregs, rregs integer lres, rres, lad (ADDR_DESC_SIZE), rad (ADDR_DESC_SIZE), tad (ADDR_DESC_SIZE), opsize, opreg, subins, logins tpointer left_op, right_op procedure p1 forward procedure p2 forward procedure p3 forward left_op = Tmem (expr + 2) right_op = Tmem (expr + 3) lzero = op_has_value (left_op, 0) rzero = op_has_value (right_op, 0) select (Tmem (expr + 1)) when (INT_MODE, UNS_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LEQ_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LEQ_INS))) opreg = A_REG opsize = 1 subins = SUB_INS logins = LCEQ_INS } when (LONG_INT_MODE, LONG_UNS_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LLEQ_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LLEQ_INS))) opreg = L_REG opsize = 2 subins = SBL_INS logins = LCEQ_INS } when (FLOAT_MODE) { if (rzero) { load_eq = load (left_op, regs) regs |= A_REG return (seq (load_eq, gen_generic (LFEQ_INS))) } if (lzero) { load_eq = load (right_op, regs) regs |= A_REG return (seq (load_eq, gen_generic (LFEQ_INS))) } opreg = F_REG opsize = 2 subins = FSB_INS logins = LFEQ_INS } when (LONG_FLOAT_MODE) { if (rzero) { load_eq = load (left_op, regs) regs |= A_REG return (seq (load_eq, gen_generic (LFEQ_INS))) } if (lzero) { load_eq = load (right_op, regs) regs |= A_REG return (seq (load_eq, gen_generic (LFEQ_INS))) } opreg = LF_REG opsize = 4 subins = DFSB_INS logins = LFEQ_INS } else call panic ("load_eq: bad op mode *i*n"p, Tmem (expr + 1)) r = reach (Tmem (expr + 3), rregs, rres, rad) call alloc_temp (opsize, tad) l = reach (Tmem (expr + 2), lregs, lres, lad) select when (safe (opreg, lregs) && safe (opreg, rregs)) p1 when (safe (opreg, lregs) && ~safe (opreg, rregs)) p2 when (~safe (opreg, lregs) && safe (opreg, rregs)) p1 else p3 call free_temp (tad) regs = or (A_REG, or (opreg, or (lregs, rregs))) return procedure p1 { load_eq = seq (l, ld (opreg, lres, lad), r, gen_mr (subins, rad), gen_generic (logins)) } procedure p2 { load_eq = seq (r, ld (opreg, rres, rad), l, gen_mr (subins, lad), gen_generic (logins)) } procedure p3 { load_eq = seq (r, ld (opreg, rres, rad)) load_eq = seq (load_eq, st (opreg, tad), l, ld (opreg, lres, lad), gen_mr (sub_ins, tad), gen_generic (logins)) } end # load_field --- place contents of bit field in appropriate accumulator ipointer function load_field (expr, regs) tpointer expr regset regs include VCG_COMMON ipointer ld_field return (ld_field (expr, regs)) end # load_for_loop --- evaluate general looping construct ipointer function load_for_loop (expr, regs) tpointer expr regset regs include VCG_COMMON integer ad (ADDR_DESC_SIZE), looplab, testlab integer mklabel ipointer seq, gen_label, gen_mr, gen_generic, load, flow, void regset iregs, cregs, rregs, bregs testlab = mklabel (1) looplab = mklabel (1) if (Break_sp + 1 > MAX_BREAK_SP) call panic ("for loops nested too deeply: break stack overflow*n"p) Break_sp += 1 Break_stack (Break_sp) = mklabel (1) if (Continue_sp + 1 > MAX_CONTINUE_SP) call panic ("for loops nested too deeply: continue stack overflow*n"p) Continue_sp += 1 Continue_stack (Continue_sp) = mklabel (1) load_for_loop = void (Tmem (expr + 1), iregs) # init AD_MODE (ad) = LABELED_AM if (Tmem (expr + 2) == 0) { # no condition present, assume TRUE AD_LABEL (ad) = looplab load_for_loop = seq (load_for_loop, gen_label (looplab)) load_for_loop = seq (load_for_loop, void (Tmem (expr + 4), bregs), # body gen_label (Continue_stack (Continue_sp))) load_for_loop = seq (load_for_loop, void (Tmem (expr + 3), rregs), # reinit gen_mr (JMP_INS, ad), gen_generic (FIN_INS), gen_label (Break_stack (Break_sp))) cregs = 0 } else { # condition present, generate full loop AD_LABEL (ad) = testlab load_for_loop = seq (load_for_loop, gen_mr (JMP_INS, ad), gen_generic (FIN_INS), gen_label (looplab)) load_for_loop = seq (load_for_loop, void (Tmem (expr + 4), bregs), # body gen_label (Continue_stack (Continue_sp))) load_for_loop = seq (load_for_loop, void (Tmem (expr + 3), rregs), # reinit gen_label (testlab)) load_for_loop = seq (load_for_loop, flow (Tmem (expr + 2), cregs, TRUE, looplab),# condition gen_label (Break_stack (Break_sp))) } Break_sp -= 1 Continue_sp -= 1 regs = or (iregs, or (cregs, or (rregs, bregs))) return end # load_ge --- test for greater-or-equal, put 1 or 0 in A ipointer function load_ge (expr, regs) tpointer expr regset regs include VCG_COMMON logical lzero, rzero logical safe, op_has_value ipointer l, r ipointer seq, reach, ld, st, gen_generic, gen_mr, gen_branch, gen_label, load, void regset lregs, rregs integer lres, rres, lad (ADDR_DESC_SIZE), rad (ADDR_DESC_SIZE), tad (ADDR_DESC_SIZE), opsize, opreg, subins, lab integer mklabel tpointer left_op, right_op procedure p1 forward procedure p2 forward procedure p3 forward left_op = Tmem (expr + 2) right_op = Tmem (expr + 3) lzero = op_has_value (left_op, 0) rzero = op_has_value (right_op, 0) select (Tmem (expr + 1)) when (INT_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LGE_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LLE_INS))) opreg = A_REG opsize = 1 subins = SUB_INS } when (UNS_MODE) { if (rzero) return (seq (void (left_op, regs), gen_generic (LT_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LEQ_INS))) opreg = A_REG opsize = 1 subins = SUB_INS } when (LONG_INT_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LLGE_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LLLE_INS))) opreg = L_REG opsize = 2 subins = SBL_INS } when (LONG_UNS_MODE) { if (rzero) return (seq (void (left_op, regs), gen_generic (LT_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LLEQ_INS))) opreg = L_REG opsize = 2 subins = SBL_INS } when (FLOAT_MODE) { if (rzero) { load_ge = load (left_op, regs) regs |= A_REG return (seq (load_ge, gen_generic (LFGE_INS))) } if (lzero) { load_ge = load (right_op, regs) regs |= A_REG return (seq (load_ge, gen_generic (LFLE_INS))) } opreg = F_REG opsize = 2 subins = FSB_INS } when (LONG_FLOAT_MODE) { if (rzero) { load_ge = load (left_op, regs) regs |= A_REG return (seq (load_ge, gen_generic (LFGE_INS))) } if (lzero) { load_ge = load (right_op, regs) regs |= A_REG return (seq (load_ge, gen_generic (LFLE_INS))) } opreg = LF_REG opsize = 4 subins = DFSB_INS } else call panic ("load_ge: bad op mode *i*n"p, Tmem (expr + 1)) r = reach (Tmem (expr + 3), rregs, rres, rad) call alloc_temp (opsize, tad) l = reach (Tmem (expr + 2), lregs, lres, lad) lab = mklabel (1) select when (safe (opreg, lregs) && safe (opreg, rregs)) p1 when (safe (opreg, lregs) && ~safe (opreg, rregs)) p2 when (~safe (opreg, lregs) && safe (opreg, rregs)) p1 else p3 call free_temp (tad) regs = or (A_REG, or (opreg, or (lregs, rregs))) return procedure p1 { load_ge = seq (l, ld (opreg, lres, lad), r, gen_mr (subins, rad)) select (Tmem (expr + 1)) when (INT_MODE, LONG_INT_MODE) load_ge = seq (load_ge, gen_generic (LCGE_INS)) when (UNS_MODE, LONG_UNS_MODE) load_ge = seq (load_ge, gen_generic (CRA_INS), gen_branch (BMLT_INS, lab), gen_generic (LT_INS), gen_label (lab)) when (FLOAT_MODE, LONG_FLOAT_MODE) load_ge = seq (load_ge, gen_generic (LFGE_INS)) } procedure p2 { load_ge = seq (r, ld (opreg, rres, rad), l, gen_mr (subins, lad)) select (Tmem (expr + 1)) when (INT_MODE, LONG_INT_MODE) load_ge = seq (load_ge, gen_generic (LCLE_INS)) when (UNS_MODE, LONG_UNS_MODE) load_ge = seq (load_ge, gen_generic (CRA_INS), gen_branch (BMGT_INS, lab), gen_generic (LT_INS), gen_label (lab)) when (FLOAT_MODE, LONG_FLOAT_MODE) load_ge = seq (load_ge, gen_generic (LFLE_INS)) } procedure p3 { load_ge = seq (r, ld (opreg, rres, rad)) load_ge = seq (load_ge, st (opreg, tad), l, ld (opreg, lres, lad), gen_mr (subins, tad)) select (Tmem (expr + 1)) when (INT_MODE, LONG_INT_MODE) load_ge = seq (load_ge, gen_generic (LCGE_INS)) when (UNS_MODE, LONG_UNS_MODE) load_ge = seq (load_ge, gen_generic (CRA_INS), gen_branch (BMLT_INS, lab), gen_generic (LT_INS), gen_label (lab)) when (FLOAT_MODE, LONG_FLOAT_MODE) load_ge = seq (load_ge, gen_generic (LFGE_INS)) } end # load_goto --- generate arbitrary control transfer ipointer function load_goto (expr, regs) tpointer expr regset regs include VCG_COMMON ipointer gen_mr, gen_generic, seq integer ad (ADDR_DESC_SIZE) AD_MODE (ad) = LABELED_AM AD_LABEL (ad) = Tmem (expr + 1) load_goto = seq (gen_mr (JMP_INS, ad), gen_generic (FIN_INS)) regs = 0 return end # load_gt --- test for greater, put 1 or 0 in A ipointer function load_gt (expr, regs) tpointer expr regset regs include VCG_COMMON logical lzero, rzero logical safe, op_has_value ipointer l, r ipointer seq, reach, ld, st, gen_generic, gen_mr, gen_branch, gen_label, load, void regset lregs, rregs integer lres, rres, lad (ADDR_DESC_SIZE), rad (ADDR_DESC_SIZE), tad (ADDR_DESC_SIZE), opsize, opreg, subins, lab integer mklabel tpointer left_op, right_op procedure p1 forward procedure p2 forward procedure p3 forward left_op = Tmem (expr + 2) right_op = Tmem (expr + 3) lzero = op_has_value (left_op, 0) rzero = op_has_value (right_op, 0) select (Tmem (expr + 1)) when (INT_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LGT_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LLT_INS))) opreg = A_REG opsize = 1 subins = SUB_INS } when (UNS_MODE) { if (rzero) return (seq (void (left_op, regs), gen_generic (LT_INS))) if (lzero) return (seq (void (right_op, regs), gen_generic (CRA_INS))) opreg = A_REG opsize = 1 subins = SUB_INS } when (LONG_INT_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LLGT_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LLLT_INS))) opreg = L_REG opsize = 2 subins = SBL_INS } when (LONG_UNS_MODE) { if (rzero) return (seq (void (left_op, regs), gen_generic (LT_INS))) if (lzero) return (seq (void (right_op, regs), gen_generic (CRA_INS))) opreg = L_REG opsize = 2 subins = SBL_INS } when (FLOAT_MODE) { if (rzero) { load_gt = load (left_op, regs) regs |= A_REG return (seq (load_gt, gen_generic (LFGT_INS))) } if (lzero) { load_gt = load (right_op, regs) regs |= A_REG return (seq (load_gt, gen_generic (LFLT_INS))) } opreg = F_REG opsize = 2 subins = FSB_INS } when (LONG_FLOAT_MODE) { if (rzero) { load_gt = load (left_op, regs) regs |= A_REG return (seq (load_gt, gen_generic (LFGT_INS))) } if (lzero) { load_gt = load (right_op, regs) regs |= A_REG return (seq (load_gt, gen_generic (LFLT_INS))) } opreg = LF_REG opsize = 4 subins = DFSB_INS } else call panic ("load_gt: bad op mode *i*n"p, Tmem (expr + 1)) r = reach (Tmem (expr + 3), rregs, rres, rad) call alloc_temp (opsize, tad) l = reach (Tmem (expr + 2), lregs, lres, lad) lab = mklabel (1) select when (safe (opreg, lregs) && safe (opreg, rregs)) p1 when (safe (opreg, lregs) && ~safe (opreg, rregs)) p2 when (~safe (opreg, lregs) && safe (opreg, rregs)) p1 else p3 call free_temp (tad) regs = or (A_REG, or (opreg, or (lregs, rregs))) return procedure p1 { load_gt = seq (l, ld (opreg, lres, lad), r, gen_mr (subins, rad)) select (Tmem (expr + 1)) when (INT_MODE, LONG_INT_MODE) load_gt = seq (load_gt, gen_generic (LCGT_INS)) when (UNS_MODE, LONG_UNS_MODE) load_gt = seq (load_gt, gen_generic (CRA_INS), gen_branch (BMLE_INS, lab), gen_generic (LT_INS), gen_label (lab)) when (FLOAT_MODE, LONG_FLOAT_MODE) load_gt = seq (load_gt, gen_generic (LFGT_INS)) } procedure p2 { load_gt = seq (r, ld (opreg, rres, rad), l, gen_mr (subins, lad)) select (Tmem (expr + 1)) when (INT_MODE, LONG_INT_MODE) load_gt = seq (load_gt, gen_generic (LCLT_INS)) when (UNS_MODE, LONG_UNS_MODE) load_gt = seq (load_gt, gen_generic (CRA_INS), gen_branch (BMGE_INS, lab), gen_generic (LT_INS), gen_label (lab)) when (FLOAT_MODE, LONG_FLOAT_MODE) load_gt = seq (load_gt, gen_generic (LFLT_INS)) } procedure p3 { load_gt = seq (r, ld (opreg, rres, rad)) load_gt = seq (load_gt, st (opreg, tad), l, ld (opreg, lres, lad), gen_mr (subins, tad)) select (Tmem (expr + 1)) when (INT_MODE, LONG_INT_MODE) load_gt = seq (load_gt, gen_generic (LCGT_INS)) when (UNS_MODE, LONG_UNS_MODE) load_gt = seq (load_gt, gen_generic (CRA_INS), gen_branch (BMLE_INS, lab), gen_generic (LT_INS), gen_label (lab)) when (FLOAT_MODE, LONG_FLOAT_MODE) load_gt = seq (load_gt, gen_generic (LFGT_INS)) } end # load_if --- evaluate conditional expression; result in accumulator ipointer function load_if (expr, regs) tpointer expr regset regs include VCG_COMMON ipointer load, flow, gen_generic, gen_mr, gen_label, seq integer else_lab, exit_lab, ad (ADDR_DESC_SIZE) integer mklabel regset cregs, tregs, eregs if (Tmem (expr + 4) == 0) { # no 'else' part exit_lab = mklabel (1) load_if = flow (Tmem (expr + 2), cregs, FALSE, exit_lab) load_if = seq (load_if, load (Tmem (expr + 3), tregs), gen_label (exit_lab)) eregs = 0 } else if (Tmem (expr + 3) == 0) { # no 'then' part exit_lab = mklabel (1) load_if = flow (Tmem (expr + 2), cregs, TRUE, exit_lab) load_if = seq (load_if, load (Tmem (expr + 4), eregs), gen_label (exit_lab)) tregs = 0 } else { # general case else_lab = mklabel (1) exit_lab = mklabel (1) AD_MODE (ad) = LABELED_AM AD_LABEL (ad) = exit_lab load_if = flow (Tmem (expr + 2), cregs, FALSE, else_lab) load_if = seq (load_if, load (Tmem (expr + 3), tregs), gen_mr (JMP_INS, ad), gen_generic (FIN_INS), gen_label (else_lab)) load_if = seq (load_if, load (Tmem (expr + 4), eregs), gen_label (exit_lab)) } regs = or (cregs, or (tregs, eregs)) return end # load_index --- load value selected by indexing an array ipointer function load_index (expr, regs) tpointer expr regset regs include VCG_COMMON ipointer reach, gen_mr, ld, seq integer res, ad (ADDR_DESC_SIZE) regset opreg load_index = reach (expr, regs, res, ad) select (Tmem (expr + 1)) when (INT_MODE, UNS_MODE) opreg = A_REG when (LONG_INT_MODE, LONG_UNS_MODE) opreg = L_REG when (FLOAT_MODE) opreg = F_REG when (LONG_FLOAT_MODE) opreg = LF_REG else call panic ("load_index: bad data mode *i*n"p, Tmem (expr + 1)) load_index = seq (load_index, ld (opreg, res, ad)) regs |= opreg return end # load_label --- generate label placement code ipointer function load_label (expr, regs) tpointer expr regset regs include VCG_COMMON ipointer gen_label load_label = gen_label (Tmem (expr + 1)) regs = 0 return end # load_le --- test for greater, put 1 or 0 in A ipointer function load_le (expr, regs) tpointer expr regset regs include VCG_COMMON logical lzero, rzero logical safe, op_has_value ipointer l, r ipointer seq, reach, ld, st, gen_generic, gen_mr, gen_branch, gen_label, load, void regset lregs, rregs integer lres, rres, lad (ADDR_DESC_SIZE), rad (ADDR_DESC_SIZE), tad (ADDR_DESC_SIZE), opsize, opreg, subins, lab integer mklabel tpointer left_op, right_op procedure p1 forward procedure p2 forward procedure p3 forward left_op = Tmem (expr + 2) right_op = Tmem (expr + 3) lzero = op_has_value (left_op, 0) rzero = op_has_value (right_op, 0) select (Tmem (expr + 1)) when (INT_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LLE_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LGE_INS))) opreg = A_REG opsize = 1 subins = SUB_INS } when (UNS_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LEQ_INS))) if (lzero) return (seq (void (right_op, regs), gen_generic (LT_INS))) opreg = A_REG opsize = 1 subins = SUB_INS } when (LONG_INT_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LLLE_INS))) if (lzero) return (seq (load (right_op, regs), gen_generic (LLGE_INS))) opreg = L_REG opsize = 2 subins = SBL_INS } when (LONG_UNS_MODE) { if (rzero) return (seq (load (left_op, regs), gen_generic (LLEQ_INS))) if (lzero) return (seq (void (right_op, regs), gen_generic (LT_INS))) opreg = L_REG opsize = 2 subins = SBL_INS } when (FLOAT_MODE) { if (rzero) { load_le = load (left_op, regs) regs |= A_REG return (seq (load_le, gen_generic (LFLE_INS))) } if (lzero) { load_le = load (right_op, regs) regs |= A_REG return (seq (load_le, gen_generic (LFGE_INS))) } opreg = F_REG opsize = 2 subins = FSB_INS } when (LONG_FLOAT_MODE) { if (rzero) { load_le = load (left_op, regs) regs |= A_REG return (seq (load_le, gen_generic (LFLE_INS))) } if (lzero) { load_le = load (right_op, regs) regs |= A_REG return (seq (load_le, gen_generic (LFGE_INS))) } opreg = LF_REG opsize = 4 subins = DFSB_INS } else call panic ("load_le: bad op mode *i*n"p, Tmem (expr + 1)) r = reach (Tmem (expr + 3), rregs, rres, rad) call alloc_temp (opsize, tad) l = reach (Tmem (expr + 2), lregs, lres, lad) lab = mklabel (1) select when (safe (opreg, lregs) && safe (opreg, rregs)) p1 when (safe (opreg, lregs) && ~safe (opreg, rregs)) p2 when (~safe (opreg, lregs) && safe (opreg, rregs)) p1 else p3 call free_temp (tad) regs = or (A_REG, or (opreg, or (lregs, rregs))) return procedure p1 { load_le = seq (l, ld (opreg, lres, lad), r, gen_mr (subins, rad)) select (Tmem (expr + 1)) when (INT_MODE, LONG_INT_MODE) load_le = seq (load_le, gen_generic (LCLE_INS)) when (UNS_MODE, LONG_UNS_MODE) load_le = seq (load_le, gen_generic (CRA_INS), gen_branch (BMGT_INS, lab), gen_generic (LT_INS), gen_label (lab)) when (FLOAT_MODE, LONG_FLOAT_MODE) load_le = seq (load_le, gen_generic (LFLE_INS)) } procedure p2 { load_le = seq (r, ld (opreg, rres, rad), l, gen_mr (subins, lad)) select (Tmem (expr + 1)) when (INT_MODE, LONG_INT_MODE) load_le = seq (load_le, gen_generic (LCGE_INS)) when (UNS_MODE, LONG_UNS_MODE) load_le = seq (load_le, gen_generic (CRA_INS), gen_branch (BMLT_INS, lab), gen_generic (LT_INS), gen_label (lab)) when (FLOAT_MODE, LONG_FLOAT_MODE) load_le = seq (load_le, gen_generic (LFGE_INS)) } procedure p3 { load_le = seq (r, ld (opreg, rres, rad)) load_le = seq (load_le, st (opreg, tad), l, ld (opreg, lres, lad), gen_mr (subins, tad)) select (Tmem (expr + 1)) when (INT_MODE, LONG_INT_MODE) load_le = seq (load_le, gen_generic (LCLE_INS)) when (UNS_MODE, LONG_UNS_MODE) load_le = seq (load_le, gen_generic (CRA_INS), gen_branch (BMGT_INS, lab), gen_generic (LT_INS), gen_label (lab)) when (FLOAT_MODE, LONG_FLOAT_MODE) load_le = seq (load_le, gen_generic (LFLE_INS)) } end