diff options
Diffstat (limited to 'web/noweb/examples/mipscoder.nw')
-rw-r--r-- | web/noweb/examples/mipscoder.nw | 1118 |
1 files changed, 1118 insertions, 0 deletions
diff --git a/web/noweb/examples/mipscoder.nw b/web/noweb/examples/mipscoder.nw new file mode 100644 index 0000000000..a97f30774e --- /dev/null +++ b/web/noweb/examples/mipscoder.nw @@ -0,0 +1,1118 @@ +\section{A small assembler for the MIPS} +This is part of the code generator for Standard ML of New Jersey. +We generate code in several stages. +This is nearly the lowest stage; it is like an assembler. +The user can call any function in the [[MIPSCODER]] signature. +Each one corresponds to an assembler pseudo-instruction. +Most correspond to single MIPS instructions. +The assembler remembers all the instructions that have been +requested, and when [[codegen]] is called it generates MIPS +code for them. + +Some other structure will be able to use the MIPS structure to implement +a [[CMACHINE]], which is the abstract machine that ML thinks it is running +on. +(What really happens is a functor maps some structure +implementing [[MIPSCODER]] to a different structure implementing +[[CMACHINE]].) + +{\em Any function using a structure of this signature must avoid +touching registers 1~and~31. +Those registers are reserved for use by the assembler.} + +@ Here is the signature of the assembler, [[MIPSCODER]]. +It can be extracted from this file by +$$\hbox{\tt notangle mipsinstr.nw -Rsignature}.$$ +<<signature>>= +signature MIPSCODER = sig + +(* Assembler for the MIPS chip *) + +eqtype Label +datatype Register = Reg of int + (* Registers 1 and 31 are reserved for use by this assembler *) +datatype EA = Direct of Register | Immed of int | Immedlab of Label + (* effective address *) + +structure M : sig + + (* Emit various constants into the code *) + + val emitstring : string -> unit (* put a literal string into the + code (null-terminated?) and + extend with nulls to 4-byte + boundary. Just chars, no + descriptor or length *) + exception BadReal of string + val low_order_offset : int (* does the low-order word of a + floating point literal come + first (0) or second (1) *) + val realconst : string -> unit (* emit a floating pt literal *) + val emitlong : int -> unit (* emit a 4-byte integer literal *) + + + (* Label bindings and emissions *) + + val newlabel : unit -> Label (* new, unbound label *) + val define : Label -> unit (* cause the label to be bound to + the code about to be generated *) + val emitlab : int * Label -> unit (* L3: emitlab(k,L2) is equivalent to + L3: emitlong(k+L2-L3) *) + + (* Control flow instructions *) + + val slt : Register * EA * Register -> unit + (* (operand1, operand2, result) *) + (* set less than family *) + val beq : bool * Register * Register * Label -> unit + (* (beq or bne, operand1, operand2, branch address) *) + (* branch equal/not equal family *) + + val jump : Register -> unit (* jump register instruction *) + + val slt_double : Register * Register -> unit + (* floating pt set less than *) + val seq_double : Register * Register -> unit + (* floating pt set equal *) + val bcop1 : bool * Label -> unit (* floating pt conditional branch *) + + + (* Arithmetic instructions *) + (* arguments are (operand1, operand2, result) *) + + val add : Register * EA * Register -> unit + val and' : Register * EA * Register -> unit + val or : Register * EA * Register -> unit + val xor : Register * EA * Register -> unit + val sub : Register * Register * Register -> unit + val div : Register * Register * Register -> unit + (* first arg is some register + guaranteed to overflow when + added to itself. Used to + detect divide by zero. *) + val mult : Register * Register * Register -> unit + val mfhi : Register -> unit (* high word of 64-bit multiply *) + + (* Floating point arithmetic *) + + val neg_double : Register * Register -> unit + val mul_double : Register * Register * Register -> unit + val div_double : Register * Register * Register -> unit + val add_double : Register * Register * Register -> unit + val sub_double : Register * Register * Register -> unit + + (* Move pseudo-instruction : move(src,dest) *) + + val move : EA * Register -> unit + + (* Load and store instructions *) + (* arguments are (destination, source address, offset) *) + + val lbu : Register * EA * int -> unit (* bytes *) + val sb : Register * EA * int -> unit + val lw : Register * EA * int -> unit (* words *) + val sw : Register * EA * int -> unit + val lwc1: Register * EA * int -> unit (* floating point coprocessor *) + val swc1: Register * EA * int -> unit + val lui : Register * int -> unit + + (* Shift instructions *) + (* arguments are (shamt, operand, result) *) + (* shamt as Immedlab _ is senseless *) + + val sll : EA * Register * Register -> unit + val sra : EA * Register * Register -> unit + + + (* Miscellany *) + + val align : unit -> unit (* cause next data to be emitted on + a 4-byte boundary *) + val mark : unit -> unit (* emit a back pointer, + also called mark *) + + val comment : string -> unit + + end (* signature of structure M *) + + val codegen : unit->unit + + val codestats : outstream -> unit (* write statistics on stream *) + +end (* signature MIPSCODER *) +@ The basic strategy of the implementation is to hold on, via the [[kept]] +pointer, to the list of instructions generated so far. +We use [[instr]] for the type of an instruction, so +[[kept]] has type [[instr list ref]]. + +The instructions will be executed in the following order: the +instruction at the head of the [[!kept]] is executed last. +This enables us to accept calls in the order of execution but +add the new instruction(s) to the list in constant time. + + +@ +We structure the instruction stream a little bit by factoring +out the different load and store instructions that can +occur: we have load byte, load word, and load to coprocessor (floating point). +<<types auxiliary to [[instr]]>>= +datatype size = Byte | Word | Floating +@ +Here are the instructions that exist. +We list them in more or less the order of the MIPSCODER signature. +<<definition of [[instr]]>>= +<<types auxiliary to [[instr]]>> + +datatype instr = + STRINGCONST of string (* constants *) + | EMITLONG of int + + | DEFINE of Label (* labels *) + | EMITLAB of int * Label + + | SLT of Register * EA * Register (* control flow *) + | BEQ of bool * Register * Register * Label + | JUMP of Register + | SLT_D of Register * Register + | SEQ_D of Register * Register + | BCOP1 of bool * Label + + | NOP (* no-op for delay slot *) + + | ADD of Register * EA * Register (* arithmetic *) + | AND of Register * EA * Register + | OR of Register * EA * Register + | XOR of Register * EA * Register + | SUB of Register * Register * Register + | MULT of Register * Register + | DIV of Register * Register + | MFLO of Register (* mflo instruction used with + 64-bit multiply and divide *) + | MFHI of Register + + | NEG_D of Register * Register + | MUL_D of Register * Register * Register + | DIV_D of Register * Register * Register + | ADD_D of Register * Register * Register + | SUB_D of Register * Register * Register + + | MOVE of EA * Register (* put something into a register *) + | LDI_32 of int * Register (* load in a big immediate constant (>16 bits) *) + | LUI of Register * int (* Mips lui instruction *) + + | LOAD of size * Register * EA * int (* load and store *) + | STORE of size * Register * EA * int + + | SLL of EA * Register * Register (* shift *) + | SRA of EA * Register * Register + + | COMMENT of string (* generates nothing *) + | MARK (* a backpointer *) + + | BREAK of int (* break instruction *) +@ +Here is the code that handles the generated stream, [[kept]]. +It begins life as [[nil]] and returns to [[nil]] every time code is +generated. +The function [[keep]] is a convenient way of adding a single [[instr]] to +the list; it's very terse. +Sometimes we have to add multiple [[instr]]s; then we use [[keeplist]]. +We also define a function [[delay]] that is just like a [[keep]] but +it adds a NOP in the delay slot. +<<instruction stream and its functions>>= + val kept = ref nil : instr list ref + fun keep f a = kept := f a :: !kept + fun delay f a = kept := NOP :: f a :: !kept + fun keeplist l = kept := l @ !kept +<<reinitialize [[kept]]>>= + kept := nil +@ +\subsection{Exporting functions for {\tt MIPSCODER}} +We now know enough to implement most of the functions called for in +[[MIPSCODER]]. +We still haven't decided on an implementation of labels, +and there is one subtlety in multiplication and division, +but the rest is set. +<<[[MIPSCODER]] functions>>= + val emitstring = keep STRINGCONST (* literals *) + exception BadReal = IEEEReal.BadReal + val low_order_offset = Emitter.low_order_offset + val realconst = keep (STRINGCONST o order_real o IEEEReal.realconst) + val emitlong = keep EMITLONG + + <<label functions>> (* labels *) + + val slt = keep SLT (* control flow *) + val beq = delay BEQ + val jump = delay JUMP + val slt_double = delay SLT_D + val seq_double = delay SEQ_D + val bcop1 = delay BCOP1 + + val add = keep ADD (* arithmetic *) + val and' = keep AND + val or = keep OR + val xor = keep XOR + val op sub = keep SUB + <<multiplication and division functions>> + + val neg_double = keep NEG_D + val mul_double = keep MUL_D + val div_double = keep DIV_D + val add_double = keep ADD_D + val sub_double = keep SUB_D + + val move = keep MOVE + + fun lbu (a,b,c) = delay LOAD (Byte,a,b,c) (* load and store *) + fun lw (a,b,c) = delay LOAD (Word,a,b,c) + fun lwc1 (a,b,c) = delay LOAD (Floating,a,b,c) + fun sb (a,b,c) = keep STORE (Byte,a,b,c) + fun sw (a,b,c) = keep STORE (Word,a,b,c) + fun swc1 (a,b,c) = delay STORE (Floating,a,b,c) + val lui = keep LUI + + val sll = keep SLL (* shift *) + val sra = keep SRA + + fun align() = () (* never need to align on MIPS *) + val mark = keep (fn () => MARK) + val comment = keep COMMENT +@ +Multiplication has a minor complication; the +result has to be fetched from the LO register. +<<multiplication and division functions>>= +fun mult (op1, op2, result) = keeplist [MFLO result, MULT (op1, op2)] +val mfhi = keep MFHI +@ +Division has a major complication; I must test for divide by zero since +the hardware does not. +If the divisor is zero, I cause an overflow exception by +adding [[limitreg]] to itself. +<<multiplication and division functions>>= +fun op div (op1, op2, result) = + let val next = newlabel() + in keeplist [ + MFLO result, (* get the result *) + DEFINE next, (* skip to here if nonzero *) + BREAK 7, (* signals zerodivide *) + DIV (op1, op2), (* divide in delay slot *) + BEQ (false, Reg 0, op2, next) (* skip if divisor nonzero *) + ] + end +@ +For now, labels are just pointers to integers. +During code generation, those integers will be set to positions +in the instruction stream, and then they'll be useful as addresses +relative to the program counter pointer (to be held in [[Reg pcreg]]). +<<definition of [[Label]]>>= + type Label = int ref +<<label functions>>= + fun newlabel () = ref 0 + val define = keep DEFINE + val emitlab = keep EMITLAB +@ +Here's the overall plan of this structure: +<<*>>= +functor MipsCoder(Emitter: EMITTER) : MIPSCODER = struct + + open Emitter + <<definition of [[Label]]>> + + datatype Register = Reg of int + + datatype EA = Direct of Register + | Immed of int + | Immedlab of Label + + <<definition of [[instr]]>> + + <<instruction stream and its functions>> + + structure M = struct + <<[[MIPSCODER]] functions>> + end + + open M + + <<functions that assemble [[instr]]s into code>> + + <<statistics>> + +end (* MipsInstr *) +@ \subsection{Sizes of {\tt instr}s} +Now let's consider the correspondence between our [[instr]] type and the +actual MIPS instructions we intend to emit. +One important problem to solve is figuring out how big things are, +so that we know what addresses to generate for the various labels. +We will also want to know what address is currently stored in the program +counter regsiter ([[pcreg]]), +because we'll need to know when something is close +enough that we can use a sixteen-bit address relative to that register. +The kind of address we can use will determine how big things are. + +We'll rearrange the code so that we have a list of [[ref int * instr]] pairs, +where the [[ref int]] stores the position in the list. +(Positions start at zero.) +Since in the MIPS all instructions are the same size, we measure +position as number of instructions. +While we're at it, we reverse the list so that the head will execute first, +then the rest of the list. + +We begin with each position set to zero, and make a pass over the list +trying to set the value of each position. +We do this by estimating the size of (number of MIPS instructions +generated for) each [[instr]]. +Since there are forward references, we may not have all the distances right +the first time, so we have to make a second pass. +But during this second pass we could find that something is further +away than we thought, and we have to switch from using a pc-relative mode to +something else (or maybe grab the new pc?), which changes the size again, +and moves things even further away. +Because we can't control this process, we just keep making passes over the +list until the process quiesces (we get the same size twice). + +In order to guarantee termination, we have to make sure later passes only +increase the sizes of things. +This is sufficient since there is a maximum number of MIPS instructions +we can generate for each [[instr]]. + + +While we're at it, we might want to complicate things by making the function +that does the passes also emit code. +For a single pass we hand an optional triple of emitters, the initial position, +an [[int option]] for the program counter pointer (if known), and the +instructions. + + + +I'm not sure what explains the use of the [[ref int]] to track the position, +instead of just an [[int]]---it might be a desire to avoid the +overhead of creating a bunch of new objects, or it might be really hard +to do the passes cheaply. +It should think a variation on [[map]] would do the job, but maybe I'm +missing something. + +@ +[[emit : int * int -> unit]] emits one instruction, +and [[emit_string : int -> string -> unit]] emits a string constant. +[[emit_string]] could be specified as a function of [[emit]], +but the nature of the function would depend on whether the target +machine was little-endian or big-endian, and we don't want to have +that dependency built in. + + [[instrs]] is the +list of instructions (in execute-head-last order). + +The second argument to [[pass]] indicates for what instructions code +is to be generated. +It is a record (position of next instruction, program counter pointer if any, +remaining instructions to generate [with positions]). + +\indent [[prepare]] produces two results: the instruction stream with +size pointers added, and the total size of code to be generated. +We add the total size because that is the only way to find the number +of [[bltzal]]s, which are implicit in the instruction stream. + +<<assembler>>= +fun prepare instrs = + let fun add_positions(done, inst::rest) = + add_positions( (ref 0, inst) :: done, rest) + | add_positions(done, nil) = done + + val instrs' = add_positions(nil, instrs) (* reverse and add [[ref int]]s*) + + fun passes(oldsize) = + (* make passes with no emission until size is stable*) + let val size = pass false (0,NONE,instrs') + in if size=oldsize then size + else passes size + end + in {size = passes 0, stream = instrs'} + end + +fun assemble instrs = + pass true (0,NONE,#stream (prepare instrs)) + +<<functions that assemble [[instr]]s into code>>= +fun get (SOME x) = x + | get NONE = ErrorMsg.impossible "missing pcptr in mipscoder" + +<<[[pcptr]] functions>> +<<single pass>> +<<assembler>> + +fun codegen () = ( + assemble (!kept); + <<reinitialize [[kept]]>> + ) +@ +The program counter pointer is a device that enables us to to addressing +relative to the pcp register, register 31. +The need for it arises when we want to access a data element which we know +only by its label. +The labels give us addresses relative to the beginning of the function, +but we can only use addresses relative to some register. +The answer is to set register~31 with a [[bltzal]] instruction, +then use that for addressing. + +The function [[needs_a_pcptr]] determines when it is necessary +to have a known value in register~31. +That is, we need the program counter pointer +\begin{itemize} +\item +at [[NOP]] for a reason to be named later? +\item +at any operation that uses an effective address that refers to a label +(since all labels have to be relative to the program counter). +\item +BEQ's and BCOP1's to very far away, +since we have to compute the address for a JUMP +knowing the value of the program counter pointer. +\end{itemize} +<<[[pcptr]] functions>>= +fun needs_a_pcptr(_,SLT(_,Immedlab _,_)) = true + | needs_a_pcptr(_,ADD(_,Immedlab _,_)) = true + | needs_a_pcptr(_,AND(_,Immedlab _,_)) = true + | needs_a_pcptr(_,OR(_,Immedlab _,_)) = true + | needs_a_pcptr(_,XOR(_,Immedlab _,_)) = true + | needs_a_pcptr(_,MOVE(Immedlab _,_)) = true + | needs_a_pcptr(_,LOAD(_,_,Immedlab _,_)) = true + | needs_a_pcptr(_,STORE(_,_,Immedlab _,_)) = true + | needs_a_pcptr(_,SLL(Immedlab _,_,_)) = true + | needs_a_pcptr(_,SRA(Immedlab _,_,_)) = true + | needs_a_pcptr(1, BEQ _) = false (* small BEQ's dont need pcptr *) + | needs_a_pcptr(_, BEQ _) = true (* but large ones do *) + | needs_a_pcptr(1, BCOP1 _) = false (* small BCOP1's dont need pcptr *) + | needs_a_pcptr(_, BCOP1 _) = true (* but large ones do *) + | needs_a_pcptr _ = false +@ +Creating the program counter pointer once, with a [[bltzal]], is not +enough; we have to invalidate the program counter pointer at every +label, since control could arrive at the label from God knows where, and +therefore we don't know what the program counter pointer is. + +We use the function [[makepcptr]] to create a new program counter pointer +``on the fly'' while generating code for other [[instrs]]. +(I chose not to create a special [[instr]] for [[bltzal]], which I +could have inserted at appropriate points in the instruction stream.) +To try and find an odd bug, I'm adding no-ops after each [[bltzal]]. +I don't really believe they're necessary. + +The function [[gen]], which generates the instructions (or computes +their size), takes three arguments. +Third: the list of instructions to be generated (paired with pointers +to their sizes); first: the position (in words) at which to generate +those instructions; second: the current value of the program counter +pointer (register~31), if known. + +The mutual recursion between [[gen]] and [[makepcptr]] maintains +the program counter pointer. +[[gen]] invalidates it at labels, and calls [[makepcptr]] to create a valid +one when necessary (as determined by [[needs_a_pcptr]]). +<<single pass>>= +fun pass emit_now = +let fun makepcptr(i,x) = + (* may need to emit NOP for delay slot if next instr is branch *) + let val size = case x of ((_,BEQ _)::rest) => 2 + | ((_,BCOP1 _)::rest) => 2 + | _ => 1 + in if emit_now then (emit(Opcodes.bltzal(0,0)); + if size=2 then emit(Opcodes.add(0,0,0)) else ()) + else (); + gen(i+size, SOME (i+2), x) + end +and gen(i,_,nil) = i + | gen(i, _, (_,DEFINE lab) :: rest) = (lab := i; gen(i,NONE, rest)) + (* invalidate the pc pointer at labels *) + (* may want to do special fiddling with NOPs *) + | gen(pos, pcptr, x as ((sizeref as ref size, inst) :: rest)) = + if (pcptr=NONE andalso needs_a_pcptr(size, inst)) then makepcptr(pos,x) + else if emit_now + then + <<emit MIPS instructions>> + else + <<compute positions>> +in gen +end + +@ \subsection{Generating the instructions} +Now we need to consider the nitty-gritty details of just what instructions +are generated for each [[instr]]. +In early passes, we'll just need to know how many instructions are +required (and that number may change from pass to pass, so it must be +recomputed). +In the last pass, the sizes are stable (by definition), so we can look +at the sizes to see what instructions to generate. + +We'll consider the [[instrs]] in groups, but first, here's the +way we will structure things: +<<compute positions>>= +let <<functions for computing sizes>> + val newsize = case inst of + <<cases for sizes to be computed>> +in if newsize > size then sizeref := newsize else (); + gen(pos+(!sizeref) (* BUGS -- was pos+size*),pcptr,rest) +end +<<emit MIPS instructions>>= +let fun gen1() = gen(pos+size,pcptr,rest) + (* generate the rest of the [[instr]]s *) + open Bits + open Opcodes + <<declare reserved registers [[tempreg]] and [[pcreg]]>> + <<functions for emitting instructions>> +in case inst of + <<cases of instructions to be emitted>> +end +@ When we get around to generating code, we may need to use a temporary +register. +For example, if we want to load into a register +an immediate constant that won't fit +into 16~bits, we will have to load the high-order part of the constant +with [[lui]], then use [[addi]] to add then the low-order part. +The MIPS assembler has a similar problem, and on page D-2 of +the MIPS book we notice that register~1 is reserved for the use of the +assembler. +So we do the same. + +We need to reserve a second register for use in pointing to the program +counter. +We will use register 31 because the [[bltzal]] instruction automatically +sets register 31 to the PC. +<<declare reserved registers [[tempreg]] and [[pcreg]]>>= +val tempreg = 1 +val pcreg = 31 +@ +Before showing the code for the actual instructions, we should +point out that +we have two different ways of emitting a long word. +[[emitlong]] just splits the bits into two pieces for those cases +when it's desirable to put a word into the memory image. +[[split]] gives something that will load correctly +when the high-order piece is loaded into a high-order halfword +(using [[lui]]), +and the low-order piece is sign-extended and then added to the +high-order piece. +This is the way we load immediate constants of more than sixteen bits. +It is also useful for generating load or store instructions with +offsets of more than sixteen bits: we [[lui]] the [[hi]] part and +add it to the base regsiter, then use the [[lo]] part as an offset. +<<functions for emitting instructions>>= +fun emitlong i = emit(rshift(i,16), andb(i,65535)) + (* emit one long word (no sign fiddling) *) +fun split i = let val hi = rshift(i,16) and lo = andb(i,65535) + in if lo<32768 then (hi,lo) else (hi+1, lo-65536) + end + +@ We begin implementing [[instrs]] by considering those that emit constants. +String constants are padded with nulls out to a word boundary. +Integer constants are just emitted with [[emitlong]]. +<<cases for sizes to be computed>>= + STRINGCONST s => Integer.div(String.length(s)+3,4) +| EMITLONG _ => 1 +<<cases of instructions to be emitted>>= + STRINGCONST s => + let val s' = s ^ "\000\000\000\000" + in gen1(emit_string (4*size) s') + (* doesn't know Big vs Little-Endian *) + end +| EMITLONG i => gen1(emitlong i) +@ +Next consider the labels. +A [[DEFINE]] should never reach this far, and [[EMITLAB]] is almost like +an [[EMITLONG]]. +<<cases for sizes to be computed>>= +| DEFINE _ => ErrorMsg.impossible "generate code for DEFINE in mipscoder" +| EMITLAB _ => 1 +<<cases of instructions to be emitted>>= +| DEFINE _ => gen1(ErrorMsg.impossible "generate code for DEFINE in mipscoder") +| EMITLAB(i, ref d) => gen1(emitlong((d-pos)*4+i)) +@ +Now we have to start worrying about instructions with [[EA]] in them. +The real difficulty these things present is that they may have an +immediate operand that won't fit in 16~bits. +So we'll need to get this large immediate operand into a register, +sixteen bits at a time, and then do the operation on the register. + +Since all of the arithmetic instructions have this difficulty, and since +we can use them to implement the others, we'll start with those and +catch up with the control-flow instructions later. +@ [[SUB]], [[MULT]], [[DIV]], and [[MFLO]] all use registers only, +so they are easy. +The other arithmetic operations get treated exactly the same, so we'll +use a function to compute the size. +{\bf move this to follow the definition of [[arith]]?} +<<cases for sizes to be computed>>= +| ADD(_, ea, _) => easize ea +| AND(_, ea, _) => easize ea +| OR (_, ea, _) => easize ea +| XOR(_, ea, _) => easize ea +| SUB _ => 1 +| DIV (_,_) => 1 +| MULT (_,_) => 1 +| MFLO _ => 1 +| MFHI _ => 1 +@ Register operations take one instruction. +Immediate operations take one instruction for 16~bit constants, +and 3 for larger constants (since it costs two instructions to load +a big immediate constant into a register). +An immediate instruction with [[Immedlab l]] means that the operand +is intended to be the machine address associated with that label. +To compute that address, we need to add +[[4*(l-pcptr)]] to the contents of +register~[[pcreg]] (which holds [[4*pcptr]]), +put the results in a register, and operate on that register. + +This tells us enough to compute the sizes. +<<functions for computing sizes>>= +fun easize (Direct _) = 1 + | easize (Immed i) = if abs(i)<32768 then 1 else 3 + | easize (Immedlab(ref lab)) = 1 + easize(Immed (4*(lab-(get pcptr)))) +@ +As we have seen, +to implement any arithmetic operation, we need to know the register +form and the sixteen-bit immediate form. +We will also want the operator from [[instr]], since we do the +large immediate via a recursive call. +We'll set up a function, [[arith]], that does the job. +<<functions for emitting instructions>>= +fun arith (opr, rform, iform) = + let fun ar (Reg op1, Direct (Reg op2), Reg result) = + gen1(emit(rform(result,op1,op2))) + | ar (Reg op1, Immed op2, Reg result) = + (case size of + 1 (* 16 bits *) => gen1(emit(iform(result,op1,op2))) + | 3 (* 32 bits *) => + gen(pos,pcptr, + (ref 2, LDI_32(op2, Reg tempreg)):: + (ref 1, opr(Reg op1, Direct(Reg tempreg), Reg result)):: + rest) + | _ => gen(ErrorMsg.impossible + "bad size in arith Immed in mipscoder") + ) + | ar (Reg op1, Immedlab (ref op2), Reg result) = + gen(pos, pcptr, + (ref (size-1), + ADD(Reg pcreg,Immed(4*(op2-(get pcptr))), Reg tempreg)):: + (ref 1, opr(Reg op1, Direct(Reg tempreg), Reg result)):: + rest) + in ar + end +@ +The generation itself may be a bit anticlimactic. +The MIPS has no ``subtract immediate'' instruction, and [[SUB]] has +a different type than the others, so we emit it directly. +<<cases of instructions to be emitted>>= +| ADD stuff => arith (ADD,add,addi) stuff +| AND stuff => arith (AND,and',andi) stuff +| OR stuff => arith (OR,or,ori) stuff +| XOR stuff => arith (XOR,xor,xori) stuff +| SUB (Reg op1, Reg op2, Reg result) => gen1(emit(sub(result,op1,op2))) +| DIV (Reg op1, Reg op2) => gen1(emit(div(op1,op2))) +| MULT(Reg op1, Reg op2) => gen1(emit(mult(op1,op2))) +| MFLO(Reg result) => gen1(emit(mflo(result))) +| MFHI(Reg result) => gen1(emit(mfhi(result))) +@ Floating point arithmetic is pretty easy because we always do it in +registers. +We also support only one format, double precision. +<<cases for sizes to be computed>>= +| NEG_D _ => 1 +| MUL_D _ => 1 +| DIV_D _ => 1 +| ADD_D _ => 1 +| SUB_D _ => 1 +@ When emitting instructions we have to remember the Mips instructions +use result on the left, but the [[MIPSCODER]] signature requires result +on the right. +<<cases of instructions to be emitted>>= +| NEG_D (Reg op1,Reg result) => gen1(emit(neg_fmt(D_fmt,result,op1))) +<<functions for emitting instructions>>= +fun float3double instruction (Reg op1,Reg op2,Reg result) = + gen1(emit(instruction(D_fmt,result,op1,op2))) +<<cases of instructions to be emitted>>= +| MUL_D x => float3double mul_fmt x +| DIV_D x => float3double div_fmt x +| ADD_D x => float3double add_fmt x +| SUB_D x => float3double sub_fmt x + + +@ We offer a separate [[MOVE]] instruction because of large immediate +constants. +It is always possible to do [[move(src,dest)]] by doing +[[add(Reg 0,src,dest)]], but the general form [[add(Reg i, Immed c, dest)]] +takes three instructions when [[c]] is a large constant (more than 16 bits). +Rather than clutter up the code for [[add]] (and [[or]] and [[xor]]) by +trying to recognize register~0, we provide [[move]] explicitly. + +\indent [[LDI_32]] takes care of the particular case in which we are +loading a 32-bit immediate constant into a register. +It dates from the bad old days before [[MOVE]], and it might be a good idea +to remove it sometime. +<<functions for emitting instructions>>= +fun domove (Direct (Reg src), Reg dest) = gen1(emit(add(dest,src,0))) + | domove (Immed src, Reg dest) = + (case size of + 1 (* 16 bits *) => gen1(emit(addi(dest,0,src))) + | 2 (* 32 bits *) => + gen(pos,pcptr,(ref 2, LDI_32(src, Reg dest))::rest) + | _ => gen(ErrorMsg.impossible "bad size in domove Immed in mipscoder") + ) + | domove (Immedlab (ref src), Reg dest) = + gen(pos, pcptr, + (ref size, + ADD(Reg pcreg,Immed(4*(src-(get pcptr))), Reg dest))::rest) +@ Notice we use [[easize]] and not [[movesize]] in the third clause +because when we reach this point the treatment of a [[MOVE]] is the same +as that of an [[ADD]]. +<<functions for computing sizes>>= +fun movesize (Direct _) = 1 + | movesize (Immed i) = if abs(i)<32768 then 1 else 2 + | movesize (Immedlab(ref lab)) = easize(Immed (4*(lab-(get pcptr)))) + +<<cases for sizes to be computed>>= +| MOVE (src,_) => movesize src +| LDI_32 _ => 2 +| LUI _ => 1 +<<cases of instructions to be emitted>>= +| MOVE stuff => domove stuff +| LDI_32 (immedconst, Reg dest) => + let val (hi,lo) = split immedconst + in gen1(emit(lui(dest,hi));emit(addi(dest,dest,lo))) + end +| LUI (Reg dest,immed16) => gen1(emit(lui(dest,immed16))) + +@ +Now that we've done arithmetic, we can see how to do control flow without +too much trouble. +[[SLT]] can be treated just like an arithmetic operator. +[[BEQ]] is simple if the address to which we branch is close enough. +Otherwise we use the following sequence for [[BEQ(Reg op1, Reg op2, ref dest)]]: +\begin{verbatim} + bne op1,op2,L + ADD (Reg pcreg, Immed (4*(dest-pcptr)), Reg tempreg) + jr tempreg + L: ... +\end{verbatim} +Notice we don't have to put a [[NOP]] in the delay slot of the [[bne]]. +We don't need one after the jump unless we needed one after the +original [[BEQ]], in which case one will be there. +If the branch is taken, we're doing as well as we can. +If the branch is not taken, we will have executed an [[add]] or [[lui]] in the +delay slot of the [[bne]], but the results just get thrown away. +<<cases for sizes to be computed>>= +| SLT(_, ea, _) => easize ea +| BEQ(_,_,_,ref dest) => + if abs((pos+1)-dest) < 32768 then 1 (* single instruction *) + else 2+easize (Immed (4*(dest-(get pcptr)))) +| JUMP _ => 1 +| SLT_D _ => 1 +| SEQ_D _ => 1 +| BCOP1(_,ref dest) => + if abs((pos+1)-dest) < 32768 then 1 (* single instruction *) + else 2+easize (Immed (4*(dest-(get pcptr)))) +| NOP => 1 +@ The implementation is as described, except we use a +non-standard [[nop]]. +There are many Mips instructions that have no effect, and the standard +one is the word with all zeroes ([[sll 0,0,0]]). +We use [[add]], adding 0 to 0 and store the result in 0, because it +will be easy to distinguish from a data word that happens to be zero. +<<cases of instructions to be emitted>>= +| SLT stuff => arith (SLT,slt,slti) stuff +| BEQ(b, Reg op1, Reg op2, ref dest) => + if size = 1 then + gen1(emit((if b then beq else bne)(op1,op2,dest-(pos+1)))) + else gen(pos,pcptr, + (ref 1, BEQ(not b, Reg op1, Reg op2, ref(pos+size))) + ::(ref (size-2), + ADD(Reg pcreg, Immed(4*(dest-(get pcptr))), Reg tempreg)) + ::(ref 1, JUMP(Reg tempreg)) + ::rest) +| JUMP(Reg dest) => gen1(emit(jr(dest))) +| SLT_D (Reg op1, Reg op2) => + gen1(emit(c_lt(D_fmt,op1,op2))) +| SEQ_D (Reg op1, Reg op2) => + gen1(emit(c_seq(D_fmt,op1,op2))) +| BCOP1(b, ref dest) => + let fun bc1f offset = cop1(8,0,offset) + fun bc1t offset = cop1(8,1,offset) + in if size = 1 then + gen1(emit((if b then bc1t else bc1f)(dest-(pos+1)))) + else gen(pos,pcptr, + (ref 1, BCOP1(not b, ref(pos+size))) + ::(ref (size-2), + ADD(Reg pcreg, Immed(4*(dest-(get pcptr))), Reg tempreg)) + ::(ref 1, JUMP(Reg tempreg)) + ::rest) + end +| NOP => gen1(emit(add(0,0,0))) (* one of the many MIPS no-ops *) +@ +Our next problem is to tackle load and store. +The major difficulty is if the offset is too large to fit in +sixteen bits; if so, we have to create a new base register. +If we have [[Immedlab]], we do it as an offset from [[pcreg]]. +<<functions for emitting instructions>>= +fun memop(rform,Reg dest, Direct (Reg base), offset) = + (case size + of 1 => gen1(emit(rform(dest,offset,base))) + | 3 => let val (hi,lo) = split offset + in gen1(emit(lui(tempreg,hi)); (* tempreg = hi @<< 16 *) + emit(add(tempreg,base,tempreg));(* tempreg += base *) + emit(rform(dest,lo,tempreg)) (* load dest,lo(tempreg) *) + ) + end + | _ => gen1(ErrorMsg.impossible "bad size in memop Direct in mipscoder") + ) + | memop(rform,Reg dest, Immed address, offset) = + (case size + of 1 => gen1(emit(rform(dest,offset+address,0))) + | 2 => let val (hi,lo) = split (offset+address) + in gen1(emit(lui(tempreg,hi)); + emit(rform(dest,lo,tempreg)) + ) + end + | _ => gen1(ErrorMsg.impossible "bad size in memop Immed in mipscoder") + ) + | memop(rform,Reg dest, Immedlab (ref lab), offset) = + memop(rform, Reg dest, Direct (Reg pcreg), offset+4*(lab - get pcptr)) +@ The actual registers don't matter for computing sizes, and in fact +the value of [[pcreg]] is not visible here, so we use an arbitrary +register ([[Reg 0]]) to compute the size. +<<functions for computing sizes>>= +fun adrsize(_, Reg _, Direct _, offset) = + if abs(offset)<32768 then 1 else 3 + | adrsize(_, Reg _, Immed address, offset) = + if abs(address+offset) < 32768 then 1 else 2 + | adrsize(x, Reg dest, Immedlab (ref lab), offset) = + adrsize(x, Reg dest, Direct (Reg 0 (* pcreg in code *) ), + offset+4*(lab-(get pcptr))) +<<cases for sizes to be computed>>= +| LOAD x => adrsize x +| STORE x => adrsize x +<<cases of instructions to be emitted>>= +| LOAD (Byte,dest,address,offset) => memop(lbu,dest,address,offset) +| LOAD (Word,dest,address,offset) => memop(lw,dest,address,offset) +| LOAD (Floating,dest,address,offset) => memop(lwc1,dest,address,offset) +| STORE (Byte,dest,address,offset) => memop(sb,dest,address,offset) +| STORE (Word,dest,address,offset) => memop(sw,dest,address,offset) +| STORE (Floating,dest,address,offset) => memop(swc1,dest,address,offset) +@ +For the shift instructions, only register and immediate operands +make sense. +Immediate operands make sense if and only if they are representable +in five bits. +If everything is right, these are single instructions. +<<cases for sizes to be computed>>= +| SLL _ => 1 +| SRA _ => 1 +<<cases of instructions to be emitted>>= +| SLL (Immed shamt, Reg op1, Reg result) => gen1( + if (shamt >= 0 andalso shamt < 32) then emit(sll(result,op1,shamt)) + else ErrorMsg.impossible ("bad sll shamt " + ^ (Integer.makestring shamt) ^ " in mipscoder")) +| SLL (Direct(Reg shamt), Reg op1, Reg result) => + gen1(emit(sllv(result,op1,shamt))) +| SLL (Immedlab _,_,_) => ErrorMsg.impossible "sll shamt is Immedlab in mipscoder" +| SRA (Immed shamt, Reg op1, Reg result) => gen1( + if (shamt >= 0 andalso shamt < 32) then emit(sra(result,op1,shamt)) + else ErrorMsg.impossible ("bad sra shamt " + ^ (Integer.makestring shamt) ^ " in mipscoder")) +| SRA (Direct(Reg shamt), Reg op1, Reg result) => + gen1(emit(srav(result,op1,shamt))) +| SRA (Immedlab _,_,_) => ErrorMsg.impossible "sra shamt is Immedlab in mipscoder" +@ +Finally, comments are ignored, and marks (backpointers) are written into the +instruction stream. + +Comments are used by the front end to give diagnostics. +In the bad old days we would have had two different [[MIPSCODER]]s, one +which generated machine code (and ignored comments), and one which +wrote out assembly code (and copied comments). +Today we have just one, which means the rerouting of comments takes place +at a much higher level. Look in [[cps/mipsglue.nw]]. +<<cases for sizes to be computed>>= +| COMMENT _ => 0 +| MARK => 1 (* backpointer takes one word *) +| BREAK _ => 1 (* break instruction *) +@ Just for the record, here's the description of what a mark (backpointer) +is. +``Take the byte address at which the mark resides and add 4, giving +the byte address of the object following the mark. +(That object is the marked object.) +Subtract the byte address of the initial word that marks the +start of this instruction stream. +Now divide by 4, giving the distance in words between the +beginning of the block and the marked object. +Take that quantity and shift it left by multiplying by [[power_tags]], +and indicate the result is a mark by adding the tag bits [[tag_backptr]] +into the low order part.'' + [[pos+1]] is exactly the required distance in words. +<<cases of instructions to be emitted>>= +| COMMENT _ => gen1() +| MARK => gen1( + let open System.Tags + in emitlong((pos+1) * power_tags + tag_backptr) + end) +| BREAK n => gen1( + if n < 0 orelse n > 32 then ErrorMsg.impossible "bad break code" + else emit(break n)) +@ +\subsection{Optimization} +The first step towards optimization is to take statistics. +We will count: [[instrs]], Mips words, [[NOP]]s in load and branch delays, +and [[bltzal]]s. +In the current implementation the [[bltzal]]s are implicit, so there +is no way to count them or optimize them. +<<statistics>>= +fun printstats stream + {inst : int, code : int, data : int, + load : int, branch : int, compare : int, size : int} = + let val print = output stream + val nop = load+branch+compare + val bltzal = size - (code + data) + val code = code + bltzal + <<definition of [[sprintf]]>> + fun P x = substring(makestring(100.0 * x),0,4) (* percent *) + fun printf f d = print (sprintf f d) + in printf ["Counted "," instrs in "," words (", + " code, "," data)\n" ^ + "Used "," NOPs ("," load, "," branch,"," compare) and "," bltzals\n" ^ + "","% of code words were NOPs; ","% were bltzals\n" ^ + "","% of all words were code; ","% of all words were NOPs\n"] + [I inst, I size, I code, I data, + I nop, I load, I branch, I compare, I bltzal, + P (real nop / real code), P (real bltzal / real code), + P (real code / real size), P (real nop / real size)] + handle Overflow => print "[Overflow in computing Mips stats]\n" + end + +<<statistics>>= +<<definition of [[iscode]]>> +fun addstats (counts as {inst,code,data,load,branch,compare}) = + fn nil => counts + | (sizeref,first)::(_,NOP)::rest => addstats + {inst=inst+2, code=code+(!sizeref)+1, data=data, + load=load+ (case first of LOAD _ => 1 | _ => 0), + branch=branch +(case first of BEQ _ => 1 | JUMP _ => 1 + | BCOP1 _ => 1 | _ => 0), + compare=compare+(case first of SLT_D _ => 1 | SEQ_D _ => 1 + | _ => 0) + } rest + | (sizeref,first)::rest => addstats + {inst=inst+1, + code = code + if iscode(first) then !sizeref else 0, + data = data + if not (iscode first) then !sizeref else 0, + load=load, + branch=branch, + compare=compare + } rest + + +fun codestats outfile = + let val {size,stream=instrs} = prepare (!kept) + val zero = {inst=0, code=0, data=0, load=0, branch=0, compare=0} + val counts as {inst,code,data,load,branch,compare} = + addstats zero instrs + in printstats outfile + {inst=inst,code=code,data=data, + load=load,branch=branch,compare=compare,size=size} + end + +<<definition of [[iscode]]>>= +val iscode = fn + STRINGCONST _ => false + | EMITLONG _ => false + | DEFINE _ => false + | EMITLAB _ => false + + | SLT _ => true + | BEQ _ => true + | JUMP _ => true + | NOP => true + | SLT_D _ => true + | SEQ_D _ => true + | BCOP1 _ => true + + | ADD _ => true + | AND _ => true + | OR _ => true + | XOR _ => true + | SUB _ => true + | MULT _ => true + | DIV _ => true + | MFLO _ => true + | MFHI _ => true + + | NEG_D _ => true + | MUL_D _ => true + | DIV_D _ => true + | ADD_D _ => true + | SUB_D _ => true + + | MOVE _ => true + | LDI_32 _ => true + | LUI _ => true + + | LOAD _ => true + | STORE _ => true + + | SLL _ => true + | SRA _ => true + + | COMMENT _ => false + | MARK => false + | BREAK _ => true + +<<definition of [[sprintf]]>>= +val I = Integer.makestring +val R = Real.makestring +exception Printf +fun sprintf format values = + let fun merge([x],nil) = [x] + | merge(nil,nil) = nil + | merge(x::y,z::w) = x::z:: merge(y,w) + | merge _ = raise Printf + in implode(merge(format,values)) + end + +@ +At the moment these functions are meaningless junk. +<<functions that remove pipeline bubbles>>= +val rec squeeze = + + fn (x as LOAD(_,Reg d, m, i))::NOP::instr::rest => + if use(instr,d) then ?? + else squeeze(x::instr::rest) + | (x as STORE _)::(y as LOAD _)::rest => + x :: squeeze(y::rest) + | instr::(x as LOAD(_,Reg d, Direct(Reg s), i))::NOP::rest => + if use(instr, d) orelse gen(instr, s) then ?? + else squeeze(x::instr::rest) + | instr::(x as LOAD(_,Reg d, _, i))::NOP::rest => + if use(instr,d) then ?? + else squeeze(x::instr::rest) + | (x as MFLO _):: (y as MULDIV _) :: rest => + x :: squeeze (y::rest) + | (x as MFLO(Reg d))::instr::rest => + if (use(instr,d) orelse gen(instr,d) then ?? + else squeeze(instr::x::rest) + | instr :: (x as MULDIV(Reg a, Reg b)) :: rest => + if gen(instr,a) orelse gen(instr,b) then ?? + else squeeze(x::instr::rest) + +val rec final = + fn + | instr::(x as LOAD(_,Reg d, Direct(Reg s), i))::NOP::rest => + if gen(instr, s) then instr::final(x::NOP::rest) + else x::instr::(final rest) + | instr :: (x as JUMP _) :: NOP :: rest => + x :: instr :: final rest + | instr :: (x as BEQ(_,Reg a, Reg b, _)) :: NOP :: rest => + if gen(instr,a) orelse gen(instr,b) then instr::x::NOP::(final rest) + else x::instr::(final rest) +@ +\section{Indices} +\subsection{Chunks} +\nowebchunks +\subsection{Identifiers} +\nowebindex |