# put_mr --- output memory reference instruction subroutine put_mr (instr) ipointer instr include VCG_COMMON string_table posn, text _ / ADD_INS, :0006, "ADD", / ADL_INS, :0306, "ADL", / ANA_INS, :0003, "ANA", / ANL_INS, :0303, "ANL", / CAS_INS, :0011, "CAS", / CLS_INS, :0311, "CLS", / DFAD_INS, :0206, "DFAD", / DFCS_INS, :0211, "DFCS", / DFDV_INS, :0217, "DFDV", / DFLD_INS, :0202, "DFLD", / DFLX_INS, :1215, "DFLX", / DFMP_INS, :0216, "DFMP", / DFSB_INS, :0207, "DFSB", / DFST_INS, :0204, "DFST", / DIV_INS, :0017, "DIV", / DVL_INS, :0317, "DVL", / EAL_INS, :0101, "EAL", / EALB_INS, :0213, "EALB", / EAXB_INS, :0212, "EAXB", / ERA_INS, :0005, "ERA", / ERL_INS, :0305, "ERL", / FAD_INS, :0106, "FAD", / FCS_INS, :0111, "FCS", / FDV_INS, :0117, "FDV", / FLD_INS, :0102, "FLD", / FLX_INS, :1115, "FLX", / FMP_INS, :0116, "FMP", / FSB_INS, :0107, "FSB", / FST_INS, :0104, "FST", / IMA_INS, :0013, "IMA", / IRS_INS, :0012, "IRS", / JMP_INS, :0001, "JMP", / JST_INS, :0010, "JST", / JSX_INS, :1335, "JSX", / JSXB_INS, :0214, "JSXB", / JSY_INS, :0014, "JSY", / LDA_INS, :0002, "LDA", / LDL_INS, :0302, "LDL", / LDLR_INS, :0501, "LDLR", / LDX_INS, :1035, "LDX", / LDY_INS, :1135, "LDY", / MPL_INS, :0316, "MPL", / MPY_INS, :0016, "MPY", / ORA_INS, :0203, "ORA", / PCL_INS, :0210, "PCL", / SBL_INS, :0307, "SBL", / STA_INS, :0004, "STA", / STL_INS, :0304, "STL", / STLR_INS, :0103, "STLR", / STX_INS, :1015, "STX", / STY_INS, :1235, "STY", / SUB_INS, :0007, "SUB", / XEC_INS, :0201, "XEC" integer mr_ad (ADDR_DESC_SIZE), ins, i, ilit, mr_code character str (20) long_int llit real flit long_real dlit equivalence (AD_LIT1(mr_ad), ilit), (AD_LIT1(mr_ad), llit), (AD_LIT1(mr_ad), flit), (AD_LIT1(mr_ad), dlit) character dpstr (20) ipointer j procedure pba forward ins = Imem (instr + 3) if (ins < 1 || ins > LAST_MR_INSTRUCTION) call panic ("put_mr: bad instr code *i*n"p, ins) # copy address descriptor into something we can pass as a chunk for ({j = instr + 4; i = 1}; i <= ADDR_DESC_SIZE; {i += 1; j += 1}) mr_ad (i) = Imem (j) if (Emit_PMA == YES) { call putch (' 'c, Outfile) call putlin (text (posn (ins + 1) + 2), Outfile) call putch (' 'c, Outfile) select (AD_MODE (mr_ad)) when (DIRECT_AM) { # address is base%+offset pba } when (INDEXED_AM) { # address is base%+offset,X pba call putlin (",X"s, Outfile) } when (INDIRECT_AM) { # address is base%+offset,* pba call putlin (",*"s, Outfile) } when (INDIRECT_POSTX_AM) { # address is base%+offset,*X pba call putlin (",*X"s, Outfile) } when (PREX_INDIRECT_AM) { # address is base%+offset,X* pba call putlin (",X*"s, Outfile) } when (ILIT_AM) { # int or uns literal operand str (1) = '='c str (2) = "'"c call gitoc (ilit, str (3), 18, -8) call putlin (str, Outfile) } when (LLIT_AM) { # long int or uns literal str (1) = '='c str (2) = "'"c call gltoc (llit, str (3), 18, -8) call putlin (str, Outfile) call putch ('L'c, Outfile) } when (FLIT_AM) { # single prec. fp literal call rtoc (dlit, dpstr, 20, -11) for (i = 1; dpstr (i) ~= EOS; i += 1) if (dpstr (i) == 'e'c) dpstr (i) = 'E'c for (i = 1; dpstr (i) == ' 'c; i += 1) ; call putch ('='c, Outfile) call putlin (dpstr (i), Outfile) } when (DLIT_AM) { # double prec. fp literal call dtoc (dlit, dpstr, 20, -11) for (i = 1; dpstr (i) ~= EOS; i += 1) if (dpstr (i) == 'e'c) dpstr (i) = 'D'c for (i = 1; dpstr (i) == ' 'c; i += 1) ; call putch ('='c, Outfile) call putlin (dpstr (i), Outfile) } when (LABELED_AM) { str (1) = 'L'c call gitoc (AD_LABEL (mr_ad), str (2), 19, -10) call putlin (str, Outfile) call putch ('_'c, Outfile) } ifany call putch (NEWLINE, Outfile) else call panic ("put_mr: bad instr operand *i*n"p, AD_MODE (mr_ad)) } if (Emit_Obj == YES) { DB call print (ERROUT, "put_mr: instruction = *i*n"p, ins) DB call print (ERROUT, " AD_MODE = *i*n AD_BASE = *i*n AD(3) = *i*n"s, DB AD_MODE (mr_ad), AD_BASE (mr_ad), AD_OFFSET (mr_ad)) DB call print (ERROUT, " AD(4) = *i*n AD(5) = *i*n"s, DB AD_LIT3 (mr_ad), AD_LIT4 (mr_ad)) call zero_lit (mr_ad) mr_code = text (posn (ins + 1) + 1) select (ins) when (JMP_INS, JST_INS, JSX_INS, JSXB_INS, JSY_INS) if (AD_MODE (mr_ad) == LABELED_AM) AD_BASE (mr_ad) = PB_REG # always for a jump or branch # to a label # as for SETUP_OWNER_INS, we have to trick the loader # into stuffing the right address into the instruction for # fwd refs. We start out hoping that we will know where # the procedure is located. If it's a fwd. ref, then we # switch the base register to the PB% so the loader will # resolve the address correctly. when (PCL_INS) AD_BASE (mr_ad) = LB_REG # for EAL, EALB, EAXB we have to assume that either we # already know the address or somebody kludged the address # descriptor for the special case of a fwd ref label (e.g., # for the location of the ecb) call otg (MR_INSTRUCTION, mr_ad, mr_code) } return # pba --- print base address (base_reg% + offset) procedure pba { local str; character str (20) select (AD_BASE(mr_ad)) when (PB_REG) str (1) = 'P'c when (SB_REG) str (1) = 'S'c when (LB_REG) str (1) = 'L'c when (XB_REG) str (1) = 'X'c str (2) = 'B'c str (3) = '%'c str (4) = '+'c str (5) = "'"c call gitoc (AD_OFFSET (mr_ad), str (6), 15, -8) call putlin (str, Outfile) } end