![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ns32.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / ns32|
Return to ns32.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / ns32 |
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.