Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/MLRISC/x86/instructions/x86comp-instr-ext.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/x86/instructions/x86comp-instr-ext.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 599, Wed Apr 5 18:35:02 2000 UTC revision 600, Wed Apr 5 20:13:47 2000 UTC
# Line 13  Line 13 
13      (I.instruction, I.C.regmap, I.C.cellset, I.operand, I.addressing_mode) T.reducer      (I.instruction, I.C.regmap, I.C.cellset, I.operand, I.addressing_mode) T.reducer
14    
15    val compileSext :    val compileSext :
16       reducer -> {stm: (T.rexp, T.fexp) X86InstrExt.sext, an: T.an list} -> unit       reducer
17          -> {stm: (T.stm, T.rexp, T.fexp, T.ccexp) X86InstrExt.sext,
18              an: T.an list}
19            -> unit
20  end  end
21    
22    
# Line 27  Line 30 
30    structure C = I.C    structure C = I.C
31    structure X = X86InstrExt    structure X = X86InstrExt
32    
33    type stm = (T.rexp, T.fexp) X.sext    type stm = (T.stm, T.rexp, T.fexp, T.ccexp) X.sext
34    
35    type reducer =    type reducer =
36      (I.instruction, I.C.regmap, I.C.cellset, I.operand, I.addressing_mode) T.reducer      (I.instruction, I.C.regmap, I.C.cellset, I.operand, I.addressing_mode) T.reducer
# Line 42  Line 45 
45    fun compileSext reducer {stm: stm, an:T.an list} = let    fun compileSext reducer {stm: stm, an:T.an list} = let
46      val T.REDUCER{operand, emit, reduceFexp, instrStream, ...} = reducer      val T.REDUCER{operand, emit, reduceFexp, instrStream, ...} = reducer
47      val T.Stream.STREAM{emit=emitI, ...} = instrStream      val T.Stream.STREAM{emit=emitI, ...} = instrStream
48        fun fstp(sz, fstpInstr, fexp) =
49          (case fexp
50            of T.FREG(sz', f) =>
51                if sz <> sz' then error "fstp: sz"
52                else emitI(fstpInstr(I.FDirect f))
53             | _ => error "fstp: fexp"
54          (*esac*))
55    in    in
56      case stm      case stm
57      of X.PUSHL(rexp) => emit(I.PUSHL(operand rexp), an)      of X.PUSHL(rexp) => emit(I.PUSHL(operand rexp), an)
58       | X.PUSHf{sz, fexp} => let       | X.POP(rexp)   => emit(I.POP(operand rexp), an)
          fun inRange f = let  
            val {high, low} = C.cellRange C.FP  
          in low <= f andalso f <= high  
          end  
59    
60           fun alloc(size) =       | X.FSTPS(fexp) => fstp(32, I.FSTPS, fexp)
61             emitI(I.BINARY{binOp=I.SUBL, src=I.Immed size, dst=espOpnd});       | X.FSTPL(fexp) => fstp(64, I.FSTPL, fexp)
62         | X.FSTPT(fexp) => fstp(80, I.FSTPT, fexp)
63    
64           fun copyf(f, fld, fstp, size) =       | X.LEAVE       => emit(I.LEAVE, an)
65             (emitI(fld(I.FDirect f));       | X.RET(rexp)   => emit(I.RET(SOME(operand rexp)), an)
             alloc(size);  
             emitI(I.BINARY{binOp=I.ADDL, src=I.Immed size, dst=espOpnd});  
             emit(fstp(I.Displace{base=esp, disp=I.Immed(0), mem=stackArea}), an))  
        in  
          case fexp  
          of T.FREG(_, f) =>  
             if inRange(f) then error "compileSext: FREG: inRange"  
             else (case sz  
               of X.single => copyf(f, I.FLDS, I.FSTPS, 4)  
                | X.double => copyf(f, I.FLDL, I.FSTPL, 8)  
                | X.extended => error "compileSext: FREG: sz=80"  
               (*esac*))  
          | _ => let  
               val f = reduceFexp(fexp)  
               fun pushf(size, fstp) =  
                 (alloc(size);  
                  emit(fstp(I.Displace{base=esp, disp=I.Immed(0), mem=stackArea}), an))  
             in  
                case sz  
                of X.single => pushf(4, I.FSTPS)  
                 | X.double => pushf(8, I.FSTPL)  
                 | X.extended => error "compileSext: fexp: sz=80"  
             end  
         (*esac*)  
        end  
66    end    end
67  end  end

Legend:
Removed from v.599  
changed lines
  Added in v.600

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0