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

SCM Repository

[smlnj] View of /sml/trunk/src/MLRISC/Tools/MDL/mdl-gen-asm.sml
ViewVC logotype

View of /sml/trunk/src/MLRISC/Tools/MDL/mdl-gen-asm.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1003 - (download) (annotate)
Fri Dec 7 02:45:32 2001 UTC (18 years, 1 month ago) by george
File size: 11722 byte(s)
Changed the representation of instructions from being fully abstract
to being partially concrete. That is to say:

  from
	type instruction

  to
	type instr				(* machine instruction *)

	datatype instruction =
	    LIVE of {regs: C.cellset, spilled: C.cellset}
          | KILL of {regs: C.cellset, spilled: C.cellset}
          | COPYXXX of {k: CB.cellkind, dst: CB.cell list, src: CB.cell list}
          | ANNOTATION of {i: instruction, a: Annotations.annotation}
          | INSTR of instr

This makes the handling of certain special instructions that appear on
all architectures easier and uniform.

LIVE and KILL say that a list of registers are live or killed at the
program point where they appear. No spill code is generated when an
element of the 'regs' field is spilled, but the register is moved to
the 'spilled' (which is present, more for debugging than anything else).

LIVE replaces the (now deprecated) DEFFREG instruction on the alpha.
We used to generate:

	DEFFREG f1
	f1 := f2 + f3
        trapb

but now generate:

	f1 := f2 + f3
	trapb
	LIVE {regs=[f1,f2,f3], spilled=[]}

Furthermore, the DEFFREG (hack) required that all floating point instruction
use all registers mentioned in the instruction. Therefore f1 := f2 + f3,
defines f1 and uses [f1,f2,f3]! This hack is no longer required resulting
in a cleaner alpha implementation. (Hopefully, intel will not get rid of
this architecture).

COPYXXX is intended to replace the parallel COPY and FCOPY  available on
all the architectures. This will result in further simplification of the
register allocator that must be aware of them for coalescing purposes, and
will also simplify certain aspects of the machine description that provides
callbacks related to parallel copies.

ANNOTATION should be obvious, and now INSTR represents the honest to God
machine instruction set!

The <arch>/instructions/<arch>Instr.sml files define certain utility
functions for making porting easier -- essentially converting upper case
to lower case. All machine instructions (of type instr) are in upper case,
and the lower case form generates an MLRISC instruction. For example on
the alpha we have:

  datatype instr =
     LDA of {r:cell, b:cell, d:operand}
   | ...

  val lda : {r:cell, b:cell, d:operand} -> instruction
    ...

where lda is just (INSTR o LDA), etc.
(* 
 * This module generates the assembler of an architecture 
 * given a machine description.
 *
 *)
functor MDLGenAsm(Comp : MDL_COMPILE) : MDL_GEN_MODULE =
struct
   structure Comp = Comp
   structure Env  = Comp.Env
   structure Ast  = Comp.Ast
   structure R    = Comp.Rewriter
   structure T    = Comp.Trans

   open Ast Comp.Util Comp.Error

   fun gen md =
   let (* name of the functor and signature *)
       val strName = Comp.strname md "AsmEmitter"
       val sigName = "INSTRUCTION_EMITTER"

       (* Arguments of the functor *)
       val args = ["structure S : INSTRUCTION_STREAM",
		   "structure Instr : "^Comp.signame md "INSTR",
		   "   where T = S.P.T",
                   "structure Shuffle : "^Comp.signame md "SHUFFLE",
                   "   where I = Instr",
                   "structure MLTreeEval : MLTREE_EVAL",
		   "   where T = Instr.T"
                  ]
       val args = SEQdecl[$args,Comp.fctArgOf md "Assembly"]

       (* Cellkinds declared by the user *)   
       val cellKinds = Comp.cells md

       (* Assembly case *)
       val asmCase = Comp.asmCase md

       (* How to make a string expression *)
       fun mkString s =
           STRINGexp(case asmCase of VERBATIM  => s
                                   | LOWERCASE => String.map Char.toLower s
                                   | UPPERCASE => String.map Char.toUpper s)

       (* The Instruction structure *)
       val env = Env.lookupStr (Comp.env md) (IDENT([], "Instruction"))

       (* All datatype definitions in this structure *)
       val datatypeDefinitions = Env.datatypeDefinitions env

       (*
        * There are three assembly modes:
        *   EMIT: directly emit to stream
        *   ASM:  convert to string
        *   NOTHING: do nothing
        *)
       datatype mode = EMIT | ASM | NOTHING

       (*
        * Find out which assembly mode a datatype should use
        *)
       fun modeOf(DATATYPEbind{cbs, asm, ...}) = 
           let val mode = if asm then ASM else NOTHING
               fun loop([], m) = m
                 | loop(_, EMIT) = EMIT
                 | loop(CONSbind{asm=NONE, ...}::cbs, m) = loop(cbs, m)
                 | loop(CONSbind{asm=SOME(STRINGasm _), ...}::cbs, _)=
                      loop(cbs, ASM)
                 | loop(CONSbind{asm=SOME(ASMasm a), ...}::cbs, m)=
                      loop(cbs, loop2(a, ASM))
               and loop2([], m) = m
                 | loop2(EXPasm _::_, _) = EMIT
                 | loop2(_::a, m) = loop2(a, m)
           in  loop(cbs, mode) end 


       (*
        * Names of emit and assembly functions. 
        * The assembly function converts something into a string.
        * The emit function prints that to the stream for side effect.
        *)
       fun emit id = "emit_"^id
       fun asm  id = "asm_"^id 

       (*
        * How to emit special types 
        *)
       fun emitTy(id,IDty(IDENT(prefix,t)), e) =
            (case (prefix, t) of
               ([], "int")    => APP(emit t, e)
             | ([], "string") => APP("emit", e)
             | (["Constant"],"const") => APP(emit t, e)
             | (["Label"],"label") => APP(emit t, e)
             | (["T"],"labexp") => APP(emit t, e)
             | (["Region"],"region") => APP(emit t, e)
             | _ =>
                if List.exists(fn db as DATATYPEbind{id=id', ...}=> 
                                 t = id' andalso modeOf db <> NOTHING) 
                   datatypeDefinitions then
                   APP(emit t, e)
                else
                   APP(emit id, e)
            )
         | emitTy(_,CELLty "cellset", e) = APP("emit_cellset", e)
         | emitTy(_,CELLty k, e) = APP("emitCell", e)
         | emitTy(id, _, e) = APP(emit id, e)

       (* 
        * Functions to convert assembly annotations to code 
        *)
       fun mkAsms([], fbs) = rev fbs 
         | mkAsms((db as DATATYPEbind{id, cbs, ...})::dbs, fbs) = 
           (case modeOf db of
              NOTHING => mkAsms(dbs, fbs)
            | EMIT    => mkAsms(dbs, FUNbind(emit id,mkAsm(EMIT,cbs))::fbs)
            | ASM     => mkAsms(dbs, mkEmit id::
                                     FUNbind(asm id,mkAsm(ASM,cbs))::fbs)
           )

           (* fun emitXXX x = emit(asmXXX x) *)
       and mkEmit id = 
           FUNbind(emit id,[CLAUSE([IDpat "x"],NONE,
                              APP("emit",APP(asm id,ID "x")))]) 

           (* Translate backquoted expression *)
       and mkAsm(mode, cbs) = 
           let fun emitIt e =
                    if mode = EMIT then APP("emit",e) else e
               fun asmToExp E (TEXTasm s) = emitIt(mkString s) 
                 | asmToExp E (EXPasm(IDexp(IDENT([],x)))) = 
                    (let val (e, ty) = E x
                     in  emitTy(x, ty, e) end
                     handle e => 
                        fail("unknown assembly field <"^x^">")
                    )
                 | asmToExp E (EXPasm e) = 
                   let fun exp _ (ASMexp(STRINGasm s)) = emitIt(mkString s)
                         | exp _ (ASMexp(ASMasm a)) = SEQexp(map (asmToExp E) a)
                         | exp _ e = e
                   in #exp(R.rewrite{exp=exp,
                                     ty=R.noRewrite,
                                     pat=R.noRewrite,
                                     sexp=R.noRewrite,
                                     decl=R.noRewrite
                                    }
                          ) e
                   end
               fun mkClause(cb as CONSbind{id, asm, ...}) = 
               let val exp = 
                     case asm of
                       NONE => emitIt(mkString id)
                     | SOME(STRINGasm s) => emitIt(mkString s)
                     | SOME(ASMasm a) =>
                       let val consEnv = T.consBindings cb
                       in  SEQexp(map (asmToExp consEnv) a) end
               in  T.mapConsToClause {prefix=["I"],pat=fn p=>p, exp=exp} cb
               end
           in  map mkClause cbs end 

       (* 
        * For each datatype defined in the structure Instruction that
        * has pretty printing annotations attached, generate an assembly
        * function and an emit function.
        *)
       val asmFuns = FUNdecl(mkAsms(datatypeDefinitions, []))

       (* Main function for emitting an instruction *)
       val emitInstrFun = 
           let val instructions = Comp.instructions md
           in  FUN("emitInstr'", IDpat "instr", 
                           CASEexp(ID "instr", mkAsm(EMIT, instructions))
                  )
           end

       val body =
       [$["structure I  = Instr",
          "structure C  = I.C",
          "structure T  = I.T",
          "structure S  = S",
          "structure P  = S.P",
          "structure Constant = I.Constant",
          "",
          "val show_cellset = MLRiscControl.getFlag \"asm-show-cellset\"",
          "val show_region  = MLRiscControl.getFlag \"asm-show-region\"",
          "val show_cutsTo = MLRiscControl.getFlag \"asm-show-cutsto\"",
          "val indent_copies = MLRiscControl.getFlag \"asm-indent-copies\"",
          ""
        ],
        Comp.errorHandler md "AsmEmitter",
       $[ "",
          "fun makeStream formatAnnotations =",
          "let val stream = !AsmStream.asmOutStream",
          "    fun emit' s = TextIO.output(stream,s)",
          "    val newline = ref true",
          "    val tabs = ref 0",
          "    fun tabbing 0 = ()",
          "      | tabbing n = (emit' \"\\t\"; tabbing(n-1))",
          "    fun emit s = (tabbing(!tabs); tabs := 0; newline := false; emit' s)",
          "    fun nl() = (tabs := 0; if !newline then () else (newline := true; emit' \"\\n\"))",
          "    fun comma() = emit \",\"",
          "    fun tab() = tabs := 1",
          "    fun indent() = tabs := 2",
          "    fun ms n = let val s = Int.toString n",
          "               in  if n<0 then \"-\"^String.substring(s,1,size s-1)",
          "                   else s",
          "               end",
          "    fun emit_label lab = emit(P.Client.AsmPseudoOps.lexpToString(T.LABEL lab))",
	  "    fun emit_labexp le = emit(P.Client.AsmPseudoOps.lexpToString (T.LABEXP le))",
          "    fun emit_const c = emit(Constant.toString c)",
          "    fun emit_int i = emit(ms i)",
          "    fun paren f = (emit \"(\"; f(); emit \")\")",
          "    fun defineLabel lab = emit(P.Client.AsmPseudoOps.defineLabel lab^\":\\n\")",
          "    fun entryLabel lab = defineLabel lab",
          "    fun comment msg = (tab(); emit(\"/* \" ^ msg ^ \" */\\n\"))",
          "    fun annotation a = (comment(Annotations.toString a); nl())",
          "    fun getAnnotations() = error \"getAnnotations\"",
          "    fun doNothing _ = ()",
	  "    fun fail _ = raise Fail \"AsmEmitter\"",
          "    fun emit_region mem = comment(I.Region.toString mem)",
          "    val emit_region = ",
          "       if !show_region then emit_region else doNothing",
          "    fun pseudoOp pOp = (emit(P.toString pOp); emit \"\\n\")",
          "    fun init size = (comment(\"Code Size = \" ^ ms size); nl())",
          "    val emitCellInfo = AsmFormatUtil.reginfo",
          "                             (emit,formatAnnotations)",
          "    fun emitCell r = (emit(CellsBasis.toString r); emitCellInfo r)",
          "    fun emit_cellset(title,cellset) =",
          "      (nl(); comment(title^CellsBasis.CellSet.toString cellset))",
          "    val emit_cellset = ",
          "      if !show_cellset then emit_cellset else doNothing",
          "    fun emit_defs cellset = emit_cellset(\"defs: \",cellset)",
          "    fun emit_uses cellset = emit_cellset(\"uses: \",cellset)",
          "    val emit_cutsTo = ",
          "      if !show_cutsTo then AsmFormatUtil.emit_cutsTo emit",
          "      else doNothing",
          "    fun emitter instr =",
          "    let"
         ],
        asmFuns,
        Comp.declOf md "Assembly",
        emitInstrFun,
        $["   in  tab(); emitInstr' instr; nl()",
          "   end (* emitter *)",
          "   and emitInstrIndented i = (indent(); emitInstr i; nl())",
          "   and emitInstrs instrs =",
          "        app (if !indent_copies then emitInstrIndented",
          "             else emitInstr) instrs",
          "",
          "   and emitInstr(I.ANNOTATION{i,a}) =",
	  "        ( comment(Annotations.toString a);",
	  "           nl();",
          "           emitInstr i )",
          "     | emitInstr(I.LIVE{regs, spilled})  = ",
	  "         comment(\"live= \" ^ CellsBasis.CellSet.toString regs ^",
	  "                 \"spilled= \" ^ CellsBasis.CellSet.toString spilled)",
          "     | emitInstr(I.KILL{regs, spilled})  = ",
	  "         comment(\"killed:: \" ^ CellsBasis.CellSet.toString regs ^",
	  "                 \"spilled:: \" ^ CellsBasis.CellSet.toString spilled)",
          "     | emitInstr(I.INSTR i) = emitter i",  
	  "     | emitInstr _ = error \"emitInstr\"", 
          "", 
          "in  S.STREAM{beginCluster=init,",
          "             pseudoOp=pseudoOp,",
          "             emit=emitInstr,",
          "             endCluster=fail,",
          "             defineLabel=defineLabel,",
          "             entryLabel=entryLabel,",
          "             comment=comment,",
          "             exitBlock=doNothing,",
          "             annotation=annotation,",
          "             getAnnotations=getAnnotations",
          "            }",
          "end"
         ]
       ]

   in  Comp.codegen md "emit/Asm"
         [Comp.mkFct' md "AsmEmitter" args sigName body]
   end
end 

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