Return to mips.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / mips

Annotation of researchv10no/cmd/sml/src/mips/mips.sml, revision 1.1

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: functor MipsCM(MipsC : MIPSCODER) : CMACHINE = struct
        !             3: 
        !             4:     open MipsC System.Tags
        !             5: 
        !             6:     fun three f (Direct x, ea, Direct y) = f(x,ea,y)
        !             7:       | three f (ea, Direct x, Direct y) = f(x,ea,y)
        !             8:       | three f _ =ErrorMsg.impossible "neither arg to three f is register in mips"
        !             9: 
        !            10: 
        !            11:     val immed = Immed
        !            12:     fun isimmed(Immed i) = SOME i
        !            13:       | isimmed _ = NONE
        !            14:     
        !            15:     fun isreg(Direct(Reg i)) = SOME i | isreg _ = NONE
        !            16:     fun eqreg (a: EA) b = a=b
        !            17:     
        !            18: 
        !            19: 
        !            20:     val standardarg = Direct(Reg 2)
        !            21:     val standardcont = Direct(Reg 3)
        !            22:     val standardclosure = Direct(Reg 4)
        !            23:     val miscregs = map (Direct o Reg) [5,6,7,8,9,10,11,12,13,14,
        !            24:                                        15,16,17,18,19]
        !            25:     val storeptr as Direct storeptr' = Direct(Reg 22)
        !            26:     val dataptr  as Direct dataptr'  = Direct(Reg 23)
        !            27:     val exnptr = Direct(Reg 30)
        !            28:     
        !            29:       (* internal use only *)
        !            30:     val my_arithtemp as Direct my_arithtemp'= Direct(Reg 20) 
        !            31:     val my_ptrtemp as Direct my_ptrtemp' = Direct(Reg 21)
        !            32:     
        !            33:       (* exported for external use *)
        !            34:     val arithtemp as Direct arithtemp' = Direct(Reg 24) 
        !            35:     val arithtemp2 as Direct arithtemp2'= Direct(Reg 25)
        !            36: 
        !            37: 
        !            38:     fun move (src,Direct dest) = M.move(src, dest)
        !            39:       | move _ = ErrorMsg.impossible "destination of move not register in mips"
        !            40:     val align = M.align
        !            41:     val mark = M.mark
        !            42:     
        !            43:     val emitlong = M.emitlong
        !            44:     val realconst = M.realconst
        !            45:     val emitstring = M.emitstring
        !            46: 
        !            47:     fun emitlab(i,Immedlab lab) = M.emitlab(i,lab)
        !            48:       | emitlab _ = ErrorMsg.impossible "bad emitlab arg in mips"
        !            49:     fun newlabel() = Immedlab(M.newlabel())
        !            50:     fun define (Immedlab lab) = M.define lab
        !            51:       | define _ = ErrorMsg.impossible "bad define arg in mips"
        !            52:     fun record(vl, Direct z) =
        !            53:         let open CPS
        !            54:             val len = List.length vl
        !            55:             fun f(i,nil) = ()
        !            56:               | f(i,(r, SELp(j,p))::rest) = (* follow ptrs to get the item *)
        !            57:                     (M.lw(my_ptrtemp', r, j*4); f(i,(my_ptrtemp,p)::rest))
        !            58:               | f(i,(Direct r,OFFp 0)::rest) =  (* simple store, last first *) 
        !            59:                     (M.sw(r, dataptr, i*4); f(i-1,rest))
        !            60:               | f(i,(Direct r, OFFp j)::rest) = 
        !            61:                     (M.add(r, Immed(4*j), my_ptrtemp'); 
        !            62:                                     f(i,(my_ptrtemp,OFFp 0)::rest))
        !            63:               | f(i,(ea,p)::rest) = (* convert to register-based *)
        !            64:                     (M.move(ea, my_ptrtemp'); f(i,(my_ptrtemp,p)::rest))
        !            65:           in f(len - 1, rev vl); (* store first word in [[0(dataptr')]] *)
        !            66:              M.add(dataptr', Immed 4, z);
        !            67:              M.add(dataptr', Immed(4*len), dataptr')
        !            68:          end
        !            69:        | record _ = ErrorMsg.impossible "result of record not register in mips"
        !            70:     
        !            71:     fun select(i, r, Direct s) = M.lw(s, r, i*4)
        !            72:       | select _ = ErrorMsg.impossible "result of select not register in mips"
        !            73:     
        !            74:     fun offset(i, Direct r, Direct s) = M.add(r,Immed(i*4), s)
        !            75:       | offset _ = ErrorMsg.impossible "nonregister arg to offset in mips"
        !            76:     (* fetchindexb(x,y) fetches a byte: y <- mem[x+arithtemp]
        !            77:             y cannot be arithtemp *)
        !            78:     fun fetchindexb(x,Direct y) =
        !            79:         (M.add(arithtemp',x,my_arithtemp');    
        !            80:          M.lbu(y,my_arithtemp,0))
        !            81:       | fetchindexb _ = ErrorMsg.impossible "fetchb result not register in mips"
        !            82:     
        !            83:     (* storeindexb(x,y) stores a byte: mem[y+arithtemp] <- x; *)
        !            84:     fun storeindexb(Direct x,y) =
        !            85:         (M.add(arithtemp',y,my_arithtemp');
        !            86:          M.sb(x,my_arithtemp,0))
        !            87:       | storeindexb _ = ErrorMsg.impossible "storeb arg not register in mips"
        !            88:     
        !            89:     (* jmpindexb(x)    pc <- (x+arithtemp) *)
        !            90:     fun jmpindexb x = (M.add(arithtemp',x,my_arithtemp');
        !            91:                          M.jump(my_arithtemp'))
        !            92: 
        !            93:        (* fetchindexl(x,y,z) fetches a word:   y <- mem[x+2*(z-1)] *)
        !            94:        (* storeindexl(x,y,z) stores a word:    mem[y+2*(z-1)] <- x *)
        !            95:     
        !            96:     fun fetchindexl(x,Direct y, Direct z) = 
        !            97:           (M.sll(Immed 1,z,my_arithtemp');
        !            98:            M.add(my_arithtemp',x,my_arithtemp');
        !            99:            M.lw(y, my_arithtemp,~2))
        !           100:       | fetchindexl(x,Direct y, Immed z) = M.lw(y, x, z+z-2)
        !           101:       | fetchindexl _ = ErrorMsg.impossible "fetchl result not register in mips"
        !           102:     
        !           103:     fun storeindexl(Direct x,y, Immed 1) = M.sw(x,y,0)
        !           104:       | storeindexl(Direct x,y,Direct z) = 
        !           105:         (M.sll(Immed 1,z,my_arithtemp');
        !           106:          M.add(my_arithtemp',y,my_arithtemp');
        !           107:          M.sw(x, my_arithtemp,~2))
        !           108:       | storeindexl(Direct x,y,Immed z) = M.sw(x,y,z+z-2)
        !           109:     
        !           110:       | storeindexl(Direct _,_,Immedlab _) =
        !           111:        ErrorMsg.impossible "storeindexl(Direct _,_,Immedlab _) in mips"
        !           112:     
        !           113:       | storeindexl(Immedlab label,y,z) =
        !           114:         (M.move(Immedlab label,my_ptrtemp');
        !           115:          storeindexl(my_ptrtemp,y,z))
        !           116:     
        !           117:       | storeindexl(Immed constant,y,offset) =
        !           118:        (M.move(Immed constant,my_ptrtemp');
        !           119:         storeindexl(my_ptrtemp,y,offset))
        !           120: 
        !           121:     val addl3 = three M.add
        !           122:     
        !           123:     fun subl3(Immed k, x, y) = addl3(x, Immed(~k), y)
        !           124:       | subl3(Direct x, Direct y, Direct z) = M.sub(y,x,z)
        !           125:       | subl3(x, Immed k, dest) = 
        !           126:                 (M.move(Immed k, my_arithtemp');
        !           127:                  subl3(x, my_arithtemp, dest))
        !           128:       | subl3 _ = ErrorMsg.impossible "subl3 args don't match in mips"
        !           129:     
        !           130:     fun mull2(Direct x, Direct y) = M.mult(y,x,y)
        !           131:       | mull2(Immed x, Direct y) = (M.move(Immed x,my_arithtemp');
        !           132:                                M.mult(y,my_arithtemp',y))
        !           133:       | mull2 _ = ErrorMsg.impossible "mull2 args don't match in mips"
        !           134:     fun divl2(Direct x, Direct y) = M.div(y,x,y)
        !           135:       | divl2(Immed x, Direct y) = (M.move(Immed x,my_arithtemp');
        !           136:                                M.div(y,my_arithtemp',y))
        !           137:       | divl2 _ = ErrorMsg.impossible "divl2 args don't match in mips"
        !           138: 
        !           139:     fun ashr(shamt, Direct op1, Direct result) = M.sra(shamt,op1,result)
        !           140:       | ashr(shamt, Immed op1, Direct result) = 
        !           141:        (M.move(Immed op1,my_arithtemp'); M.sra(shamt,my_arithtemp',result))
        !           142:       | ashr _ = ErrorMsg.impossible "ashr args don't match in mips"
        !           143:     fun ashl(shamt, Direct op1, Direct result) = M.sll(shamt,op1,result)
        !           144:       | ashl(shamt, Immed op1, Direct result) = 
        !           145:        (M.move(Immed op1,my_arithtemp'); M.sll(shamt,my_arithtemp',result))
        !           146:       | ashl _ = ErrorMsg.impossible "ashl args don't match in mips"
        !           147:     val addl3t = addl3
        !           148:     val subl3t = subl3
        !           149:     val ashlt = ashl
        !           150:     fun mull2t(x,y as Direct y') = 
        !           151:         let val ok = M.newlabel()
        !           152:         in  mull2(x,y);
        !           153:        M.mfhi(my_arithtemp');
        !           154:        M.slt(y',Direct (Reg 0),my_ptrtemp'); (* 0 or 1 OK in pointer *)
        !           155:        M.add(my_arithtemp',my_ptrtemp,my_arithtemp');
        !           156:        M.beq(true,my_arithtemp',Reg 0,ok);    (* OK if not overflow *)
        !           157:        M.lui(my_arithtemp',32767);
        !           158:        M.add(my_arithtemp',my_arithtemp,my_arithtemp');  (* overflows *)
        !           159:        M.define(ok)
        !           160:         end
        !           161:       | mull2t _ = ErrorMsg.impossible "result of mull2t not register in mips"
        !           162: 
        !           163:     val orb = three M.or
        !           164:     val andb = three M.and'
        !           165:     fun notb (a,b) = subl3(a, Immed ~1, b) (* ~1 - a == one's complement *)
        !           166:     val xorb = three M.xor
        !           167:     datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR
        !           168:     local 
        !           169:     fun makeibranch reverse = 
        !           170:     let
        !           171:     fun ibranch (cond, Immed a, Immed b, Immedlab label) =
        !           172:                 if (case cond of EQL => a=b | NEQ => a<>b | LSS => a<b |
        !           173:                                  LEQ => a<=b | GTR => a>b | GEQ => a>=b)
        !           174:                     then M.beq(true,Reg 0, Reg 0, label) else ()
        !           175:       | ibranch (NEQ, Direct r, Direct s, Immedlab label) =
        !           176:                         M.beq(false, r, s, label)
        !           177:       | ibranch (NEQ, Direct r, x, Immedlab label) =
        !           178:                         (M.move(x, my_arithtemp');
        !           179:                          M.beq(false, r, my_arithtemp', label))
        !           180:       | ibranch (EQL, Direct r, Direct s, Immedlab label) =
        !           181:                         M.beq(true, r, s, label)
        !           182:       | ibranch (EQL, Direct r, x, Immedlab label) =
        !           183:                         (M.move(x, my_arithtemp');
        !           184:                          M.beq(true, r, my_arithtemp', label))
        !           185:       | ibranch (LSS, Direct r, x, Immedlab lab) =
        !           186:                     (M.slt(r,x,my_arithtemp');
        !           187:                      M.beq(false,Reg 0, my_arithtemp',lab))
        !           188:       | ibranch (GEQ, Direct r, x, Immedlab lab) =
        !           189:                     (M.slt(r,x,my_arithtemp'); 
        !           190:                      M.beq(true,Reg 0, my_arithtemp',lab))
        !           191:       | ibranch (GTR, x, Direct r, Immedlab lab) =
        !           192:                     (M.slt(r,x,my_arithtemp'); 
        !           193:                      M.beq(false,Reg 0, my_arithtemp',lab))
        !           194:       | ibranch (LEQ, x, Direct r, Immedlab lab) =
        !           195:                     (M.slt(r,x,my_arithtemp'); 
        !           196:                      M.beq(true,Reg 0, my_arithtemp',lab))
        !           197:     (* These two cases added to prevent infinite reversal *)
        !           198:       | ibranch (GTR, Direct r, x, Immedlab lab) =
        !           199:                (M.move(x, my_arithtemp');
        !           200:                 M.slt(my_arithtemp',Direct r,my_arithtemp');
        !           201:                 M.beq(false,Reg 0,my_arithtemp',lab))
        !           202:       | ibranch (LEQ, Direct r, x, Immedlab lab) =
        !           203:                (M.move(x, my_arithtemp');
        !           204:                 M.slt(my_arithtemp',Direct r,my_arithtemp');
        !           205:                 M.beq(true,Reg 0,my_arithtemp',lab))
        !           206:       | ibranch (_, Immedlab _, Immedlab _, _) = 
        !           207:                     ErrorMsg.impossible "bad ibranch args 1 in mips"
        !           208:       | ibranch (_, Immedlab _, _, _) = 
        !           209:                     ErrorMsg.impossible "bad ibranch args 1a in mips"
        !           210:       | ibranch (_, _, Immedlab _, _) = 
        !           211:                     ErrorMsg.impossible "bad ibranch args 1b in mips"
        !           212:       | ibranch (_, _, _, Direct _) = 
        !           213:                     ErrorMsg.impossible "bad ibranch args 2 in mips"
        !           214:       | ibranch (_, _, _, Immed _) = 
        !           215:                     ErrorMsg.impossible "bad ibranch args 3 in mips"
        !           216:       | ibranch (cond, x, y, l) = 
        !           217:             let fun rev LEQ = GEQ
        !           218:                   | rev GEQ = LEQ
        !           219:                   | rev LSS = GTR
        !           220:                   | rev GTR = LSS
        !           221:                   | rev NEQ = NEQ
        !           222:                   | rev EQL = EQL
        !           223:             in  if reverse then (makeibranch false) (rev cond, y,x,l) 
        !           224:            else ErrorMsg.impossible "infinite ibranch reversal in mips"
        !           225:        
        !           226:             end
        !           227:     in ibranch
        !           228:     end
        !           229:     in
        !           230:     val ibranch = makeibranch true
        !           231:     end
        !           232:         
        !           233:     fun jmp (Direct r) = M.jump(r)
        !           234:       | jmp (Immedlab lab) = M.beq(true,Reg 0,Reg 0,lab)
        !           235:       | jmp (Immed i) = ErrorMsg.impossible "jmp (Immed i) in mips"
        !           236:     
        !           237:     
        !           238:             (* branch on bit set *)
        !           239:     fun bbs (Immed k, Direct y, Immedlab label) =
        !           240:             (M.and'(y,Immed (Bits.lshift(1,k)),my_arithtemp');
        !           241:              M.beq(false,my_arithtemp',Reg 0,label))
        !           242:       | bbs _ = ErrorMsg.impossible "bbs args don't match in mips"
        !           243: 
        !           244: 
        !           245:     val floatop1 = Reg 0
        !           246:     val floatop2 = Reg 2
        !           247:     val floatresult = Reg 0
        !           248:     
        !           249:     val real_tag = Immed(8*System.Tags.power_tags + System.Tags.tag_string)
        !           250:     
        !           251:     fun store_float(Reg n,ea,offset) = 
        !           252:         if n mod 2 <> 0 then ErrorMsg.impossible "bad float reg in mips"
        !           253:         else (M.swc1(Reg (n+1),ea,offset+4);M.swc1(Reg n,ea,offset))
        !           254:     
        !           255:     fun finish_real (Direct result) = (
        !           256:         store_float(floatresult,dataptr,4);
        !           257:         M.move(real_tag,my_arithtemp');
        !           258:         M.sw(my_arithtemp',dataptr,0);
        !           259:         M.add(dataptr',Immed 4,result);
        !           260:         M.add(dataptr',Immed 12,dataptr'))
        !           261:       | finish_real _ = 
        !           262:          ErrorMsg.impossible "ptr to result of real operation not register in mips"
        !           263:     
        !           264:     fun load_float(Reg dest,src,offset) =
        !           265:         if dest mod 2 <> 0 then ErrorMsg.impossible "bad float reg in mips"
        !           266:         else (M.lwc1(Reg dest,src,offset); M.lwc1(Reg (dest+1),src,offset+4))
        !           267:     
        !           268:     fun two_float instruction (op1,result) = (
        !           269:         load_float(floatop1,op1,0);
        !           270:         instruction(floatop1,floatresult);
        !           271:         finish_real(result))
        !           272:     
        !           273:     fun three_float instruction (op1,op2,result) = (
        !           274:         load_float(floatop1,op1,0);
        !           275:         load_float(floatop2,op2,0);
        !           276:         instruction(floatop1,floatop2,floatresult);
        !           277:         finish_real(result))
        !           278:     
        !           279:     val mnegg = two_float M.neg_double
        !           280:     val mulg3 = three_float M.mul_double
        !           281:     val divg3 = three_float M.div_double
        !           282:     val addg3 = three_float M.add_double
        !           283:     val subg3 = three_float M.sub_double
        !           284:     
        !           285:     
        !           286:     local
        !           287:         fun compare(LSS,op1,op2) = (M.slt_double(op1,op2); true)
        !           288:           | compare(GEQ,op1,op2) = (M.slt_double(op1,op2); false)
        !           289:           | compare(EQL,op1,op2) = (M.seq_double(op1,op2); true)
        !           290:           | compare(NEQ,op1,op2) = (M.seq_double(op1,op2); false)
        !           291:           | compare(LEQ,op1,op2) = compare(GEQ,op2,op1)
        !           292:           | compare(GTR,op1,op2) = compare(LSS,op2,op1)
        !           293:     in
        !           294:         fun gbranch (cond, op1, op2, Immedlab label) = (
        !           295:                 load_float(floatop1,op1,0);
        !           296:                 load_float(floatop2,op2,0);
        !           297:                 M.bcop1(compare(cond,floatop1,floatop2),label))
        !           298:           | gbranch _ = ErrorMsg.impossible "insane gbranch target in mips.nw"
        !           299:     end
        !           300:        
        !           301:     
        !           302:     fun checkLimit max_allocation = M.sw(Reg 0, dataptr, max_allocation-4)
        !           303:                              (* store zero in last location to be used *)
        !           304:     
        !           305: 
        !           306: 
        !           307:     fun beginStdFn _ = ()           (* do nothing, just like the Vax *)
        !           308:     
        !           309:     fun profile(i,incr) = ()
        !           310: 
        !           311: 
        !           312:     val comment = M.comment
        !           313: 
        !           314: (* +DEBUG *)
        !           315:     fun diag (s : string) f x =
        !           316:        f x handle e =>
        !           317:                (print "?exception "; print (System.exn_name e);
        !           318:                 print " in mips."; print s; print "\n";
        !           319:                 raise e)
        !           320:     
        !           321:     val emitlab = diag "emitlab" emitlab
        !           322:     val define = diag "define" define
        !           323:     
        !           324:     
        !           325:     val record = diag "record" record
        !           326:     val select = diag "select" select
        !           327:     val offset = diag "offset" offset
        !           328:     
        !           329:     val fetchindexb = diag "fetchindexb" fetchindexb
        !           330:     val storeindexb = diag "storeindexb" storeindexb
        !           331:     val jmpindexb = diag "jmpindexb" jmpindexb
        !           332:     
        !           333:     
        !           334:     val fetchindexl = diag "fetchindexl" fetchindexl
        !           335:     val storeindexl = diag "storeindexl" storeindexl
        !           336:     
        !           337:     
        !           338:     val ashr = diag "ashr" ashr
        !           339:     val ashl = diag "ashl" ashl
        !           340:     
        !           341:     val orb = diag "orb" orb
        !           342:     val andb = diag "andb" andb
        !           343:     val notb = diag "notb" notb
        !           344:     val xorb = diag "xorb" xorb
        !           345:     
        !           346:     
        !           347:     val addl3 = diag "addl3" addl3
        !           348:     val subl3 = diag "subl3" subl3
        !           349:     val mull2 = diag "mull2" mull2
        !           350:     val divl2 = diag "divl2" divl2
        !           351:     
        !           352:     
        !           353:     val addl3t = diag "addl3t" addl3t
        !           354:     val subl3t = diag "subl3t" subl3t
        !           355:     val mull2t = diag "mull2t" mull2t
        !           356:     val ashlt = diag "ashlt" ashlt
        !           357:     
        !           358:     
        !           359:     val ibranch = diag "ibranch" ibranch
        !           360:     val jmp = diag "jmp" jmp
        !           361:     val bbs = diag "bbs" bbs
        !           362: 
        !           363: (* -DEBUG *)
        !           364: 
        !           365: end (* MipsCM *)
        !           366: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.