Return to ns32.sml CVS log

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

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

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: functor NS32CM(V : NS32CODER) : CMACHINE = struct
        !             3: 
        !             4: structure V' : sig datatype Register = Genreg of int
        !             5:                                     | FloatReg of int
        !             6:                                     | FP
        !             7:                                     | SP
        !             8:                                     | SB
        !             9:                                     | PC
        !            10: 
        !            11:                   eqtype Label sharing type Label = V.Label
        !            12:                   datatype Size = Byte | Word | Long
        !            13:                        
        !            14:                   datatype EA = Direct of Register
        !            15:                               | Topofstack
        !            16:                               | Displace of int * Register
        !            17:                               | Immed of int
        !            18:                               | Immedlab of Label
        !            19:                               | Abs of int
        !            20:                               | OffAddress of Label * int
        !            21:                               | Index of EA * Register * Size
        !            22: 
        !            23:                end = V
        !            24: open V' System.Tags
        !            25: 
        !            26: datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR
        !            27: 
        !            28: fun address lab = OffAddress(lab,0)    (* old Address style *)
        !            29: 
        !            30: fun defer(Direct r) = Displace(0,r)
        !            31:   | defer(Immedlab lab) = address lab
        !            32:   | defer(Displace z) = ErrorMsg.impossible "defer of displace in cpsns32"
        !            33:   | defer _ = ErrorMsg.impossible "defer in cpsns32"
        !            34: 
        !            35: val sp' = SP
        !            36: val exnptr = Displace(0, SB)
        !            37: val dataptr as Direct dataptr' = Direct(FP)
        !            38: val arithtemp as Direct arithtemp' = Direct(Genreg 6)
        !            39: val arithtemp2 = Direct(Genreg 7)
        !            40: val storeptr = Displace(4, SB)
        !            41: val standardclosure = Direct(Genreg 2)
        !            42: val standardarg = Direct(Genreg 0)
        !            43: val standardcont = Direct(Genreg 1)
        !            44: val miscregs : EA list = map (Direct o Genreg) [3,4]
        !            45: val ptrtemp = Direct(Genreg 5)
        !            46: 
        !            47: fun newlabel() = Immedlab(V.newlabel())
        !            48: fun emitlab(i,Immedlab lab) = V.emitlab(i,lab)
        !            49: fun define (Immedlab lab) = V.define lab
        !            50: fun beginStdFn _ = ()
        !            51: 
        !            52: val align = V.align
        !            53: val mark = V.mark
        !            54: 
        !            55: fun move(Immedlab l, dest as Direct(Genreg x)) = V.lea(address l, dest)
        !            56:   | move(Immedlab l, dest) = (* This via ptrtemp probably not needed BUGBUG *)
        !            57:            (V.lea(address l, ptrtemp);
        !            58:             move(ptrtemp, dest))
        !            59: (* Only runtime knows about SB and MOD registers.
        !            60:    We use SB as a base for our pseudo-registers.
        !            61:   | move(src as Direct(SB), dest) = V.sprl(src, dest)
        !            62:   | move(src, dest as Direct(SB)) = V.lprl(src, dest)
        !            63:  *)
        !            64:   | move(src as Direct(FP), dest) = V.sprl(src, dest)
        !            65:   | move(src, dest as Direct(FP)) = V.lprl(src, dest)
        !            66:   | move x = V.movl x
        !            67: 
        !            68: (* checkLimit (n):
        !            69:  * Generate code to check the heap limit to see if there is enough free space
        !            70:  * to allocate n bytes.
        !            71:  *)
        !            72: fun checkLimit maxAllocSize = (
        !            73:       V.comment ("begin fun, max alloc = "^(makestring maxAllocSize)^"\n");
        !            74:     (* Check the heap limit by writing to the dataptr+maxAllocSize-4 *)
        !            75:       move(Immed 0, Displace(maxAllocSize-4, dataptr')))
        !            76: 
        !            77: val emitlong = V.emitlong
        !            78: val realconst = V.realconst
        !            79: val emitstring = V.emitstring
        !            80: 
        !            81: fun jmpindexb lab = V.jump(Index(defer lab, arithtemp', Byte))
        !            82: 
        !            83: fun record(vl, z) =
        !            84:     let open CPS
        !            85:        val len = List.length vl
        !            86:        fun f(i,nil) = ()
        !            87:          | f(i,(Direct r, SELp(j,p))::rest) = f(i,(Displace(j*4,r),p)::rest)
        !            88:          | f(i,(Immedlab l, p)::rest) = (V.lea(address l, ptrtemp);
        !            89:                                          f(i, (ptrtemp,p)::rest))
        !            90:          | f(i,(x,OFFp 0)::rest) = (move(x,Displace(i*4,dataptr'));
        !            91:                                     f(i-1,rest))
        !            92:          | f(i,(Direct r, OFFp j)::rest) = (V.lea(Displace(j*4,r),
        !            93:                                                   Displace(i*4,dataptr'));
        !            94:                                                 f(i-1,rest))
        !            95:          | f(i,(x,p)::rest) = (move(x,ptrtemp); f(i,(ptrtemp,p)::rest))
        !            96:       in
        !            97:         f(len - 2, rev vl);
        !            98:         move(dataptr,z);
        !            99:          V.lea(Displace(4*len, dataptr'), ptrtemp);
        !           100:          move(ptrtemp, dataptr)
        !           101: (*         V.addl(Immed(4*len), dataptr)       *)
        !           102:      end
        !           103: 
        !           104: fun select(i, Direct r, s) = move(Displace(i*4,r),s)
        !           105:   | select(0, a, s) = move(defer a, s) (* BUGBUG *)
        !           106: 
        !           107: fun offset(i, Direct r, s) = V.lea(Displace(i*4,r),s)
        !           108: 
        !           109: exception Three
        !           110: fun three opcode (a,b,c) = 
        !           111:            if b=c then opcode(a,b) 
        !           112:            else if a=c then (move(a,ptrtemp); three opcode(ptrtemp,b,c))
        !           113:            else (move(b,c); opcode(a,c))
        !           114: 
        !           115: (* opcode is commutative *)
        !           116: fun threec opcode (a,b,c) = 
        !           117:             if b=c then opcode(a,c)
        !           118:             else if a=c then opcode(b,c)
        !           119:             else (move(b,c); opcode(a,c))
        !           120: 
        !           121: (* opcode(x,y) is bop(y,anti(x)) *)
        !           122: fun threeab opcode anti bop (a,b,c) = 
        !           123:             if b=c then opcode(a,c)
        !           124:             else if a=c then (anti(c,c); bop(b,c))
        !           125:             else (move(b,c); opcode(a,c))
        !           126: 
        !           127: (* The use of three here is silly.
        !           128:    If opcode is commutative, then only one move should ever
        !           129:    be necessary, not two, as in the middle case of above.
        !           130:    Also note that we have few registers, so folding is likely.
        !           131:    The only non-commutative 3-operation here is subl3.
        !           132:    Subtraction may require a move, but in this case we should
        !           133:    do a negate instead of a move, then add.
        !           134:  *)
        !           135: 
        !           136: val addl3 = threec V.addl
        !           137: val addl3t = addl3
        !           138: val subl3 = threeab V.subl V.negl V.addl
        !           139: val subl3t = subl3
        !           140: fun ashl(s, r, d as Direct(Genreg _)) =
        !           141:         (if r<>d then move(r,d) else ();
        !           142:          V.ashl(s,d))
        !           143: fun ashr(Immed i, b, c) = ashl(Immed (~i), b, c)
        !           144:   | ashr(a,b,c) = (V.negl(a,ptrtemp);
        !           145:                   ashl(ptrtemp,b,c))
        !           146: val mull2 = V.mull
        !           147: val mull2t = mull2
        !           148: val divl2 = V.divl
        !           149: val andb = threec V.andl
        !           150: val orb = threec V.orl
        !           151: val xorb = threec V.xorl
        !           152: fun notb (a,b) = V.coml(a,b)
        !           153: 
        !           154: fun fetchindexl(Direct x,y,Immed k) = move(Displace(k+k-2,x),y)
        !           155:   | fetchindexl(Direct x,y,Direct z) = move(Index(Displace(~2,x),z,Word),y)
        !           156:   | fetchindexl(Immedlab lab, y, Direct z) =
        !           157:        move(Index(OffAddress(lab,~2), z, Word), y)
        !           158: fun storeindexl(x,y, Immed 1) = move(x, defer y)
        !           159:   | storeindexl(x, Direct y, Immed k) = move(x, Displace(k+k-2,y))
        !           160:   | storeindexl(x, Direct y, Direct z) = move(x,Index(Displace(~2,y),z,Word))
        !           161: fun fetchindexb(v,w) = V.movzbl(Index(defer v, arithtemp', Byte),w)
        !           162: fun storeindexb(v,w) = V.movb(v,Index(defer w, arithtemp', Byte))
        !           163: 
        !           164: fun finishreal(y) = (V.movl(Immed(8*power_tags + tag_string),
        !           165:                            Displace(~4,dataptr'));
        !           166:                     move(dataptr,y);
        !           167:                     V.lea(Displace(4*3, dataptr'), ptrtemp);
        !           168:                     move(ptrtemp, dataptr))
        !           169: (*                     V.addl(Immed(4*3), dataptr)) *)
        !           170: 
        !           171: val fp0 = FloatReg 0
        !           172: 
        !           173: fun float f (a,b,c) =
        !           174:     (V.movg(defer a, Direct fp0);
        !           175:      f(defer b, Direct fp0);
        !           176:      V.movg(Direct fp0, defer dataptr);
        !           177:      finishreal c)
        !           178: 
        !           179: fun mnegg(x,y) = (V.negg(defer x, defer dataptr); finishreal y)
        !           180: 
        !           181: val mulg3 = float V.mulg
        !           182: val divg3 = float V.divg
        !           183: val addg3 = float V.addg
        !           184: val subg3 = float V.subg
        !           185: 
        !           186: fun cbranch NEQ = V.bne
        !           187:   | cbranch EQL = V.beq
        !           188:   | cbranch LEQ = V.ble
        !           189:   | cbranch GEQ = V.bge
        !           190:   | cbranch LSS = V.blt
        !           191:   | cbranch GTR = V.bgt
        !           192: 
        !           193: fun ibranch (cond, op1, op2, label) =
        !           194:        (V.cmpl(op1, op2); cbranch cond (defer label))
        !           195: 
        !           196: fun gbranch (cond, op1, op2, label) =
        !           197:        (V.cmpg(defer op1, defer op2); cbranch cond (defer label))
        !           198: 
        !           199: fun defer' j = fn x => j(defer x)
        !           200: val jmp = defer' V.jump
        !           201: val bbs = fn(x,y,l) => (V.tbit(x,y); V.bfs(defer l))
        !           202: 
        !           203: val immed = Immed
        !           204: fun isimmed(Immed i) = SOME i
        !           205:   | isimmed _ = NONE
        !           206: 
        !           207: fun isreg(Direct(Genreg i)) = SOME i
        !           208: (*  | isreg(Direct(FP)) = SOME(8)              (* What?  BUGBUG *) *)
        !           209:   | isreg _ = NONE
        !           210: 
        !           211: fun eqreg (a: EA) b = a=b
        !           212: 
        !           213: fun profile(i,incr) = if i >= Profile.PROFSIZE
        !           214:                        then ErrorMsg.impossible ("Bad profiling in ns32: trying "
        !           215:                                                  ^makestring i^" with size "
        !           216:                                                  ^makestring Profile.PROFSIZE)
        !           217:                        else V.addl(Immed incr, Displace(4*i,sp')) (* MSPACE mode *) 
        !           218: 
        !           219: val comment = V.comment
        !           220: end

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